Bug 2400 [11/18]: fixing pod syntax in C4/Labels.pm
[koha_fer] / C4 / AuthoritiesMarc.pm
index 40a943e..a5102a6 100644 (file)
@@ -24,6 +24,7 @@ use C4::Biblio;
 use C4::Search;
 use C4::AuthoritiesMarc::MARC21;
 use C4::AuthoritiesMarc::UNIMARC;
+use C4::Charset;
 
 use vars qw($VERSION @ISA @EXPORT);
 
@@ -251,8 +252,14 @@ sub SearchAuthorities {
         }         
         ## Adding order
         #$query=' @or  @attr 7=2 @attr 1=Heading 0 @or  @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc");
-       $query=' @or  @attr 7=1 @attr 1=Heading 0'.$query if ($sortby eq "HeadingAsc");
-       $query=' @or  @attr 7=2 @attr 1=Heading 0'.$query if ($sortby eq "HeadingDsc");
+        my $orderstring= ($sortby eq "HeadingAsc"?
+                           '@attr 7=1 @attr 1=Heading 0'
+                         :
+                           $sortby eq "HeadingDsc"?      
+                            '@attr 7=2 @attr 1=Heading 0'
+                           :''
+                        );            
+        $query=($query?"\@or $orderstring $query":"\@or \@attr 1=_ALLRECORDS \@attr 2=103 '' $orderstring ");
         
         $offset=0 unless $offset;
         my $counter = $offset;
@@ -531,8 +538,7 @@ 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
@@ -543,6 +549,7 @@ sub AddAuthority {
     $record->add_fields($auth_type_tag,'','', $auth_type_subfield=>$authtypecode); 
   }
 
+  my $oldRecord;
   if (!$authid) {
     my $sth=$dbh->prepare("select max(authid) from auth_header");
     $sth->execute;
@@ -554,19 +561,20 @@ sub AddAuthority {
         $record->insert_fields_ordered(MARC::Field->new('001',$authid));
     }
 #     warn $record->as_formatted;
-    $dbh->do("lock tables auth_header WRITE");
     $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);
+      }
       $record->add_fields('001',$authid) unless ($record->field('001'));
-      $dbh->do("lock tables auth_header WRITE");
       my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
       $sth->execute($record->as_usmarc,$record->as_xml_record($format),$authid);
       $sth->finish;
+      $dbh->do("unlock tables");
   }
-  $dbh->do("unlock tables");
-  ModZebra($authid,'specialUpdate',"authorityserver",$record);
+  ModZebra($authid,'specialUpdate',"authorityserver",$oldRecord,$record);
   return ($authid);
 }
 
@@ -587,7 +595,7 @@ sub DelAuthority {
     my ($authid) = @_;
     my $dbh=C4::Context->dbh;
 
-    ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid));
+    ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef);
     $dbh->do("delete from auth_header where authid=$authid") ;
 
 }
@@ -595,12 +603,8 @@ 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
@@ -619,7 +623,7 @@ sub ModAuthority {
       print AUTH $authid;
       close AUTH;
   } else {
-#        &merge($authid,$record,$authid,$record);
+      &merge($authid,$oldrecord,$authid,$record);
   }
   return $authid;
 }
@@ -675,7 +679,8 @@ 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($marcxml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
+    my $record=MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
+        (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
     $record->encoding('UTF-8');
     if (C4::Context->preference("marcflavour") eq "MARC21") {
       my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
@@ -688,14 +693,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 {
@@ -703,19 +708,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;
 }
 
 
@@ -793,7 +793,7 @@ sub FindDuplicateAuthority {
     # 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 ($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]);
@@ -1144,14 +1144,15 @@ 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);
     # return if authority does not exist
     my @X = $MARCfrom->fields();
-    return if $#X == -1;
+    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if $#X == -1;
     @X = $MARCto->fields();
-    return if $#X == -1;
+    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);
@@ -1162,62 +1163,83 @@ sub merge {
     my @record_from;
     @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
     
+    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;
+            map {
+                my $biblionumber=$1 if ($_=~/(\d+),.*/);
+                my $marc=GetMarcBiblio($biblionumber);        
+                push @reccache,$marc;        
+            } @biblionumbers;
+        }
     } else {
-        # now, find every biblio using this authority
-        my $oConnection=C4::Context->Zconn("biblioserver");
+        #zebra connection  
+        my $oConnection=C4::Context->Zconn("biblioserver",0);
         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);
-                foreach my $subfield (@record_to) {
-            #        warn "$subfield,$subfield->[0],$subfield->[1]";
-                    $tag->update($subfield->[0] =>$subfield->[1]);
-                }#for $subfield
+        $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::File::USMARC::decode($marcrecord) unless(C4::Context->preference('NoZebra'));
+        foreach my $tagfield (@tags_using_authtype){
+            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) {
+                        $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
+                    }
+                    $marcrecord->delete_field($field);
+                    $marcrecord->insert_grouped_field($field_to);            
+                    $update=1;
                 }
-                $marcrecord->delete_field($tag);
-                $marcrecord->add_fields($tag);
-                $update=1;
             }#for each tag
-            }#foreach tagfield
-            my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
-            if ($update==1){
+        }#foreach tagfield
+        my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
+        if ($update==1){
             &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
-            }
-            
-        }#foreach $marc
-    }
+            $counteditedbiblio++;
+            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
+        }    
+    }#foreach $marc
+    return $counteditedbiblio;  
   # now, find every other authority linked with this authority
 #   my $oConnection=C4::Context->Zconn("authorityserver");
 #   my $query;