Get rid of a few warnings in the bulkmarcimport script: C4/Biblio.pm, hunks #1, ...
[koha.git] / C4 / Biblio.pm
index de0b3c3..cdb119f 100644 (file)
@@ -67,6 +67,7 @@ BEGIN {
                GetMarcUrls
                &GetUsedMarcStructure
                &GetXmlBiblio
+               &GetCOinSBiblio
 
                &GetAuthorisedValueDesc
                &GetMarcStructure
@@ -74,6 +75,8 @@ BEGIN {
                &GetFrameworkCode
                &GetPublisherNameFromIsbn
                &TransformKohaToMarc
+               
+               &CountItemsIssued
        );
 
        # To modify something
@@ -111,6 +114,19 @@ BEGIN {
        );
 }
 
+eval {
+    my $servers = C4::Context->config('memcached_servers');
+    if ($servers) {
+        require Memoize::Memcached;
+        import Memoize::Memcached qw(memoize_memcached);
+
+        my $memcached = {
+            servers    => [ $servers ],
+            key_prefix => C4::Context->config('memcached_namespace') || 'koha',
+        };
+        memoize_memcached('GetMarcStructure', memcached => $memcached, expire_time => 600); #cache for 10 minutes
+    }
+};
 =head1 NAME
 
 C4::Biblio - cataloging management functions
@@ -235,10 +251,9 @@ sub AddBiblio {
     _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode);
     
     # now add the record
-    $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
+    ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
       
     logaction("CATALOGUING", "ADD", $biblionumber, "biblio") if C4::Context->preference("CataloguingLog");
-
     return ( $biblionumber, $biblioitemnumber );
 }
 
