small (UNIMARC) fix, error in regexp writing
[koha.git] / C4 / Biblio.pm
index 86f6310..99996f5 100755 (executable)
@@ -239,8 +239,7 @@ sub AddBiblio {
     # now add the record
     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
       
-    &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio") 
-        if C4::Context->preference("CataloguingLog");
+    logaction("CATALOGUING", "ADD", $biblionumber, "biblio") if C4::Context->preference("CataloguingLog");
 
     return ( $biblionumber, $biblioitemnumber );
 }
@@ -256,7 +255,7 @@ sub ModBiblio {
     my ( $record, $biblionumber, $frameworkcode ) = @_;
     if (C4::Context->preference("CataloguingLog")) {
         my $newrecord = GetMarcBiblio($biblionumber);
-        &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
+        logaction("CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>".$newrecord->as_formatted);
     }
     
     my $dbh = C4::Context->dbh;
@@ -362,7 +361,13 @@ sub DelBiblio {
     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
-    ModZebra($biblionumber, "recordDelete", "biblioserver", undef);
+    my $oldRecord;
+    if (C4::Context->preference("NoZebra")) {
+        # only NoZebra indexing needs to have
+        # the previous version of the record
+        $oldRecord = GetMarcBiblio($biblionumber);
+    }
+    ModZebra($biblionumber, "recordDelete", "biblioserver", $oldRecord, undef);
 
     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
     $sth =
@@ -382,8 +387,8 @@ sub DelBiblio {
     # from being generated by _koha_delete_biblioitems
     $error = _koha_delete_biblio( $dbh, $biblionumber );
 
-    &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"") 
-        if C4::Context->preference("CataloguingLog");
+    logaction("CATALOGUING", "DELETE", $biblionumber, "") if C4::Context->preference("CataloguingLog");
+
     return;
 }
 
@@ -691,7 +696,7 @@ sub GetMarcStructure {
     {
         $res->{$tag}->{lib} =
           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
-        $res->{$tab}->{tab}        = "";
+        $res->{$tag}->{tab}        = "";
         $res->{$tag}->{mandatory}  = $mandatory;
         $res->{$tag}->{repeatable} = $repeatable;
     }
@@ -809,11 +814,14 @@ sub GetMarcFromKohaField {
 
 =over 4
 
-Returns MARC::Record of the biblionumber passed in parameter.
-the marc record contains both biblio & item datas
+my $record = GetMarcBiblio($biblionumber);
 
 =back
 
+Returns MARC::Record representing bib identified by
+C<$biblionumber>.  If no bib exists, returns undef.
+The MARC record contains both biblio & item data.
+
 =cut
 
 sub GetMarcBiblio {
@@ -991,7 +999,7 @@ sub GetMarcSubjects {
         my $subfield9 = $field->subfield('9');
         for my $subject_subfield (@subfields ) {
             # don't load unimarc subfields 3,4,5
-            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
+            next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /3|4|5/ ) );
             my $code = $subject_subfield->[0];
             my $value = $subject_subfield->[1];
             my $linkvalue = $value;
@@ -1005,7 +1013,7 @@ sub GetMarcSubjects {
             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
             # 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] == 9 );
+            push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] eq 9 );
             $counter++;
         }
                 
@@ -1055,7 +1063,7 @@ sub GetMarcAuthors {
         my $subfield9 = $field->subfield('9');
         for my $authors_subfield (@subfields) {
             # don't load unimarc subfields 3, 5
-            next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) );
+            next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ /3|5/ ) );
             my $subfieldcode = $authors_subfield->[0];
             my $value = $authors_subfield->[1];
             my $linkvalue = $value;
