Merge commit 'workbuffer.org-koha/translation' into to-push
[koha.git] / C4 / AuthoritiesMarc.pm
index fb33afe..3d4564e 100644 (file)
@@ -57,6 +57,9 @@ BEGIN {
     
        &merge
        &FindDuplicateAuthority
+
+        &GuessAuthTypeCode
+        &GuessAuthId
        );
 }
 
@@ -358,17 +361,9 @@ sub CountUsage {
         return scalar @tab;
     } else {
         ### ZOOM search here
-        my $oConnection=C4::Context->Zconn("biblioserver",1);
         my $query;
         $query= "an=".$authid;
-        my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
-        my $result;
-        while ((my $i = ZOOM::event([ $oConnection ])) != 0) {
-            my $ev = $oConnection->last_event();
-            if ($ev == ZOOM::Event::ZEND) {
-                $result = $oResult->size();
-            }
-        }
+               my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
         return ($result);
     }
 }
@@ -409,6 +404,107 @@ sub GetAuthTypeCode {
   return $authtypecode;
 }
  
+=head2 GuessAuthTypeCode
+
+=over 4
+
+my $authtypecode = GuessAuthTypeCode($record);
+
+=back
+
+Get the record and tries to guess the adequate authtypecode from its content.
+
+=cut
+
+sub GuessAuthTypeCode {
+    my ($record) = @_;
+    return unless defined $record;
+my $heading_fields = {
+    "MARC21"=>{
+        '100'=>{authtypecode=>'PERSO_NAME'},
+        '110'=>{authtypecode=>'CORPO_NAME'},
+        '111'=>{authtypecode=>'MEETI_NAME'},
+        '130'=>{authtypecode=>'UNIF_TITLE'},
+        '148'=>{authtypecode=>'CHRON_TERM'},
+        '150'=>{authtypecode=>'TOPIC_TERM'},
+        '151'=>{authtypecode=>'GEOGR_NAME'},
+        '155'=>{authtypecode=>'GENRE/FORM'},
+        '180'=>{authtypecode=>'GEN_SUBDIV'},
+        '181'=>{authtypecode=>'GEO_SUBDIV'},
+        '182'=>{authtypecode=>'CHRON_SUBD'},
+        '185'=>{authtypecode=>'FORM_SUBD'},
+    },
+#200 Personal name     700, 701, 702 4-- with embedded 700, 701, 702 600
+#                    604 with embedded 700, 701, 702
+#210 Corporate or meeting name 710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712
+#215 Territorial or geographic name    710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712
+#216 Trademark         716 [Reserved for future use]
+#220 Family name       720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722
+#230 Title     500 4-- with embedded 500 605
+#240 Name and title (embedded 200, 210, 215, or 220 and 230)   4-- with embedded 7-- and 500 7--  604 with embedded 7-- and 500 500
+#245 Name and collective title (embedded 200, 210, 215, or 220 and 235)        4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501
+#250 Topical subject   606
+#260 Place access      620
+#280 Form, genre or physical characteristics   608
+#
+#
+# Could also be represented with :
+#leader position 9
+#a = personal name entry
+#b = corporate name entry
+#c = territorial or geographical name
+#d = trademark
+#e = family name
+#f = uniform title
+#g = collective uniform title
+#h = name/title
+#i = name/collective uniform title
+#j = topical subject
+#k = place access
+#l = form, genre or physical characteristics
+    "UNIMARC"=>{
+        '200'=>{authtypecode=>'NP'},
+        '210'=>{authtypecode=>'CO'},
+        '215'=>{authtypecode=>'SNG'},
+        '216'=>{authtypecode=>'TM'},
+        '220'=>{authtypecode=>'FAM'},
+        '230'=>{authtypecode=>'TU'},
+        '235'=>{authtypecode=>'CO_UNI_TI'},
+        '240'=>{authtypecode=>'SAUTTIT'},
+        '245'=>{authtypecode=>'NAME_COL'},
+        '250'=>{authtypecode=>'SNC'},
+        '260'=>{authtypecode=>'PA'},
+        '280'=>{authtypecode=>'GENRE/FORM'},
+    }
+};
+    foreach my $field (keys %{$heading_fields->{uc(C4::Context->preference('marcflavour'))} }) {
+       return $heading_fields->{uc(C4::Context->preference('marcflavour'))}->{$field}->{'authtypecode'} if (defined $record->field($field));
+    }
+    return;
+}
+
+=head2 GuessAuthId
+
+=over 4
+
+my $authtid = GuessAuthId($record);
+
+=back
+
+Get the record and tries to guess the adequate authtypecode from its content.
+
+=cut
+
+sub GuessAuthId {
+    my ($record) = @_;
+    return unless ($record && $record->field('001'));
+#    my $authtypecode=GuessAuthTypeCode($record);
+#    my ($tag,$subfield)=GetAuthMARCFromKohaField("auth_header.authid",$authtypecode);
+#    if ($tag > 010) {return $record->subfield($tag,$subfield)}
+#    else {return $record->field($tag)->data}
+    return $record->field('001')->data;
+}
+
 =head2 GetTagsLabels
 
 =over 4