@@ -379,11 +394,9 @@ sub DelBiblio {
     return $error if $error;
 
     # We delete attached subscriptions
-    if(C4::Serials::CountSubscriptionFromBiblionumber($biblionumber) != 0){
-        my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
-        foreach my $subscription (@$subscriptions){
-            &C4::Serials::DelSubscription($subscription->{subscriptionid});
-        }
+    my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
+    foreach my $subscription (@$subscriptions){
+        &C4::Serials::DelSubscription($subscription->{subscriptionid});
     }
     
     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
@@ -833,23 +846,17 @@ sub GetMarcStructure {
         return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
     }
 
-    my $sth;
-    my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
-
-    # check that framework exists
-    $sth =
-      $dbh->prepare(
+    my $sth = $dbh->prepare(
         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
     $sth->execute($frameworkcode);
     my ($total) = $sth->fetchrow;
     $frameworkcode = "" unless ( $total > 0 );
-    $sth =
-      $dbh->prepare(
+    $sth = $dbh->prepare(
         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable 
         FROM marc_tag_structure 
         WHERE frameworkcode=? 
         ORDER BY tagfield"
-      );
+    );
     $sth->execute($frameworkcode);
     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 
@@ -863,13 +870,12 @@ sub GetMarcStructure {
         $res->{$tag}->{repeatable} = $repeatable;
     }
 
-    $sth =
-      $dbh->prepare(
-            "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue 
-                FROM marc_subfield_structure 
-            WHERE frameworkcode=? 
-                ORDER BY tagfield,tagsubfield
-            "
+    $sth = $dbh->prepare(
+        "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue 
+         FROM   marc_subfield_structure 
+         WHERE  frameworkcode=? 
+         ORDER BY tagfield,tagsubfield
+        "
     );
     
     $sth->execute($frameworkcode);
@@ -888,7 +894,7 @@ sub GetMarcStructure {
     while (
         (
             $tag,          $subfield,      $liblibrarian,
-            ,              $libopac,       $tab,
+            $libopac,      $tab,
             $mandatory,    $repeatable,    $authorised_value,
             $authtypecode, $value_builder, $kohafield,
             $seealso,      $hidden,        $isurl,
@@ -920,7 +926,7 @@ sub GetMarcStructure {
 
 =head2 GetUsedMarcStructure
 
-    the same function as GetMarcStructure expcet it just take field
+    the same function as GetMarcStructure except it just takes field
     in tab 0-9. (used field)
     
     my $results = GetUsedMarcStructure($frameworkcode);
@@ -934,20 +940,16 @@ sub GetMarcStructure {
 
 sub GetUsedMarcStructure($){
     my $frameworkcode = shift || '';
-    my $dbh           = C4::Context->dbh;
     my $query         = qq/
         SELECT *
         FROM   marc_subfield_structure
         WHERE   tab > -1 
             AND frameworkcode = ?
+        ORDER BY tagfield, tagsubfield
     /;
-    my @results;
-    my $sth = $dbh->prepare($query);
+    my $sth = C4::Context->dbh->prepare($query);
     $sth->execute($frameworkcode);
-    while (my $row = $sth->fetchrow_hashref){
-        push @results,$row;
-    }
-    return \@results;
+    return $sth->fetchall_arrayref({});
 }
 
 =head2 GetMarcFromKohaField
@@ -1029,6 +1031,128 @@ sub GetXmlBiblio {
     return $marcxml;
 }
 
+=head2 GetCOinSBiblio
+
+=over 4
+
+my $coins = GetCOinSBiblio($biblionumber);
+
+Returns the COinS(a span) which can be included in a biblio record
+
+=back
+
+=cut
+
+sub GetCOinSBiblio {
+    my ( $biblionumber ) = @_;
+    my $record = GetMarcBiblio($biblionumber);
+
+    # get the coin format
+    my $pos7 = substr $record->leader(), 7,1;
+    my $pos6 = substr $record->leader(), 6,1;
+    my $mtx;
+    my $genre;
+    my ($aulast, $aufirst) = ('','');
+    my $oauthors  = '';
+    my $title     = '';
+    my $subtitle  = '';
+    my $pubyear   = '';
+    my $isbn      = '';
+    my $issn      = '';
+    my $publisher = '';
+
+    if ( C4::Context->preference("marcflavour") eq "UNIMARC" ){
+        my $fmts6;
+        my $fmts7;
+        %$fmts6 = (
+                    'a' => 'book',
+                    'b' => 'manuscript',
+                    'c' => 'book',
+                    'd' => 'manuscript',
+                    'e' => 'map',
+                    'f' => 'map',
+                    'g' => 'film',
+                    'i' => 'audioRecording',
+                    'j' => 'audioRecording',
+                    'k' => 'artwork',
+                    'l' => 'document',
+                    'm' => 'computerProgram',
+                    'r' => 'document',
+
+                );
+        %$fmts7 = (
+                    'a' => 'journalArticle',
+                    's' => 'journal',
+                );
+
+        $genre =  $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book' ;
+
+        if( $genre eq 'book' ){
+            $genre =  $fmts7->{$pos7} if $fmts7->{$pos7};
+        }
+
+        ##### We must transform mtx to a valable mtx and document type ####
+        if( $genre eq 'book' ){
+            $mtx = 'book';
+        }elsif( $genre eq 'journal' ){
+            $mtx = 'journal';
+        }elsif( $genre eq 'journalArticle' ){
+            $mtx = 'journal';
+            $genre = 'article';
+        }else{
+            $mtx = 'dc';
+        }
+
+        $genre = ($mtx eq 'dc') ? "&rft.type=$genre" : "&rft.genre=$genre";
+
+        # Setting datas
+        $aulast     = $record->subfield('700','a');
+        $aufirst    = $record->subfield('700','b');
+        $oauthors   = "&rft.au=$aufirst $aulast";
+        # others authors
+        if($record->field('200')){
+            for my $au ($record->field('200')->subfield('g')){
+                $oauthors .= "&rft.au=$au";
+            }
+        }
+        $title      = ( $mtx eq 'dc' ) ? "&rft.title=".$record->subfield('200','a') :
+                                         "&rft.title=".$record->subfield('200','a')."&rft.btitle=".$record->subfield('200','a');
+        $pubyear    = $record->subfield('210','d');
+        $publisher  = $record->subfield('210','c');
+        $isbn       = $record->subfield('010','a');
+        $issn       = $record->subfield('011','a');
+    }else{
+        # MARC21 need some improve
+        my $fmts;
+        $mtx = 'book';
+        $genre = "&rft.genre=book";
+
+        # Setting datas
+        if ($record->field('100')) {
+            $oauthors .= "&rft.au=".$record->subfield('100','a');
+        }
+        # others authors
+        if($record->field('700')){
+            for my $au ($record->field('700')->subfield('a')){
+                $oauthors .= "&rft.au=$au";
+            }
+        }
+        $title      = "&rft.btitle=".$record->subfield('245','a');
+        $subtitle   = $record->subfield('245', 'b') || '';
+        $title .= $subtitle;
+        $pubyear    = $record->subfield('260', 'c') || '';
+        $publisher  = $record->subfield('260', 'b') || '';
+        $isbn       = $record->subfield('020', 'a') || '';
+        $issn       = $record->subfield('022', 'a') || '';
+
+    }
+    my $coins_value = "ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear";
+    $coins_value =~ s/(\ |&[^a])/\+/g;
+    #<!-- TMPL_VAR NAME="ocoins_format" -->&amp;rft.au=<!-- TMPL_VAR NAME="author" -->&amp;rft.btitle=<!-- TMPL_VAR NAME="title" -->&amp;rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&amp;rft.pages=<!-- TMPL_VAR NAME="pages" -->&amp;rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&amp;rft.aucorp=&amp;rft.place=<!-- TMPL_VAR NAME="place" -->&amp;rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&amp;rft.edition=<!-- TMPL_VAR NAME="edition" -->&amp;rft.series=<!-- TMPL_VAR NAME="series" -->&amp;rft.genre="
+
+    return $coins_value;
+}
+
 =head2 GetAuthorisedValueDesc
 
 =over 4
@@ -1206,7 +1330,7 @@ sub GetMarcAuthors {
     my ( $record, $marcflavour ) = @_;
     my ( $mintag, $maxtag );
     # tagslib useful for UNIMARC author reponsabilities
-    my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
+    my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
     if ( $marcflavour eq "MARC21" ) {
         $mintag = "700";
         $maxtag = "720"; 
@@ -1513,6 +1637,7 @@ $auth_type contains :
 sub TransformHtmlToXml {
     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
     my $xml = MARC::File::XML::header('UTF-8');
+    $xml .= "<record>\n";
     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
     MARC::File::XML->default_record_format($auth_type);
     # in UNIMARC, field 100 contains the encoding
@@ -1559,10 +1684,8 @@ sub TransformHtmlToXml {
                         warn "Indicator in @$tags[$i] is empty";
                         $ind2 = " ";
                     }
-                    $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
-                    $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                    $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                    $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
                     $first = 0;
                 }
                 else {
@@ -1580,17 +1703,16 @@ sub TransformHtmlToXml {
                         # rest of the fixed fields
                     }
                     elsif ( @$tags[$i] < 10 ) {
-                        $xml .=
-"<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
+                        $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
                         $first = 1;
                     }
                     else {
                         my $ind1 = substr( @$indicator[$j], 0, 1 );
                         my $ind2 = substr( @$indicator[$j], 1, 1 );
-                        $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
-                        $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                        $ind1 = " " if !defined($ind2) or $ind2 eq "";
+                        $ind2 = " " if !defined($ind2) or $ind2 eq "";
+                        $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                        $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
                         $first = 0;
                     }
                 }
@@ -1603,12 +1725,12 @@ sub TransformHtmlToXml {
                 if ($first) {
                     my $ind1 = substr( @$indicator[$j], 0, 1 );
                     my $ind2 = substr( @$indicator[$j], 1, 1 );
-                    $xml .=
-"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+                    $ind1 = " " if !defined($ind2) or $ind2 eq "";
+                    $ind2 = " " if !defined($ind2) or $ind2 eq "";
+                    $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
                     $first = 0;
                 }
-                $xml .=
-"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+                $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
             }
         }
         $prevtag = @$tags[$i];
@@ -1626,6 +1748,7 @@ sub TransformHtmlToXml {
         $xml .= "<subfield code=\"a\">$string</subfield>\n";
         $xml .= "</datafield>\n";
     }
+    $xml .= "</record>\n";
     $xml .= MARC::File::XML::footer();
     return $xml;
 }
@@ -1903,6 +2026,15 @@ more.
 
 =cut
 
+sub CountItemsIssued {
+  my ( $biblionumber )  = @_;
+  my $dbh = C4::Context->dbh;
+  my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
+  $sth->execute( $biblionumber );
+  my $row = $sth->fetchrow_hashref();
+  return $row->{'issuedCount'};
+}
+
 sub _disambiguate {
     my ($table, $column) = @_;
     if ($column eq "cn_sort" or $column eq "cn_source") {
@@ -2063,10 +2195,14 @@ sub PrepareItemrecordDisplay {
                   $tagslib->{$tag}->{$subfield}->{repeatable};
                 $subfield_data{hidden} = "display:none"
                   if $tagslib->{$tag}->{$subfield}->{hidden};
-                my ( $x, $value );
-                ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
-                  if ($itemrecord);
-                $value =~ s/"/&quot;/g;
+                  my ( $x, $value );
+                  if ($itemrecord) {
+                      ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord );
+                  }
+                  if (!defined $value) {
+                      $value = q||;
+                  }
+                  $value =~ s/"/&quot;/g;
 
                 # search for itemcallnumber if applicable
                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
@@ -2112,7 +2248,7 @@ sub PrepareItemrecordDisplay {
                         "branches" )
                     {
                         if ( ( C4::Context->preference("IndependantBranches") )
-                            && ( C4::Context->userenv->{flags} != 1 ) )
+                            && ( C4::Context->userenv->{flags} % 2 != 1 ) )
                         {
                             my $sth =
                               $dbh->prepare(
@@ -2533,7 +2669,8 @@ sub _AddBiblioNoZebra {
                 foreach (split / /,$line) {
                     next unless $_; # skip  empty values (multiple spaces)
                     # if the entry is already here, improve weight
-                    if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) { 
+                    my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
+                    if ($tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/) {
                         my $weight=$1+1;
                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
@@ -2544,7 +2681,7 @@ sub _AddBiblioNoZebra {
                         # it exists
                         if ($existing_biblionumbers) {
                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
-                            my $weight=$1+1;
+                            my $weight = ($1 ? $1 : 0) + 1;
                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                         # create a new ligne for this entry
@@ -3135,9 +3272,8 @@ sub ModBiblioMarc {
 
     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
     if ( $encoding eq "UNIMARC" ) {
-        my $string;
-        if ( length($record->subfield( 100, "a" )) == 35 ) {
-            $string = $record->subfield( 100, "a" );
+        my $string = $record->subfield( 100, "a" );
+        if ( ($string) && ( length($record->subfield( 100, "a" )) == 35 ) ) {
             my $f100 = $record->field(100);
             $record->delete_field($f100);
         }
@@ -3284,7 +3420,7 @@ sub set_service_options {
     biblionumber
     MARC::Record of the bib
 
-  returns: a hashref malling the authorised value to the value set for this biblionumber
+  returns: a hashref mapping the authorised value to the value set for this biblionumber
 
       $authorised_values = {
                              'Scent'     => 'flowery',