Bug 8594 - prevent the report system from breaking some subqueries
[koha_fer] / C4 / Biblio.pm
index 81da91b..7512a49 100644 (file)
@@ -35,11 +35,12 @@ use C4::Log;    # logaction
 use C4::ClassSource;
 use C4::Charset;
 use C4::Linker;
+use C4::OAI::Sets;
 
 use vars qw($VERSION @ISA @EXPORT);
 
 BEGIN {
-    $VERSION = 1.00;
+    $VERSION = 3.07.00.049;
 
     require Exporter;
     @ISA = qw( Exporter );
@@ -82,6 +83,7 @@ BEGIN {
       &GetXmlBiblio
       &GetCOinSBiblio
       &GetMarcPrice
+      &MungeMarcPrice
       &GetMarcQuantity
 
       &GetAuthorisedValueDesc
@@ -102,6 +104,8 @@ BEGIN {
       &ModBiblio
       &ModBiblioframework
       &ModZebra
+      &UpdateTotalIssues
+      &RemoveAllNsb
     );
 
     # To delete something
@@ -131,6 +135,7 @@ BEGIN {
       &TransformHtmlToMarc
       &TransformHtmlToXml
       &GetNoZebraIndexes
+      prepare_host_field
     );
 }
 
@@ -268,6 +273,11 @@ sub AddBiblio {
     # now add the record
     ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
 
+    # update OAI-PMH sets
+    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+        C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+    }
+
     logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
     return ( $biblionumber, $biblioitemnumber );
 }
@@ -339,6 +349,12 @@ sub ModBiblio {
     # modify the other koha tables
     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
+
+    # update OAI-PMH sets
+    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+        C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+    }
+
     return 1;
 }
 
@@ -417,6 +433,13 @@ sub DelBiblio {
         C4::Serials::DelSubscription( $subscription->{subscriptionid} );
     }
 
+    # We delete any existing holds
+    require C4::Reserves;
+    my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
+    foreach my $res ( @$reserves ) {
+        C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
+    }
+
     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
     # for at least 2 reasons :
     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
