Followup previous patch bug 2955 :
[koha.git] / C4 / Biblio.pm
old mode 100755 (executable)
new mode 100644 (file)
index a0406db..cee44d5
@@ -18,15 +18,16 @@ package C4::Biblio;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
+use warnings;
 # use utf8;
 use MARC::Record;
 use MARC::File::USMARC;
+# Force MARC::File::XML to use LibXML SAX Parser
+#$XML::SAX::ParserPackage = "XML::LibXML::SAX";
 use MARC::File::XML;
 use ZOOM;
 
-use C4::Context;
 use C4::Koha;
-use C4::Branch;
 use C4::Dates qw/format_date/;
 use C4::Log; # logaction
 use C4::ClassSource;
@@ -63,6 +64,7 @@ BEGIN {
                GetMarcUrls
                &GetUsedMarcStructure
                &GetXmlBiblio
+        &GetCOinSBiblio
 
                &GetAuthorisedValueDesc
                &GetMarcStructure
@@ -107,12 +109,6 @@ BEGIN {
        );
 }
 
-# because of interdependencies between
-# C4::Search, C4::Heading, and C4::Biblio,
-# 'use C4::Heading' must occur after
-# the exports have been defined.
-use C4::Heading;
-
 =head1 NAME
 
 C4::Biblio - cataloging management functions