@@ -1063,7 +1071,7 @@ sub GetMarcAuthors {
             my $operator = " and " unless $count_auth==0;
             # if we have an authority link, use that as the link, otherwise use standard searching
             if ($subfield9) {
-                @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" });
+                @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
             }
             else {
                 # reset $linkvalue if UNIMARC author responsibility
@@ -1105,17 +1113,31 @@ sub GetMarcUrls {
         for my $note ( $field->subfield('z')) {
             push @notes , {note => $note};
         }        
-        $marcurl = {  MARCURL => $url,
-                      notes => \@notes,
-                    };
         if($marcflavour eq 'MARC21') {
             my $s3 = $field->subfield('3');
             my $link = $field->subfield('y');
-            $marcurl->{'linktext'} = $link || $s3 || $url ;;
+                       warn $url;
+                       unless($url =~ /^\w+:/) {
+                       warn $field->indicator(1);
+                               if($field->indicator(1) eq '7') {
+                                       $url = $field->subfield('2') . "://" . $url;
+                               } elsif ($field->indicator(1) eq '1') {
+                                       $url = 'ftp://' . $url;
+                               } else {  
+                                       #  properly, this should be if ind1=4,
+                                       #  however we will assume http protocol since we're building a link.
+                                       $url = 'http://' . $url;
+                               }
+                       }
+                       # TODO handle ind 2 (relationship)
+               $marcurl = {  MARCURL => $url,
+                      notes => \@notes,
+            };
+            $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url ;;
             $marcurl->{'part'} = $s3 if($link);
             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
         } else {
-            $marcurl->{'linktext'} = $url;
+            $marcurl->{'linktext'} = $url || C4::Context->preference('URLLinkText') ;
         }
         push @marcurls, $marcurl;    
     }
@@ -2036,11 +2058,14 @@ sub PrepareItemrecordDisplay {
 
 =over 4
 
-ModZebra( $biblionumber, $op, $server, $newRecord );
+ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
 
     $biblionumber is the biblionumber we want to index
     $op is specialUpdate or delete, and is used to know what we want to do
     $server is the server that we want to update
+    $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when 
+      NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
+      do an update.
     $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
     
 =back
@@ -2049,7 +2074,7 @@ ModZebra( $biblionumber, $op, $server, $newRecord );
 
 sub ModZebra {
 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
-    my ( $biblionumber, $op, $server, $newRecord ) = @_;
+    my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
     my $dbh=C4::Context->dbh;
 
     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
@@ -2063,24 +2088,18 @@ sub ModZebra {
         # 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
-        my $record;
-        if ($server eq 'biblioserver') {
-            $record= GetMarcBiblio($biblionumber);
-        } else {
-            $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
-        }
         if ($op eq 'specialUpdate') {
             # OK, we have to add or update the record
             # 1st delete (virtually, in indexes), if record actually exists
-            if ($record) { 
-                %result = _DelBiblioNoZebra($biblionumber,$record,$server);
+            if ($oldRecord) { 
+                %result = _DelBiblioNoZebra($biblionumber,$oldRecord,$server);
             }
             # ... add the record
             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
         } else {
             # it's a deletion, delete the record...
             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
-            %result=_DelBiblioNoZebra($biblionumber,$record,$server);
+            %result=_DelBiblioNoZebra($biblionumber,$oldRecord,$server);
         }
         # ok, now update the database...
         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
@@ -2166,12 +2185,13 @@ sub _DelBiblioNoZebra {
         $title = lc($record->subfield($titletag,$titlesubfield));
     } else {
         # for authorities, the "title" is the $a mainentry
-        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
+        my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
+        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
         $title = $record->subfield($authref->{auth_tag_to_report},'a');
         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
-        $index{'auth_type'}    = '152b';
+        $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
     }
     
     my %result;
@@ -2260,16 +2280,17 @@ sub _AddBiblioNoZebra {
     } else {
         # warn "server : $server";
         # for authorities, the "title" is the $a mainentry
-        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
+        my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
+        my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
         $title = $record->subfield($authref->{auth_tag_to_report},'a');
         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
-        $index{'auth_type'}     = '152b';
+        $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
     }
 
     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
-    $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=//g;
+    $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
     # limit to 10 char, should be enough, and limit the DB size
     $title = substr($title,0,10);
     #parse each field
@@ -2281,6 +2302,7 @@ sub _AddBiblioNoZebra {
             my $tag = $field->tag();
             my $subfieldcode = $subfield->[0];
             my $indexed=0;
+            warn "INDEXING :".$subfield->[1];
             # check each index to see if the subfield is stored somewhere
             # otherwise, store it in __RAW__ index
             foreach my $key (keys %index) {
@@ -2289,7 +2311,7 @@ sub _AddBiblioNoZebra {
                     $indexed=1;
                     my $line= lc $subfield->[1];
                     # remove meaningless value in the field...
-                    $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
+                    $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
                     # ... and split in words
                     foreach (split / /,$line) {
                         next unless $_; # skip  empty values (multiple spaces)
@@ -2322,7 +2344,7 @@ sub _AddBiblioNoZebra {
             # the subfield is not indexed, store it in __RAW__ index anyway
             unless ($indexed) {
                 my $line= lc $subfield->[1];
-                $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
+                $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
                 # ... and split in words
                 foreach (split / /,$line) {
                     next unless $_; # skip  empty values (multiple spaces)
@@ -2438,7 +2460,7 @@ sub _koha_marc_update_bib_ids {
 
         # drop old field and create new one...
         $old_field = $record->field($biblio_tag);
-        $record->delete_field($old_field);
+        $record->delete_field($old_field) if $old_field;
         $record->append_fields($new_field);
 
         # deal with biblioitemnumber
@@ -2451,7 +2473,7 @@ sub _koha_marc_update_bib_ids {
         }
         # drop old field and create new one...
         $old_field = $record->field($biblioitem_tag);
-        $record->delete_field($old_field);
+        $record->delete_field($old_field) if $old_field;
         $record->insert_fields_ordered($new_field);
 
     } else {
@@ -2464,7 +2486,7 @@ sub _koha_marc_update_bib_ids {
 
         # drop old field and create new one...
         my $old_field = $record->field($biblio_tag);
-        $record->delete_field($old_field);
+        $record->delete_field($old_field) if $old_field;
         $record->insert_fields_ordered($new_field);
     }
 }
@@ -2946,13 +2968,19 @@ sub ModBiblioMarc {
                 MARC::Field->new( 100, "", "", "a" => $string ) );
         }
     }
-    ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
+    my $oldRecord;
+    if (C4::Context->preference("NoZebra")) {
+        # only NoZebra indexing needs to have
+        # the previous version of the record
+        $oldRecord = GetMarcBiblio($biblionumber);
+    }
     $sth =
       $dbh->prepare(
         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
         $biblionumber );
     $sth->finish;
+    ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
     return $biblionumber;
 }
 
@@ -3064,6 +3092,68 @@ sub set_service_options {
     return $serviceOptions;
 }
 
+=head3 get_biblio_authorised_values
+
+  find the types and values for all authorised values assigned to this biblio.
+
+  parameters:
+    biblionumber
+
+  returns: a hashref malling the authorised value to the value set for this biblionumber
+
+      $authorised_values = {
+                             'Scent'     => 'flowery',
+                             'Audience'  => 'Young Adult',
+                             'itemtypes' => 'SER',
+                           };
+
+  Notes: forlibrarian should probably be passed in, and called something different.
+
+
+=cut
+
+sub get_biblio_authorised_values {
+    my $biblionumber = shift;
+    
+    my $forlibrarian = 1; # are we in staff or opac?
+    my $frameworkcode = GetFrameworkCode( $biblionumber );
+
+    my $authorised_values;
+
+    my $record  = GetMarcBiblio( $biblionumber )
+      or return $authorised_values;
+    my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
+      or return $authorised_values;
+
+    # assume that these entries in the authorised_value table are bibliolevel.
+    # ones that start with 'item%' are item level.
+    my $query = q(SELECT distinct authorised_value, kohafield
+                    FROM marc_subfield_structure
+                    WHERE authorised_value !=''
+                      AND (kohafield like 'biblio%'
+                       OR  kohafield like '') );
+    my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
+    
+    foreach my $tag ( keys( %$tagslib ) ) {
+        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 $record->field( $tag ) ) {
+                        my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
+                        if ( defined $this_subfield_value ) {
+                            $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
+    return $authorised_values;
+}
+
+
 1;
 
 __END__