Merge commit 'workbuffer.org-koha/translation' into to-push
[koha.git] / C4 / AuthoritiesMarc.pm
index a5102a6..3d4564e 100644 (file)
@@ -57,6 +57,9 @@ BEGIN {
     
        &merge
        &FindDuplicateAuthority
+
+        &GuessAuthTypeCode
+        &GuessAuthId
        );
 }
 
@@ -118,10 +121,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 +217,18 @@ 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") {
+
+# 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{
@@ -234,11 +239,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;
@@ -357,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);
     }
 }
@@ -404,10 +400,111 @@ 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;
 }
  
+=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
@@ -522,11 +619,48 @@ sub AddAuthority {
 # pass the MARC::Record to this function, and it will create the records in the authority table
   my ($record,$authid,$authtypecode) = @_;
   my $dbh=C4::Context->dbh;
-  my $leader='         a              ';##Fixme correct leader as this one just adds utf8 to MARC21
+       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) {
+                       $record->leader($leader);
+               }
+               if (!$record->field('003')) {
+                       $record->insert_fields_ordered(
+                               MARC::Field->new('003',C4::Context->preference('MARCOrgCode'))
+                       );
+               }
+               my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
+               if (!$record->field('005')) {
+                       $record->insert_fields_ordered(
+                               MARC::Field->new('005',$time.".0")
+                       );
+               }
+               my $date=POSIX::strftime("%y%m%d",localtime);
+               if (!$record->field('008')) {
+                       $record->insert_fields_ordered(
+                               MARC::Field->new('008',$date."|||a||||||           | |||     d")
+                       );
+               }
+               if (!$record->field('040')) {
+                $record->insert_fields_ordered(
+        MARC::Field->new('040','','',
+                               'a' => C4::Context->preference('MARCOrgCode'),
+                               'c' => C4::Context->preference('MARCOrgCode')
+                               ) 
+                       );
+    }
+       }
+
   if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){
         $record->leader("     nx  j22             ");
         my $date=POSIX::strftime("%Y%m%d",localtime);    
@@ -544,11 +678,14 @@ sub AddAuthority {
     # 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");
@@ -560,19 +697,22 @@ 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;
-      $dbh->do("unlock tables");
+  }
+  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);
@@ -610,7 +750,9 @@ sub ModAuthority {
 ### 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")) {
@@ -622,8 +764,6 @@ sub ModAuthority {
       open AUTH, "> $filename";
       print AUTH $authid;
       close AUTH;
-  } else {
-      &merge($authid,$oldrecord,$authid,$record);
   }
   return $authid;
 }
@@ -642,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');
   }
 }
 
@@ -679,8 +818,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);
@@ -792,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) {
@@ -854,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();
@@ -868,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;
@@ -889,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
@@ -1009,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);
   }
@@ -1062,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);
@@ -1083,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;
 }
 
@@ -1148,20 +1302,21 @@ sub merge {
     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 "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if $#X == -1;
-    @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);
-    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.
@@ -1173,26 +1328,31 @@ 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  
         my $oConnection=C4::Context->Zconn("biblioserver",0);
+        $oConnection->option("preferredRecordSyntax"=>"XML");
         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();    
     }
@@ -1216,31 +1376,44 @@ sub merge {
     # 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'));
+        $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) {
-                        $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
-                    }
-                    $marcrecord->delete_field($field);
-                    $marcrecord->insert_grouped_field($field_to);            
-                    $update=1;
+                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;
                 }
             }#for each tag
         }#foreach tagfield
-        my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
+        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,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
+            &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;
 # # att 9210               Auth-Internal-authtype