@@ -1061,7 +1084,7 @@ sub GetMarcStructure {
     }
 
     $sth = $dbh->prepare(
-        "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue 
+        "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
          FROM   marc_subfield_structure 
          WHERE  frameworkcode=? 
          ORDER BY tagfield,tagsubfield
@@ -1080,10 +1103,12 @@ sub GetMarcStructure {
     my $isurl;
     my $link;
     my $defaultvalue;
+    my $maxlength;
 
     while (
         (   $tag,          $subfield,      $liblibrarian, $libopac, $tab,    $mandatory, $repeatable, $authorised_value,
-            $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue
+            $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue,
+            $maxlength
         )
         = $sth->fetchrow
       ) {
@@ -1100,6 +1125,7 @@ sub GetMarcStructure {
         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
         $res->{$tag}->{$subfield}->{'link'}           = $link;
         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
+        $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
     }
 
     $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
@@ -1382,12 +1408,56 @@ sub GetMarcPrice {
     for my $field ( $record->field(@listtags) ) {
         for my $subfield_value  ($field->subfield($subfield)){
             #check value
+            $subfield_value = MungeMarcPrice( $subfield_value );
             return $subfield_value if ($subfield_value);
         }
     }
     return 0; # no price found
 }
 
+=head2 MungeMarcPrice
+
+Return the best guess at what the actual price is from a price field.
+=cut
+
+sub MungeMarcPrice {
+    my ( $price ) = @_;
+
+    return unless ( $price =~ m/\d/ ); ## No digits means no price.
+
+    ## Look for the currency symbol of the active currency, if it's there,
+    ## start the price string right after the symbol. This allows us to prefer
+    ## this native currency price over other currency prices, if possible.
+    my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
+    my $symbol = quotemeta( $active_currency->{'symbol'} );
+    if ( $price =~ m/$symbol/ ) {
+        my @parts = split(/$symbol/, $price );
+        $price = $parts[1];
+    }
+
+    ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
+    ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
+
+    ## Split price into array on periods and commas
+    my @parts = split(/[\,\.]/, $price);
+
+    ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
+    my $decimal = pop( @parts );
+    if ( length( $decimal ) > 2 ) {
+        push( @parts, $decimal );
+        $decimal = '';
+    }
+
+    $price = join('', @parts );
+
+    if ( $decimal ) {
+     $price .= ".$decimal";
+    }
+
+    return $price;
+}
+
+
 =head2 GetMarcQuantity
 
 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
@@ -1666,7 +1736,7 @@ sub GetMarcSubjects {
 
             # ignore $9
             my @this_link_loop = @link_loop;
-            push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
+            push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 || $subject_subfield->[0] eq '0' );
             $counter++;
         }
 
@@ -1750,7 +1820,7 @@ sub GetMarcAuthors {
                 link_loop => \@this_link_loop,
                 separator => $separator
               }
-              unless ( $authors_subfield->[0] eq '9' );
+              unless ( $authors_subfield->[0] eq '9' || $authors_subfield->[0] eq '0');
             $count_auth++;
         }
         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
@@ -1973,6 +2043,7 @@ sub TransformKohaToMarc {
     my $db_to_marc = C4::Context->marcfromkohafield;
     while ( my ($name, $value) = each %$hash ) {
         next unless my $dtm = $db_to_marc->{''}->{$name};
+        next unless ( scalar( @$dtm ) );
         my ($tag, $letter) = @$dtm;
         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
             if ( my $field = $record->field($tag) ) {
@@ -3033,7 +3104,7 @@ sub _koha_marc_update_bib_ids {
     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
-    die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
+    die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
 
     if ( $biblio_tag == $biblioitem_tag ) {
 
@@ -3247,7 +3318,8 @@ sub _koha_modify_biblioitem_nonmarc {
         cn_item         = ?,
         cn_suffix       = ?,
         cn_sort         = ?,
-        totalissues     = ?
+        totalissues     = ?,
+    ean             = ?
         where biblioitemnumber = ?
         ";
     my $sth = $dbh->prepare($query);
@@ -3259,6 +3331,7 @@ sub _koha_modify_biblioitem_nonmarc {
         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
+    $biblioitem->{'ean'},
         $biblioitem->{'biblioitemnumber'}
     );
     if ( $dbh->errstr ) {
@@ -3310,7 +3383,8 @@ sub _koha_add_biblioitem {
         cn_item         = ?,
         cn_suffix       = ?,
         cn_sort         = ?,
-        totalissues     = ?
+        totalissues     = ?,
+    ean             = ?
         ";
     my $sth = $dbh->prepare($query);
     $sth->execute(
@@ -3321,7 +3395,7 @@ sub _koha_add_biblioitem {
         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
-        $biblioitem->{'totalissues'}
+        $biblioitem->{'totalissues'},      $biblioitem->{'ean'}
     );
     my $bibitemnum = $dbh->{'mysql_insertid'};
 
@@ -3445,9 +3519,12 @@ Function exported, but should NOT be used, unless you really know what you're do
 =cut
 
 sub ModBiblioMarc {
-
-    # pass the MARC::Record to this function, and it will create the records in the marc field
+    # pass the MARC::Record to this function, and it will create the records in
+    # the marc field
     my ( $record, $biblionumber, $frameworkcode ) = @_;
+
+    # Clone record as it gets modified
+    $record = $record->clone();
     my $dbh    = C4::Context->dbh;
     my @fields = $record->fields();
     if ( !$frameworkcode ) {
@@ -3628,9 +3705,225 @@ sub GetHolds {
     return ($holds);
 }
 
+=head2 prepare_host_field
+
+$marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
+Generate the host item entry for an analytic child entry
+
+=cut
+
+sub prepare_host_field {
+    my ( $hostbiblio, $marcflavour ) = @_;
+    $marcflavour ||= C4::Context->preference('marcflavour');
+    my $host = GetMarcBiblio($hostbiblio);
+    # unfortunately as_string does not 'do the right thing'
+    # if field returns undef
+    my %sfd;
+    my $field;
+    my $host_field;
+    if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
+        if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
+            my $s = $field->as_string('ab');
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        if ( $field = $host->field('245') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{t} = $s;
+            }
+        }
+        if ( $field = $host->field('260') ) {
+            my $s = $field->as_string('abc');
+            if ($s) {
+                $sfd{d} = $s;
+            }
+        }
+        if ( $field = $host->field('240') ) {
+            my $s = $field->as_string();
+            if ($s) {
+                $sfd{b} = $s;
+            }
+        }
+        if ( $field = $host->field('022') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{x} = $s;
+            }
+        }
+        if ( $field = $host->field('020') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{z} = $s;
+            }
+        }
+        if ( $field = $host->field('001') ) {
+            $sfd{w} = $field->data(),;
+        }
+        $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
+        return $host_field;
+    }
+    elsif ( $marcflavour eq 'UNIMARC' ) {
+        #author
+        if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
+            my $s = $field->as_string('ab');
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        #title
+        if ( $field = $host->field('200') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{t} = $s;
+            }
+        }
+        #place of publicaton
+        if ( $field = $host->field('210') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{c} = $s;
+            }
+        }
+        #date of publication
+        if ( $field = $host->field('210') ) {
+            my $s = $field->as_string('d');
+            if ($s) {
+                $sfd{d} = $s;
+            }
+        }
+        #edition statement
+        if ( $field = $host->field('205') ) {
+            my $s = $field->as_string();
+            if ($s) {
+                $sfd{a} = $s;
+            }
+        }
+        #URL
+        if ( $field = $host->field('856') ) {
+            my $s = $field->as_string('u');
+            if ($s) {
+                $sfd{u} = $s;
+            }
+        }
+        #ISSN
+        if ( $field = $host->field('011') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{x} = $s;
+            }
+        }
+        #ISBN
+        if ( $field = $host->field('010') ) {
+            my $s = $field->as_string('a');
+            if ($s) {
+                $sfd{y} = $s;
+            }
+        }
+        if ( $field = $host->field('001') ) {
+            $sfd{0} = $field->data(),;
+        }
+        $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
+        return $host_field;
+    }
+    return;
+}
+
+
+=head2 UpdateTotalIssues
+
+  UpdateTotalIssues($biblionumber, $increase, [$value])
+
+Update the total issue count for a particular bib record.
+
+=over 4
+
+=item C<$biblionumber> is the biblionumber of the bib to update
+
+=item C<$increase> is the amount to increase (or decrease) the total issues count by
+
+=item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
+
+=back
+
+=cut
+
+sub UpdateTotalIssues {
+    my ($biblionumber, $increase, $value) = @_;
+    my $totalissues;
+
+    my $data = GetBiblioData($biblionumber);
+
+    if (defined $value) {
+        $totalissues = $value;
+    } else {
+        $totalissues = $data->{'totalissues'} + $increase;
+    }
+     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
+
+     my $record = GetMarcBiblio($biblionumber);
+
+     my $field = $record->field($totalissuestag);
+     if (defined $field) {
+         $field->update( $totalissuessubfield => $totalissues );
+     } else {
+         $field = MARC::Field->new($totalissuestag, '0', '0',
+                 $totalissuessubfield => $totalissues);
+         $record->insert_grouped_field($field);
+     }
+
+     ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
+     return;
+}
+
+=head2 RemoveAllNsb
+
+    &RemoveAllNsb($record);
+
+Removes all nsb/nse chars from a record
+
+=cut
+
+sub RemoveAllNsb {
+    my $record = shift;
+
+    SetUTF8Flag($record);
+
+    foreach my $field ($record->fields()) {
+        if ($field->is_control_field()) {
+            $field->update(nsb_clean($field->data()));
+        } else {
+            my @subfields = $field->subfields();
+            my @new_subfields;
+            foreach my $subfield (@subfields) {
+                push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
+            }
+            if (scalar(@new_subfields) > 0) {
+                my $new_field;
+                eval {
+                    $new_field = MARC::Field->new(
+                        $field->tag(),
+                        $field->indicator(1),
+                        $field->indicator(2),
+                        @new_subfields
+                    );
+                };
+                if ($@) {
+                    warn "error in RemoveAllNsb : $@";
+                } else {
+                    $field->replace_with($new_field);
+                }
+            }
+        }
+    }
+
+    return $record;
+}
 
 1;
 
+
 __END__
 
 =head1 AUTHOR