Bug 5549 : GetPendingIssues now returns DateTime objects
[koha.git] / C4 / AuthoritiesMarc.pm
index 0122ca8..c3b0db3 100644 (file)
@@ -17,9 +17,8 @@ package C4::AuthoritiesMarc;
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 use strict;
-#use warnings; FIXME - Bug 2505
+use warnings;
 use C4::Context;
-use C4::Koha;
 use MARC::Record;
 use C4::Biblio;
 use C4::Search;
@@ -41,7 +40,6 @@ BEGIN {
            &GetAuthType
            &GetAuthTypeCode
        &GetAuthMARCFromKohaField 
-       &AUTHhtml2marc
 
        &AddAuthority
        &ModAuthority
@@ -98,15 +96,16 @@ sub GetAuthMARCFromKohaField {
 =head2 SearchAuthorities 
 
   (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
-     $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby)
+     $excluding, $operator, $value, $offset,$length,$authtypecode,
+     $sortby[, $skipmetadata])
 
 returns ref to array result and count of results returned
 
 =cut
 
 sub SearchAuthorities {
-    my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_;
-#     warn "CALL : $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby";
+    my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_;
+    # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
     my $dbh=C4::Context->dbh;
     if (C4::Context->preference('NoZebra')) {
     
@@ -225,26 +224,45 @@ sub SearchAuthorities {
         for(my $i = 0 ; $i <= $#{$value} ; $i++)
         {
             if (@$value[$i]){
-            ##If mainentry search $a tag
-                if (@$tags[$i] eq "mainmainentry") {
-
-# FIXME: 'Heading-Main' index not yet defined in zebra
-#                $attr =" \@attr 1=Heading-Main "; 
-                $attr =" \@attr 1=Heading ";
-
-                }elsif (@$tags[$i] eq "mainentry") {
-                $attr =" \@attr 1=Heading ";
-                }else{
-                $attr =" \@attr 1=Any ";
+                if ( @$tags[$i] eq "mainmainentry" ) {
+                    $attr = " \@attr 1=Heading-Main ";
                 }
-                if (@$operator[$i] eq 'is') {
-                    $attr.=" \@attr 4=1  \@attr 5=100 ";##Phrase, No truncation,all of subfield field must match
-                }elsif (@$operator[$i] eq "="){
-                    $attr.=" \@attr 4=107 ";           #Number Exact match
-                }elsif (@$operator[$i] eq "start"){
-                    $attr.=" \@attr 3=2 \@attr 4=1 \@attr 5=1 ";#Firstinfield Phrase, Right truncated
-                } else {
-                    $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere
+                elsif ( @$tags[$i] eq "mainentry" ) {
+                    $attr = " \@attr 1=Heading ";
+                }
+                elsif ( @$tags[$i] eq "any" ) {
+                    $attr = " \@attr 1=Any ";
+                }
+                elsif ( @$tags[$i] eq "match" ) {
+                    $attr = " \@attr 1=Match ";
+                }
+                elsif ( @$tags[$i] eq "match-heading" ) {
+                    $attr = " \@attr 1=Match-heading ";
+                }
+                elsif ( @$tags[$i] eq "see-from" ) {
+                    $attr = " \@attr 1=Match-heading-see-from ";
+                }
+                elsif ( @$tags[$i] eq "thesaurus" ) {
+                    $attr = " \@attr 1=Subject-heading-thesaurus ";
+                }
+                if ( @$operator[$i] eq 'is' ) {
+                    $attr .= " \@attr 4=1  \@attr 5=100 "
+                      ; ##Phrase, No truncation,all of subfield field must match
+                }
+                elsif ( @$operator[$i] eq "=" ) {
+                    $attr .= " \@attr 4=107 ";    #Number Exact match
+                }
+                elsif ( @$operator[$i] eq "start" ) {
+                    $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 "
+                      ;    #Firstinfield Phrase, Right truncated
+                }
+                elsif ( @$operator[$i] eq "exact" ) {
+                    $attr .= " \@attr 4=1  \@attr 5=100 \@attr 6=3 "
+                      ; ##Phrase, No truncation,all of subfield field must match
+                }
+                else {
+                    $attr .= " \@attr 5=1 \@attr 4=6 "
+                      ;    ## Word list, right truncated, anywhere
                 }
                 @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value
                 $attr =$attr."\"".@$value[$i]."\"";
@@ -254,8 +272,8 @@ sub SearchAuthorities {
             }#if value
         }
         ##Add how many queries generated
-        if ($query=~/\S+/){
-          $query= $and x $attr_cnt . $query . $q2;
+        if (defined $query && $query=~/\S+/){
+          $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : '');
         } else {
           $query= $q2;
         }
@@ -312,35 +330,42 @@ sub SearchAuthorities {
             my $separator=C4::Context->preference('authoritysep');
             $authrecord = MARC::File::USMARC::decode($marcdata);
             my $authid=$authrecord->field('001')->data(); 
-            my $summary=BuildSummary($authrecord,$authid,$authtypecode);
-            my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
-            my $sth = $dbh->prepare($query_auth_tag);
-            $sth->execute($authtypecode);
-            my $auth_tag_to_report = $sth->fetchrow;
-            my $reported_tag;
-            my $mainentry = $authrecord->field($auth_tag_to_report);
-            if ($mainentry) {
-                foreach ($mainentry->subfields()) {
-                    $reported_tag .='$'.$_->[0].$_->[1];
-                }
-            }
             my %newline;
-            $newline{summary} = $summary;
             $newline{authid} = $authid;
-            $newline{even} = $counter % 2;
-            $newline{reported_tag} = $reported_tag;
+            if ( !$skipmetadata ) {
+                my $summary =
+                  BuildSummary( $authrecord, $authid, $authtypecode );
+                my $query_auth_tag =
+"SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
+                my $sth = $dbh->prepare($query_auth_tag);
+                $sth->execute($authtypecode);
+                my $auth_tag_to_report = $sth->fetchrow;
+                my $reported_tag;
+                my $mainentry = $authrecord->field($auth_tag_to_report);
+                if ($mainentry) {
+
+                    foreach ( $mainentry->subfields() ) {
+                        $reported_tag .= '$' . $_->[0] . $_->[1];
+                    }
+                }
+                $newline{summary}      = $summary;
+                $newline{even}         = $counter % 2;
+                $newline{reported_tag} = $reported_tag;
+            }
             $counter++;
             push @finalresult, \%newline;
             }## while counter
-        ###
-        for (my $z=0; $z<@finalresult; $z++){
-                my  $count=CountUsage($finalresult[$z]{authid});
-                $finalresult[$z]{used}=$count;
-        }# all $z's
-        
+            ###
+            if (! $skipmetadata) {
+                for (my $z=0; $z<@finalresult; $z++){
+                    my  $count=CountUsage($finalresult[$z]{authid});
+                    $finalresult[$z]{used}=$count;
+                }# all $z's
+            }
+
         }## if nbresult
         NOLUCK:
-        $oAResult->destroy();
+        $oAResult->destroy();
         # $oAuth[0]->destroy();
         
         return (\@finalresult, $nbresults);
@@ -367,7 +392,12 @@ sub CountUsage {
         my $query;
         $query= "an=".$authid;
                my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
-        return ($result);
+        if ($err) {
+            warn "Error: $err from search $query";
+            $result = 0;
+        }
+
+        return $result;
     }
 }
 
@@ -637,9 +667,16 @@ sub AddAuthority {
                }
                my $date=POSIX::strftime("%y%m%d",localtime);
                if (!$record->field('008')) {
-                       $record->insert_fields_ordered(
-                               MARC::Field->new('008',$date."|||a||||||           | |||     d")
-                       );
+            # Get a valid default value for field 008
+            my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
+            if(!$default_008 or length($default_008)<34) {
+                $default_008 = '|| aca||aabn           | a|a     d';
+            }
+            else {
+                $default_008 = substr($default_008,0,34);
+            }
+
+            $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) );
                }
                if (!$record->field('040')) {
                 $record->insert_fields_ordered(
@@ -651,17 +688,21 @@ sub AddAuthority {
     }
        }
 
-  if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){
+  if ($format eq "UNIMARCAUTH") {
         $record->leader("     nx  j22             ") unless ($record->leader());
         my $date=POSIX::strftime("%Y%m%d",localtime);    
-        if ($record->field('100')){
+    if (my $string=$record->subfield('100',"a")){
+       $string=~s/fre50/frey50/;
+       $record->field('100')->update('a'=>$string);
+    }
+    elsif ($record->field('100')){
           $record->field('100')->update('a'=>$date."afrey50      ba0");
-        } else {      
-          $record->append_fields(
-            MARC::Field->new('100',' ',' '
-              ,'a'=>$date."afrey50      ba0")
-          );
-        }      
+    } else {      
+        $record->append_fields(
+        MARC::Field->new('100',' ',' '
+            ,'a'=>$date."afrey50      ba0")
+        );
+    }      
   }
   my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
   if (!$authid and $format eq "MARC21") {
@@ -728,30 +769,33 @@ sub DelAuthority {
     $sth->execute($authid);
 }
 
+=head2 ModAuthority
+
+  $authid= &ModAuthority($authid,$record,$authtypecode)
+
+Modifies authority record, optionally updates attached biblios.
+
+=cut
+
 sub ModAuthority {
-  my ($authid,$record,$authtypecode,$merge)=@_;
+  my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed
+
   my $dbh=C4::Context->dbh;
   #Now rewrite the $record to table with an add
   my $oldrecord=GetAuthority($authid);
   $authid=AddAuthority($record,$authid,$authtypecode);
 
-### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
-### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
-### the $merge flag is now depreceated and will be removed at code cleaning
-  if (C4::Context->preference('MergeAuthoritiesOnUpdate') ){
+  # If a library thinks that updating all biblios is a long process and wishes
+  # to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
+  # In that case set system preference "dontmerge" to 1. Otherwise biblios will
+  # be updated.
+  unless(C4::Context->preference('dontmerge') eq '1'){
       &merge($authid,$oldrecord,$authid,$record);
   } else {
-  # save the file in tmp/modified_authorities
-      my $cgidir = C4::Context->intranetdir ."/cgi-bin";
-      unless (opendir(DIR,"$cgidir")) {
-              $cgidir = C4::Context->intranetdir."/";
-              closedir(DIR);
-      }
-  
-      my $filename = $cgidir."/tmp/modified_authorities/$authid.authid";
-      open AUTH, "> $filename";
-      print AUTH $authid;
-      close AUTH;
+      # save a record in need_merge_authorities table
+      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
+       "VALUES (?,?)";
+      $dbh->do($sqlinsert,undef,($authid,0));
   }
   logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
   return $authid;
@@ -838,53 +882,6 @@ sub GetAuthType {
 }
 
 
-sub AUTHhtml2marc {
-    my ($rtags,$rsubfields,$rvalues,%indicators) = @_;
-    my $dbh=C4::Context->dbh;
-    my $prevtag = -1;
-    my $record = MARC::Record->new();
-#---- TODO : the leader is missing
-
-#     my %subfieldlist=();
-    my $prevvalue; # if tag <10
-    my $field; # if tag >=10
-    for (my $i=0; $i< @$rtags; $i++) {
-        # rebuild MARC::Record
-        if (@$rtags[$i] ne $prevtag) {
-            if ($prevtag < 10) {
-                if ($prevvalue) {
-                    $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
-                }
-            } else {
-                if ($field) {
-                    $record->add_fields($field);
-                }
-            }
-            $indicators{@$rtags[$i]}.='  ';
-            if (@$rtags[$i] <10) {
-                $prevvalue= @$rvalues[$i];
-                undef $field;
-            } else {
-                undef $prevvalue;
-                $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
-            }
-            $prevtag = @$rtags[$i];
-        } else {
-            if (@$rtags[$i] <10) {
-                $prevvalue=@$rvalues[$i];
-            } else {
-                if (length(@$rvalues[$i])>0) {
-                    $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
-                }
-            }
-            $prevtag= @$rtags[$i];
-        }
-    }
-    # the last has not been included inside the loop... do it now !
-    $record->add_fields($field) if $field;
-    return $record;
-}
-
 =head2 FindDuplicateAuthority
 
   $record= &FindDuplicateAuthority( $record, $authtypecode)
@@ -916,7 +913,7 @@ sub FindDuplicateAuthority {
     }
     my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, 0, 1, [ "authorityserver" ] );
     # there is at least 1 result => return the 1st one
-    if (@$results>0) {
+    if (!defined $error && @{$results} ) {
       my $marcrecord = MARC::File::USMARC::decode($results->[0]);
       return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
     }
@@ -999,14 +996,14 @@ sub BuildSummary{
     $resultstring =~ s/\n/<br>/g;
        $summary      =  $resultstring;
   } else {
-    my $heading
-    my $altheading;
-    my $seealso;
-    my $broaderterms;
-    my $narrowerterms;
-    my $see;
-    my $seeheading;
-        my $notes;
+    my $heading = '';
+    my $altheading = '';
+    my $seealso = '';
+    my $broaderterms = '';
+    my $narrowerterms = '';
+    my $see = '';
+    my $seeheading = '';
+    my $notes = '';
     my @fields = $record->fields();
     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
     # construct UNIMARC summary, that is quite different from MARC21 one
@@ -1044,7 +1041,7 @@ sub BuildSummary{
             $narrowerterms =~s/-- \n$//;
             $seealso =~s/-- \n$//;
             $see =~s/-- \n$//;
-      $summary = "<b>".$heading."</b><br />".($notes?"$notes <br />":"");
+      $summary = $heading."<br />".($notes?"$notes <br />":"");
       $summary.= '<p><div class="label">TG : '.$broaderterms.'</div></p>' if ($broaderterms);
       $summary.= '<p><div class="label">TS : '.$narrowerterms.'</div></p>' if ($narrowerterms);
       $summary.= '<p><div class="label">TA : '.$seealso.'</div></p>' if ($seealso);
@@ -1069,8 +1066,8 @@ sub BuildSummary{
               } elsif ($record->field('148')) {
                                       $heading.= $field->as_string('abvxyz68');
               } elsif ($record->field('150')) {
-          #    $heading.= $field->as_string('abvxyz68');
-          $heading.= $field->as_formatted();
+                  $heading.= $field->as_string('abvxyz68');
+              #$heading.= $field->as_formatted();
               my $tag=$field->tag();
               $heading=~s /^$tag//g;
               $heading =~s /\_/\$/g;
@@ -1125,33 +1122,34 @@ sub BuildUnimarcHierarchies{
   my $data = GetHeaderAuthority($authid);
   if ($data->{'authtrees'} and not $force){
     return $data->{'authtrees'};
-  } elsif ($data->{'authtrees'}){
-    $hierarchies=$data->{'authtrees'};
+#  } elsif ($data->{'authtrees'}){
+#    $hierarchies=$data->{'authtrees'};
   } else {
     my $record = GetAuthority($authid);
     my $found;
-       if ($record){
-               foreach my $field ($record->field('550')){
-                 if ($field->subfield('5') && $field->subfield('5') eq 'g'){
-                       my $parentrecord = GetAuthority($field->subfield('3'));
-                       my $localresult=$hierarchies;
-                       my $trees;
-                       $trees = BuildUnimarcHierarchies($field->subfield('3'));
-                       my @trees;
-                       if ($trees=~/;/){
-                          @trees = split(/;/,$trees);
-                       } else {
-                          push @trees, $trees;
-                       }
-                       foreach (@trees){
-                         $_.= ",$authid";
-                       }
-                       @globalresult = (@globalresult,@trees);
-                       $found=1;
-                 }
-                 $hierarchies=join(";",@globalresult);
-               }
-       }
+    return unless $record;
+    foreach my $field ($record->field('5..')){
+      if ($field->subfield('5') && $field->subfield('5') eq 'g'){
+               my $subfauthid=_get_authid_subfield($field);
+        next if ($subfauthid eq $authid);
+        my $parentrecord = GetAuthority($subfauthid);
+        my $localresult=$hierarchies;
+        my $trees;
+        $trees = BuildUnimarcHierarchies($subfauthid);
+        my @trees;
+        if ($trees=~/;/){
+           @trees = split(/;/,$trees);
+        } else {
+           push @trees, $trees;
+        }
+        foreach (@trees){
+          $_.= ",$authid";
+        }
+        @globalresult = (@globalresult,@trees);
+        $found=1;
+      }
+      $hierarchies=join(";",@globalresult);
+    }
     #Unless there is no ancestor, I am alone.
     $hierarchies="$authid" unless ($hierarchies);
   }
@@ -1188,15 +1186,16 @@ sub BuildUnimarcHierarchy{
   my $parents=""; my $children="";
   my (@loopparents,@loopchildren);
   foreach my $field ($record->field('5..')){
-       my $subfauthid=_get_authid_subfield($field);
-    if ($field->subfield('5') && $field->subfield('a')){
-      if ($field->subfield('5') eq 'h'){
-        push @loopchildren, { "childauthid"=>$subfauthid,"childvalue"=>$field->subfield('a')};
-      }elsif ($field->subfield('5') eq 'g'){
-        push @loopparents, { "parentauthid"=>$subfauthid,"parentvalue"=>$field->subfield('a')};
-      }
+      my $subfauthid=_get_authid_subfield($field);
+      if ($subfauthid && $field->subfield('5') && $field->subfield('a')){
+          if ($field->subfield('5') eq 'h'){
+              push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')};
+         }
+         elsif ($field->subfield('5') eq 'g'){
+             push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')};
+         }
           # brothers could get in there with an else
-    }
+      }
   }
   $cell{"ifparents"}=1 if (scalar(@loopparents)>0);
   $cell{"ifchildren"}=1 if (scalar(@loopchildren)>0);
@@ -1299,6 +1298,7 @@ sub merge {
     } else {
         #zebra connection  
         my $oConnection=C4::Context->Zconn("biblioserver",0);
+        my $oldSyntax = $oConnection->option("preferredRecordSyntax");
         $oConnection->option("preferredRecordSyntax"=>"XML");
         my $query;
         $query= "an=".$mergefrom;
@@ -1315,7 +1315,8 @@ sub merge {
             push @reccache, $marcdata;
             $z++;
         }
-        $oConnection->destroy();    
+        $oResult->destroy();
+        $oConnection->option("preferredRecordSyntax"=>$oldSyntax);
     }
     #warn scalar(@reccache)." biblios to update";
     # Get All candidate Tags for the change 
@@ -1451,7 +1452,7 @@ sub get_auth_type_location {
     my $auth_type_code = @_ ? shift : '';
 
     my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code);
-    if (defined $tag and defined $subfield and $tag != 0 and $subfield != 0) {
+    if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') {
         return ($tag, $subfield);
     } else {
         if (C4::Context->preference('marcflavour') eq "MARC21")  {