@@ -526,8 +622,13 @@ sub AddAuthority {
        my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
 
 # if authid empty => true add, find a new authid number
-  my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC');
-  $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC');
+    my $format;
+    if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
+        $format= 'UNIMARCAUTH';
+    }
+    else {
+        $format= 'MARC21';
+    }
 
        if ($format eq "MARC21") {
                if (!$record->leader) {
@@ -681,23 +782,22 @@ returns xml form of record $authid
 sub GetAuthorityXML {
   # Returns MARC::XML of the authority passed in parameter.
   my ( $authid ) = @_;
-  my $format= 'UNIMARCAUTH' if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC');
-  $format= 'MARC21' if (uc(C4::Context->preference('marcflavour')) ne 'UNIMARC');
-  if ($format eq "MARC21") {
-    # for MARC21, call GetAuthority instead of
-    # getting the XML directly since we may
-    # need to fix up the location of the authority
-    # code -- note that this is reasonably safe
-    # because GetAuthorityXML is used only by the 
-    # indexing processes like zebraqueue_start.pl
-    my $record = GetAuthority($authid);
-    return $record->as_xml_record($format);
-  } else {
-    my $dbh=C4::Context->dbh;
-    my $sth = $dbh->prepare("select marcxml from auth_header where authid=? "  );
-    $sth->execute($authid);
-    my ($marcxml)=$sth->fetchrow;
-    return $marcxml;
+  if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
+      my $dbh=C4::Context->dbh;
+      my $sth = $dbh->prepare("select marcxml from auth_header where authid=? "  );
+      $sth->execute($authid);
+      my ($marcxml)=$sth->fetchrow;
+      return $marcxml;
+  }
+  else { 
+      # for MARC21, call GetAuthority instead of
+      # getting the XML directly since we may
+      # need to fix up the location of the authority
+      # code -- note that this is reasonably safe
+      # because GetAuthorityXML is used only by the 
+      # indexing processes like zebraqueue_start.pl
+      my $record = GetAuthority($authid);
+      return $record->as_xml_record('MARC21');
   }
 }
 
@@ -832,7 +932,12 @@ sub FindDuplicateAuthority {
 #     warn "record :".$record->as_formatted."  auth_tag_to_report :$auth_tag_to_report";
     # build a request for SearchAuthorities
     my $query='at='.$authtypecode.' ';
-    map {$query.= " and he=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/)}  $record->field($auth_tag_to_report)->subfields() if $record->field($auth_tag_to_report);
+    my $filtervalues=qr([\001-\040\!\'\"\`\#\$\%\&\*\+,\-\./:;<=>\?\@\(\)\{\[\]\}_\|\~]);
+    if ($record->field($auth_tag_to_report)) {
+      foreach ($record->field($auth_tag_to_report)->subfields()) {
+        $_->[1]=~s/$filtervalues/ /g; $query.= " and he,wrdl=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
+      }
+    }
     my ($error, $results, $total_hits)=SimpleSearch( $query, 0, 1, [ "authorityserver" ] );
     # there is at least 1 result => return the 1st one
     if (@$results>0) {
@@ -894,10 +999,12 @@ sub BuildSummary{
   if ($summary and C4::Context->preference('marcflavour') eq 'UNIMARC') {
     my @fields = $record->fields();
     #             $reported_tag = '$9'.$result[$counter];
+       my @stringssummary;
     foreach my $field (@fields) {
       my $tag = $field->tag();
       my $tagvalue = $field->as_string();
-      $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
+      my $localsummary= $summary;
+         $localsummary =~ s/\[(.?.?.?.?)$tag\*(.*?)\]/$1$tagvalue$2\[$1$tag$2\]/g;
       if ($tag<10) {
         if ($tag eq '001') {
           $reported_tag.='$3'.$field->data();
@@ -908,15 +1015,18 @@ sub BuildSummary{
           my $subfieldcode = $subf[$i][0];
           my $subfieldvalue = $subf[$i][1];
           my $tagsubf = $tag.$subfieldcode;
-          $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
+          $localsummary =~ s/\[(.?.?.?.?)$tagsubf(.*?)\]/$1$subfieldvalue$2\[$1$tagsubf$2\]/g;
         }
       }
+         push @stringssummary, $localsummary if ($localsummary ne $summary);
     }
-    $summary =~ s/\[(.*?)]//g;
-    $summary =~ s/\n/<br>/g;
+       my $resultstring;
+       $resultstring = join(" -- ",@stringssummary);
+    $resultstring =~ s/\[(.*?)\]//g;
+    $resultstring =~ s/\n/<br>/g;
+       $summary      =  $resultstring;
   } else {
     my $heading; 
-    my $authid; 
     my $altheading;
     my $seealso;
     my $broaderterms;
@@ -929,26 +1039,27 @@ sub BuildSummary{
     # construct UNIMARC summary, that is quite different from MARC21 one
       # accepted form
       foreach my $field ($record->field('2..')) {
-        $heading.= $field->subfield('a');
-                $authid=$field->subfield('3');
+        $heading.= $field->as_string('abcdefghijlmnopqrstuvwxyz');
       }
       # rejected form(s)
       foreach my $field ($record->field('3..')) {
         $notes.= '<span class="note">'.$field->subfield('a')."</span>\n";
       }
       foreach my $field ($record->field('4..')) {
-        my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : " if ($field->subfield('2'));
-        $see.= '<span class="UF">'.$thesaurus.$field->subfield('a')."</span> -- \n";
+        if ($field->subfield('2')) {
+            my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : ";
+            $see.= '<span class="UF">'.$thesaurus.$field->as_string('abcdefghijlmnopqrstuvwxyz')."</span> -- \n";
+        }
       }
       # see :
       foreach my $field ($record->field('5..')) {
             
         if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) {
-          $broaderterms.= '<span class="BT"> <a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
-        } elsif (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'h')){
-          $narrowerterms.= '<span class="NT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+          $broaderterms.= '<span class="BT"> '.$field->as_string('abcdefgjxyz')."</span> -- \n";
+        } elsif (($field->subfield('5')) && ($field->as_string) && ($field->subfield('5') eq 'h')){
+          $narrowerterms.= '<span class="NT">'.$field->as_string('abcdefgjxyz')."</span> -- \n";
         } elsif ($field->subfield('a')) {
-          $seealso.= '<span class="RT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+          $seealso.= '<span class="RT">'.$field->as_string('abcdefgxyz')."</a></span> -- \n";
         }
       }
       # // form
@@ -1049,26 +1160,28 @@ sub BuildUnimarcHierarchies{
   } else {
     my $record = GetAuthority($authid);
     my $found;
-    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);
-    }
+       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);
+               }
+       }
     #Unless there is no ancestor, I am alone.
     $hierarchies="$authid" unless ($hierarchies);
   }
@@ -1102,7 +1215,8 @@ sub BuildUnimarcHierarchy{
   my $record = shift @_;
   my $class = shift @_;
   my $authid_constructed = shift @_;
-  my $authid=$record->subfield('250','3');
+  return undef unless ($record);
+  my $authid=$record->subfield('2..','3');
   my %cell;
   my $parents=""; my $children="";
   my (@loopparents,@loopchildren);
@@ -1123,7 +1237,7 @@ sub BuildUnimarcHierarchy{
   $cell{"class"}=$class;
   $cell{"loopauthid"}=$authid;
   $cell{"current_value"} =1 if $authid eq $authid_constructed;
-  $cell{"value"}=$record->subfield('250',"a");
+  $cell{"value"}=$record->subfield('2..',"a");
   return \%cell;
 }
 
@@ -1188,12 +1302,10 @@ sub merge {
     my $dbh=C4::Context->dbh;
     my $authtypecodefrom = GetAuthTypeCode($mergefrom);
     my $authtypecodeto = GetAuthTypeCode($mergeto);
-    warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
+    warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
     # return if authority does not exist
-    my @X = $MARCfrom->fields();
-    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if $#X == -1;
-    my @X = $MARCto->fields();
-    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if $#X == -1;
+    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
+    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
     # search the tag to report
     my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
     $sth->execute($authtypecodefrom);
@@ -1216,11 +1328,12 @@ sub merge {
         $rq->execute;
         while (my $biblionumbers=$rq->fetchrow){
             my @biblionumbers=split /;/,$biblionumbers;
-            map {
-                my $biblionumber=$1 if ($_=~/(\d+),.*/);
-                my $marc=GetMarcBiblio($biblionumber);        
-                push @reccache,$marc;        
-            } @biblionumbers;
+            foreach (@biblionumbers) {
+                if ($_=~/(\d+),.*/) {
+                    my $marc=GetMarcBiblio($1);
+                    push @reccache,$marc;
+                }
+            }
         }
     } else {
         #zebra connection  
@@ -1229,14 +1342,17 @@ sub merge {
         my $query;
         $query= "an=".$mergefrom;
         my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
-        my $count=$oResult->size() if  ($oResult);
+        my $count = 0;
+        if  ($oResult) {
+            $count=$oResult->size();
+        }
         my $z=0;
         while ( $z<$count ) {
             my $rec;
             $rec=$oResult->record($z);
             my $marcdata = $rec->raw();
             push @reccache, $marcdata;
-        $z++;
+            $z++;
         }
         $oConnection->destroy();    
     }
@@ -1262,7 +1378,7 @@ sub merge {
         my $update;           
         $marcrecord= MARC::Record->new_from_xml($marcrecord,"utf8",C4::Context->preference("marcflavour")) unless(C4::Context->preference('NoZebra'));
         foreach my $tagfield (@tags_using_authtype){
-            warn "tagfield : $tagfield ";
+            warn "tagfield : $tagfield ";
             foreach my $field ($marcrecord->field($tagfield)){
                 my $auth_number=$field->subfield("9");
                 my $tag=$field->tag();