@@ -539,7 +535,7 @@ sub GetBiblioItemData {
     my ($biblioitemnumber) = @_;
     my $dbh       = C4::Context->dbh;
     my $query = "SELECT *,biblioitems.notes AS bnotes
-        FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblioitemnumber ";
+        FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
     unless(C4::Context->preference('item-level_itypes')) { 
         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
     }    
@@ -826,7 +822,7 @@ for the given frameworkcode
 
 sub GetMarcFromKohaField {
     my ( $kohafield, $frameworkcode ) = @_;
-    return 0, 0 unless $kohafield;
+    return 0, 0 unless $kohafield and defined $frameworkcode;
     my $relations = C4::Context->marcfromkohafield;
     return (
         $relations->{$frameworkcode}->{$kohafield}->[0],
@@ -891,6 +887,123 @@ 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 $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
+        $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');
+        $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/\ /\+/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
@@ -912,6 +1025,9 @@ sub GetAuthorisedValueDesc {
     my $dbh = C4::Context->dbh;
 
     if (!$category) {
+
+        return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
+
 #---- branch
         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
             return C4::Branch::GetBranchName($value);
@@ -967,6 +1083,8 @@ sub GetMarcNotes {
     my $marcnote;
     foreach my $field ( $record->field($scope) ) {
         my $value = $field->as_string();
+        $value =~ s/\n/<br \/>/g ;
+
         if ( $note ne "" ) {
             $marcnote = { marcnote => $note, };
             push @marcnotes, $marcnote;
@@ -1107,7 +1225,7 @@ sub GetMarcAuthors {
             $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~/4/));
             my @this_link_loop = @link_loop;
             my $separator = C4::Context->preference("authoritysep") unless $count_auth==0;
-            push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] == 9 );
+            push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] eq '9' );
             $count_auth++;
         }
         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
@@ -1130,8 +1248,8 @@ Assumes web resources (not uncommon in MARC21 to omit resource type ind)
 sub GetMarcUrls {
     my ($record, $marcflavour) = @_;
     my @marcurls;
-    my $marcurl;
     for my $field ($record->field('856')) {
+        my $marcurl;
         my $url = $field->subfield('u');
         my @notes;
         for my $note ( $field->subfield('z')) {
@@ -1159,7 +1277,8 @@ sub GetMarcUrls {
             $marcurl->{'part'} = $s3 if($link);
             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
         } else {
-            $marcurl->{'linktext'} = $url || C4::Context->preference('URLLinkText') ;
+            $marcurl->{'linktext'} = $field->subfield('z') || C4::Context->preference('URLLinkText') || $url;
+            $marcurl->{'MARCURL'} = $url ;
         }
         push @marcurls, $marcurl;    
     }
@@ -1379,7 +1498,7 @@ sub TransformHtmlToXml {
     my $prevtag = -1;
     my $first   = 1;
     my $j       = -1;
-    for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
+    for ( my $i = 0 ; $i < @$tags ; $i++ ) {
         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
             # if we have a 100 field and it's values are not correct, skip them.
             # if we don't have any valid 100 field, we will create a default one at the end
@@ -1468,6 +1587,7 @@ sub TransformHtmlToXml {
         }
         $prevtag = @$tags[$i];
     }
+    $xml .= "</datafield>\n" if @$tags > 0;
     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
 #     warn "SETTING 100 for $auth_type";
         use POSIX qw(strftime);
@@ -1513,7 +1633,7 @@ sub TransformHtmlToXml {
 sub TransformHtmlToMarc {
     my $params = shift;
     my $cgi    = shift;
-   
+
     # explicitly turn on the UTF-8 flag for all
     # 'tag_' parameters to avoid incorrect character
     # conversion later on
@@ -1575,7 +1695,7 @@ sub TransformHtmlToMarc {
                 }
     # > 009, deal with subfields
             } else {
-                while($params->[$j] =~ /_code_/){ # browse all it's subfield
+                while(defined $params->[$j] && $params->[$j] =~ /_code_/){ # browse all it's subfield
                     my $inner_param = $params->[$j];
                     if ($newfield){
                         if($cgi->param($params->[$j+1]) ne ''){  # only if there is a value (code => value)
@@ -1624,13 +1744,15 @@ sub TransformMarcToKoha {
     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
 
     my $result;
-
+    $limit_table=$limit_table||0;
+    $frameworkcode = '' unless defined $frameworkcode;
+    
     unless (defined $inverted_field_map) {
         $inverted_field_map = _get_inverted_marc_field_map();
     }
 
     my %tables = ();
-    if ($limit_table eq 'items') {
+    if ( defined $limit_table && $limit_table eq 'items') {
         $tables{'items'} = 1;
     } else {
         $tables{'items'} = 1;
@@ -1681,8 +1803,8 @@ sub TransformMarcToKoha {
     # modify copyrightdate to keep only the 1st year found
     if (exists $result->{'copyrightdate'}) {
         my $temp = $result->{'copyrightdate'};
-        $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
-        if ( $1 > 0 ) {
+        $temp =~ m/c(\d\d\d\d)/;
+        if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
             $result->{'copyrightdate'} = $1;
         }
         else {                      # if no cYYYY, get the 1st date.
@@ -1694,8 +1816,7 @@ sub TransformMarcToKoha {
     # modify publicationyear to keep only the 1st year found
     if (exists $result->{'publicationyear'}) {
         my $temp = $result->{'publicationyear'};
-        $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
-        if ( $1 > 0 ) {
+        if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
             $result->{'publicationyear'} = $1;
         }
         else {                      # if no cYYYY, get the 1st date.
@@ -1713,6 +1834,7 @@ sub _get_inverted_marc_field_map {
 
     foreach my $frameworkcode (keys %{ $relations }) {
         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
+            next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
             my ($table, $column) = split /[.]/, $kohafield, 2;
@@ -2140,8 +2262,8 @@ sub ModZebra {
         # lock the nozebra table : we will read index lines, update them in Perl process
         # and write everything in 1 transaction.
         # lock the table to avoid someone else overwriting what we are doing
-        $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
-        my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
+        $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
+        my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
         if ($op eq 'specialUpdate') {
             # OK, we have to add or update the record
             # 1st delete (virtually, in indexes), if record actually exists
@@ -2163,7 +2285,6 @@ sub ModZebra {
             }
         }
         $dbh->do('UNLOCK TABLES');
-
     } else {
         #
         # we use zebra, just fill zebraqueue table
@@ -2194,15 +2315,13 @@ sub ModZebra {
 =cut
 
 sub GetNoZebraIndexes {
-    my $index = C4::Context->preference('NoZebraIndexes');
+    my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
     my %indexes;
-    foreach my $line (split /('|"),/,$index) {
+    INDEX: foreach my $line (split /['"],[\n\r]*/,$no_zebra_indexes) {
         $line =~ /(.*)=>(.*)/;
-        my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
+        my $index = $1; # initial ' or " is removed afterwards
         my $fields = $2;
         $index =~ s/'|"|\s//g;
-
-
         $fields =~ s/'|"|\s//g;
         $indexes{$index}=$fields;
     }
@@ -2235,7 +2354,7 @@ sub _DelBiblioNoZebra {
     if ($server eq 'biblioserver') {
         %index=GetNoZebraIndexes;
         # get title of the record (to store the 10 first letters with the index)
-        my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
+        my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title','');
         $title = lc($record->subfield($titletag,$titlesubfield));
     } else {
         # for authorities, the "title" is the $a mainentry
@@ -2275,7 +2394,7 @@ sub _DelBiblioNoZebra {
                     foreach (split / /,$line) {
                         next unless $_; # skip  empty values (multiple spaces)
                         # if the entry is already here, do nothing, the biblionumber has already be removed
-                        unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
+                        unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) ) {
                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
                             $sth2->execute($server,$key,$_);
                             my $existing_biblionumbers = $sth2->fetchrow;
@@ -2329,7 +2448,7 @@ sub _AddBiblioNoZebra {
     if ($server eq 'biblioserver') {
         %index=GetNoZebraIndexes;
         # get title of the record (to store the 10 first letters with the index)
-        my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
+        my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title','');
         $title = lc($record->subfield($titletag,$titlesubfield));
     } else {
         # warn "server : $server";
@@ -2351,6 +2470,7 @@ sub _AddBiblioNoZebra {
     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
     foreach my $field ($record->fields()) {
         #parse each subfield
+        ###FIXME: impossible to index a 001-009 value with NoZebra
         next if $field->tag <10;
         foreach my $subfield ($field->subfields()) {
             my $tag = $field->tag();
@@ -2371,9 +2491,9 @@ sub _AddBiblioNoZebra {
                         next unless $_; # skip  empty values (multiple spaces)
                         # if the entry is already here, improve weight
 #                         warn "managing $_";
-                        if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { 
-                            my $weight=$1+1;
-                            $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
+                        if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
+                            my $weight = $1 + 1;
+                            $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
                         } else {
                             # get the value if it exist in the nozebra table, otherwise, create it
@@ -2382,8 +2502,8 @@ sub _AddBiblioNoZebra {
                             # it exists
                             if ($existing_biblionumbers) {
                                 $result{$key}->{"$_"} =$existing_biblionumbers;
-                                my $weight=$1+1;
-                                $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
+                                my $weight = defined $1 ? $1 + 1 : 1;
+                                $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
                             # create a new ligne for this entry
                             } else {
@@ -2403,9 +2523,9 @@ 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);/) { 
+                    if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) { 
                         my $weight=$1+1;
-                        $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
+                        $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                     } else {
                         # get the value if it exist in the nozebra table, otherwise, create it
@@ -2415,7 +2535,7 @@ sub _AddBiblioNoZebra {
                         if ($existing_biblionumbers) {
                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
                             my $weight=$1+1;
-                            $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
+                            $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
                         # create a new ligne for this entry
                         } else {
@@ -3192,7 +3312,7 @@ sub get_biblio_authorised_values {
         foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
             if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
-                if ( exists $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
+                if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
                     if ( defined $record->field( $tag ) ) {
                         my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
                         if ( defined $this_subfield_value ) {