[REPLACE previous] Removing map calls in void context
[koha.git] / C4 / AuthoritiesMarc.pm
index 04210cc..089ce20 100644 (file)
@@ -118,10 +118,8 @@ sub SearchAuthorities {
         for(my $i = 0 ; $i <= $#{$value} ; $i++)
         {
             if (@$value[$i]){
-                if (@$tags[$i] eq "mainmainentry") {
-                    $query .=" AND mainmainentry";
-                }elsif (@$tags[$i] eq "mainentry") {
-                    $query .=" AND mainentry";
+                if (@$tags[$i] =~/mainentry|mainmainentry/) {
+                    $query .= qq( AND @$tags[$i] );
                 } else {
                     $query .=" AND ";
                 }
@@ -216,14 +214,14 @@ sub SearchAuthorities {
         }
         
         my $dosearch;
-        my $and;
+        my $and=" \@and " ;
         my $q2;
         for(my $i = 0 ; $i <= $#{$value} ; $i++)
         {
             if (@$value[$i]){
             ##If mainentry search $a tag
                 if (@$tags[$i] eq "mainmainentry") {
-                $attr =" \@attr 1=Heading ";
+                $attr =" \@attr 1=Heading-Main ";
                 }elsif (@$tags[$i] eq "mainentry") {
                 $attr =" \@attr 1=Heading ";
                 }else{
@@ -234,11 +232,10 @@ sub SearchAuthorities {
                 }elsif (@$operator[$i] eq "="){
                     $attr.=" \@attr 4=107 ";           #Number Exact match
                 }elsif (@$operator[$i] eq "start"){
-                    $attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated
+                    $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
                 }
-                $and .=" \@and " ;
                 $attr =$attr."\"".@$value[$i]."\"";
                 $q2 .=$attr;
             $dosearch=1;
@@ -404,7 +401,7 @@ sub GetAuthTypeCode {
   my $dbh=C4::Context->dbh;
   my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
   $sth->execute($authid);
-  my ($authtypecode) = $sth->fetchrow;
+  my $authtypecode = $sth->fetchrow;
   return $authtypecode;
 }
  
@@ -538,18 +535,20 @@ sub AddAuthority {
               ,'a'=>$date."afrey50      ba0")
           );
         }      
-  }    
-
+  }
   my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
   if (!$authid and $format eq "MARC21") {
     # only need to do this fix when modifying an existing authority
     C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
   } 
-
-  unless ($record->field($auth_type_tag) && $record->subfield($auth_type_tag, $auth_type_subfield)) {
+  if (my $field=$record->field($auth_type_tag)){
+    $field->update($auth_type_subfield=>$authtypecode);
+  }
+  else {
     $record->add_fields($auth_type_tag,'','', $auth_type_subfield=>$authtypecode); 
   }
 
+  my $auth_exists=0;
   my $oldRecord;
   if (!$authid) {
     my $sth=$dbh->prepare("select max(authid) from auth_header");
@@ -561,19 +560,23 @@ sub AddAuthority {
         $record->delete_field($record->field('001'));
         $record->insert_fields_ordered(MARC::Field->new('001',$authid));
     }
-#     warn $record->as_formatted;
-    $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
-    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
-    $sth->finish;
-  }else{
-      if (C4::Context->preference('NoZebra')) {
-        $oldRecord = GetAuthority($authid);
-      }
+  } else {
+    $auth_exists=$dbh->do(qq(select authid from auth_header where authid=?),undef,$authid);
+#     warn "auth_exists = $auth_exists";
+  }
+  if ($auth_exists>0){
+      $oldRecord=GetAuthority($authid);
       $record->add_fields('001',$authid) unless ($record->field('001'));
-      my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
-      $sth->execute($record->as_usmarc,$record->as_xml_record($format),$authid);
+#       warn "\n\n\n enregistrement".$record->as_formatted;
+      my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
+      $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr;
       $sth->finish;
   }
+  else {
+    my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
+    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
+    $sth->finish;
+  }
   ModZebra($authid,'specialUpdate',"authorityserver",$oldRecord,$record);
   return ($authid);
 }
@@ -603,18 +606,16 @@ sub DelAuthority {
 sub ModAuthority {
   my ($authid,$record,$authtypecode,$merge)=@_;
   my $dbh=C4::Context->dbh;
-#   my ($oldrecord)=&GetAuthority($authid);
-#   if ($oldrecord eq $record) {
-#       return;
-#   }
-#   my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
   #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('dontmerge') ){
+  if (C4::Context->preference('MergeAuthoritiesOnUpdate') ){
+      &merge($authid,$oldrecord,$authid,$record);
+  } else {
   # save the file in tmp/modified_authorities
       my $cgidir = C4::Context->intranetdir ."/cgi-bin";
       unless (opendir(DIR,"$cgidir")) {
@@ -626,8 +627,6 @@ sub ModAuthority {
       open AUTH, "> $filename";
       print AUTH $authid;
       close AUTH;
-  } else {
-#        &merge($authid,$record,$authid,$record);
   }
   return $authid;
 }
@@ -683,8 +682,9 @@ sub GetAuthority {
     my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?");
     $sth->execute($authid);
     my ($authtypecode, $marcxml) = $sth->fetchrow;
-    my $record=MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
-        (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
+    my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
+        (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
+    return undef if ($@);
     $record->encoding('UTF-8');
     if (C4::Context->preference("marcflavour") eq "MARC21") {
       my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
@@ -697,14 +697,14 @@ sub GetAuthority {
 
 =over 4
 
-$result= &GetAuthType( $authtypecode)
-If $authtypecode is not "" then 
-  Returns hashref to authtypecode information
-else 
-  returns ref to array of hashref information of all Authtypes
+$result = &GetAuthType($authtypecode)
 
 =back
 
+If the authority type specified by C<$authtypecode> exists,
+returns a hashref of the type's fields.  If the type
+does not exist, returns undef.
+
 =cut
 
 sub GetAuthType {
@@ -712,19 +712,14 @@ sub GetAuthType {
     my $dbh=C4::Context->dbh;
     my $sth;
     if (defined $authtypecode){ # NOTE - in MARC21 framework, '' is a valid authority 
-                                # type
-      $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
-      $sth->execute($authtypecode);
-    } else {
-      $sth=$dbh->prepare("select * from auth_types");
-      $sth->execute;
-    }
-    my $res=$sth->fetchall_arrayref({});
-    if (scalar(@$res)==1){
-      return $res->[0];
-    } else {
-      return $res;
+                                # type (FIXME but why?)
+        $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+        $sth->execute($authtypecode);
+        if (my $res = $sth->fetchrow_hashref) {
+            return $res; 
+        }
     }
+    return;
 }
 
 
@@ -801,8 +796,13 @@ 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 ($error,$results)=SimpleSearch($query,"authorityserver");
+    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) {
       my $marcrecord = MARC::File::USMARC::decode($results->[0]);
@@ -1153,80 +1153,119 @@ Then we should add some new parameter : bibliotargettag, authtargettag
 
 sub merge {
     my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
+    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
     my $dbh=C4::Context->dbh;
     my $authtypecodefrom = GetAuthTypeCode($mergefrom);
     my $authtypecodeto = GetAuthTypeCode($mergeto);
+#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
     # return if authority does not exist
     my @X = $MARCfrom->fields();
-    return if $#X == -1;
-    @X = $MARCto->fields();
-    return if $#X == -1;
+    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;
     # search the tag to report
     my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
     $sth->execute($authtypecodefrom);
-    my ($auth_tag_to_report) = $sth->fetchrow;
+    my ($auth_tag_to_report_from) = $sth->fetchrow;
+    $sth->execute($authtypecodeto);
+    my ($auth_tag_to_report_to) = $sth->fetchrow;
     
     my @record_to;
-    @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
+    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
     my @record_from;
-    @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
+    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
     
+    my @reccache;
     # search all biblio tags using this authority.
-    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
-    $sth->execute($authtypecodefrom);
-    my @tags_using_authtype;
-    while (my ($tagfield) = $sth->fetchrow) {
-        push @tags_using_authtype,$tagfield."9" ;
-    }
-
+    #Getting marcbiblios impacted by the change.
     if (C4::Context->preference('NoZebra')) {
-        warn "MERGE TO DO";
+        #nozebra way    
+        my $dbh=C4::Context->dbh;
+        my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
+        $rq->execute;
+        while (my $biblionumbers=$rq->fetchrow){
+            my @biblionumbers=split /;/,$biblionumbers;
+            foreach (@biblionumbers) {
+                my $biblionumber=$1 if ($_=~/(\d+),.*/);
+                my $marc=GetMarcBiblio($biblionumber);        
+                push @reccache,$marc;        
+            }
+        }
     } else {
-        # now, find every biblio using this authority
-        my $oConnection=C4::Context->Zconn("biblioserver");
+        #zebra connection  
+        my $oConnection=C4::Context->Zconn("biblioserver",0);
+        $oConnection->option("preferredRecordSyntax"=>"XML");
         my $query;
-        $query= "an= ".$mergefrom;
+        $query= "an=".$mergefrom;
         my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
         my $count=$oResult->size() if  ($oResult);
-        my @reccache;
         my $z=0;
         while ( $z<$count ) {
-        my $rec;
-                $rec=$oResult->record($z);
+            my $rec;
+            $rec=$oResult->record($z);
             my $marcdata = $rec->raw();
-        push @reccache, $marcdata;
+            push @reccache, $marcdata;
         $z++;
         }
-        $oResult->destroy();
-        foreach my $marc(@reccache){
-            my $update;
-            my $marcrecord;
-            $marcrecord = MARC::File::USMARC::decode($marc);
-            foreach my $tagfield (@tags_using_authtype){
-            $tagfield=substr($tagfield,0,3);
-            my @tags = $marcrecord->field($tagfield);
-            foreach my $tag (@tags){
-                my $tagsubs=$tag->subfield("9");
-            #warn "$tagfield:$tagsubs:$mergefrom";
-                if ($tagsubs== $mergefrom) {
-                $tag->update("9" =>$mergeto);
+        $oConnection->destroy();    
+    }
+    #warn scalar(@reccache)." biblios to update";
+    # Get All candidate Tags for the change 
+    # (This will reduce the search scope in marc records).
+    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+    $sth->execute($authtypecodefrom);
+    my @tags_using_authtype;
+    while (my ($tagfield) = $sth->fetchrow) {
+        push @tags_using_authtype,$tagfield ;
+    }
+    my $tag_to=0;  
+    if ($authtypecodeto ne $authtypecodefrom){  
+        # If many tags, take the first
+        $sth->execute($authtypecodeto);    
+        $tag_to=$sth->fetchrow;
+        #warn $tag_to;    
+    }  
+    # BulkEdit marc records
+    # May be used as a template for a bulkedit field  
+    foreach my $marcrecord(@reccache){
+        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 ";
+            foreach my $field ($marcrecord->field($tagfield)){
+                my $auth_number=$field->subfield("9");
+                my $tag=$field->tag();          
+                if ($auth_number==$mergefrom) {
+                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
                 foreach my $subfield (@record_to) {
-            #        warn "$subfield,$subfield->[0],$subfield->[1]";
-                    $tag->update($subfield->[0] =>$subfield->[1]);
-                }#for $subfield
+                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
                 }
-                $marcrecord->delete_field($tag);
-                $marcrecord->add_fields($tag);
+                $marcrecord->delete_field($field);
+                $marcrecord->insert_grouped_field($field_to);            
                 $update=1;
+                }
             }#for each tag
-            }#foreach tagfield
-            my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
-            if ($update==1){
-            &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
-            }
-            
-        }#foreach $marc
-    }
+        }#foreach tagfield
+        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
+        my $biblionumber;
+        if ($bibliotag<10){
+            $biblionumber=$marcrecord->field($bibliotag)->data;
+        }
+        else {
+            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
+        }
+        unless ($biblionumber){
+            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
+            next;
+        }
+        if ($update==1){
+            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
+            $counteditedbiblio++;
+            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
+        }    
+    }#foreach $marc
+    return $counteditedbiblio;  
+  # now, find every other authority linked with this authority
   # now, find every other authority linked with this authority
 #   my $oConnection=C4::Context->Zconn("authorityserver");
 #   my $query;