| Lines 16-23
          package C4::AuthoritiesMarc;
      
      
        Link Here | 
        
          | 16 | # You should have received a copy of the GNU General Public License | 16 | # You should have received a copy of the GNU General Public License | 
        
          | 17 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 17 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 
        
          | 18 |  | 18 |  | 
          
            
              | 19 | use strict; | 19 | use Modern::Perl; | 
            
              | 20 | use warnings; | 20 | use YAML; | 
        
          | 21 | use C4::Context; | 21 | use C4::Context; | 
        
          | 22 | use MARC::Record; | 22 | use MARC::Record; | 
        
          | 23 | use C4::Biblio; | 23 | use C4::Biblio; | 
  
    | Lines 27-68
          use C4::AuthoritiesMarc::UNIMARC;
      
      
        Link Here | 
        
          | 27 | use C4::Charset; | 27 | use C4::Charset; | 
        
          | 28 | use C4::Log; | 28 | use C4::Log; | 
        
          | 29 | use Koha::Authority; | 29 | use Koha::Authority; | 
            
              |  |  | 30 | use Koha::Cache; | 
        
          | 30 |  | 31 |  | 
        
          | 31 | use vars qw($VERSION @ISA @EXPORT); | 32 | use vars qw($VERSION @ISA @EXPORT); | 
        
          | 32 |  | 33 |  | 
        
          | 33 | BEGIN { | 34 | BEGIN { | 
          
            
              | 34 | 	# set the version for version checking | 35 |     # set the version for version checking | 
        
          | 35 |     $VERSION = 3.07.00.049; | 36 |     $VERSION = 3.07.00.049; | 
        
          | 36 |  | 37 |  | 
          
            
              | 37 | 	require Exporter; | 38 |     require Exporter; | 
            
              | 38 | 	@ISA = qw(Exporter); | 39 |     @ISA = qw(Exporter); | 
            
              | 39 | 	@EXPORT = qw( | 40 |     @EXPORT = qw( | 
            
              | 40 | 	    &GetTagsLabels | 41 |         &GetTagsLabels | 
            
              | 41 | 	    &GetAuthType | 42 |         &GetAuthType | 
            
              | 42 | 	    &GetAuthTypeCode | 43 |         &GetAuthTypeCode | 
            
              | 43 |     	&GetAuthMARCFromKohaField  | 44 |         &GetAuthMARCFromKohaField | 
            
              | 44 |  | 45 |  | 
            
              | 45 |     	&AddAuthority | 46 |         &AddAuthority | 
            
              | 46 |     	&ModAuthority | 47 |         &ModAuthority | 
            
              | 47 |     	&DelAuthority | 48 |         &DelAuthority | 
            
              | 48 |     	&GetAuthority | 49 |         &GetAuthority | 
            
              | 49 |     	&GetAuthorityXML | 50 |         &GetAuthorityXML | 
            
              | 50 |  | 51 |         &GetBibliosByAuthid | 
            
              | 51 |     	&CountUsage | 52 |  | 
            
              | 52 |     	&CountUsageChildren | 53 |         &CountUsage | 
            
              | 53 |     	&SearchAuthorities | 54 |         &CountUsageChildren | 
            
              | 54 |      | 55 |         &SearchAuthorities | 
            
              |  |  | 56 |  | 
        
          | 55 |         &BuildSummary | 57 |         &BuildSummary | 
        
          | 56 |         &BuildAuthHierarchies | 58 |         &BuildAuthHierarchies | 
        
          | 57 |         &BuildAuthHierarchy | 59 |         &BuildAuthHierarchy | 
        
          | 58 |         &GenerateHierarchy | 60 |         &GenerateHierarchy | 
          
            
              | 59 |      | 61 |  | 
            
              | 60 |     	&merge | 62 |         &merge | 
            
              | 61 |     	&FindDuplicateAuthority | 63 |         &FindDuplicateAuthority | 
        
          | 62 |  | 64 |  | 
        
          | 63 |         &GuessAuthTypeCode | 65 |         &GuessAuthTypeCode | 
        
          | 64 |         &GuessAuthId | 66 |         &GuessAuthId | 
          
            
              | 65 |  	); | 67 |     ); | 
        
          | 66 | } | 68 | } | 
        
          | 67 |  | 69 |  | 
        
          | 68 |  | 70 |  | 
  
    | Lines 91-97
          sub GetAuthMARCFromKohaField {
      
      
        Link Here | 
        
          | 91 |   my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); | 93 |   my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); | 
        
          | 92 |   $sth->execute($kohafield,$authtypecode); | 94 |   $sth->execute($kohafield,$authtypecode); | 
        
          | 93 |   my ($tagfield,$tagsubfield) = $sth->fetchrow; | 95 |   my ($tagfield,$tagsubfield) = $sth->fetchrow; | 
          
            
              | 94 |      | 96 |  | 
        
          | 95 |   return  ($tagfield,$tagsubfield); | 97 |   return  ($tagfield,$tagsubfield); | 
        
          | 96 | } | 98 | } | 
        
          | 97 |  | 99 |  | 
  
    | Lines 271-277
          sub SearchAuthorities {
      
      
        Link Here | 
        
          | 271 |     # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); | 273 |     # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]); | 
        
          | 272 |     # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); | 274 |     # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]); | 
        
          | 273 |         while (($counter < $nbresults) && ($counter < ($offset + $length))) { | 275 |         while (($counter < $nbresults) && ($counter < ($offset + $length))) { | 
          
            
              | 274 |          | 276 |  | 
        
          | 275 |         ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES | 277 |         ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES | 
        
          | 276 |         my $rec=$oAResult->record($counter); | 278 |         my $rec=$oAResult->record($counter); | 
        
          | 277 |         my $separator=C4::Context->preference('AuthoritySeparator'); | 279 |         my $separator=C4::Context->preference('AuthoritySeparator'); | 
  
    | Lines 349-355
          sub CountUsage {
      
      
        Link Here | 
        
          | 349 |         ### ZOOM search here | 351 |         ### ZOOM search here | 
        
          | 350 |         my $query; | 352 |         my $query; | 
        
          | 351 |         $query= "an:".$authid; | 353 |         $query= "an:".$authid; | 
          
            
              | 352 |   		my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); | 354 |                   my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); | 
        
          | 353 |         if ($err) { | 355 |         if ($err) { | 
        
          | 354 |             warn "Error: $err from search $query"; | 356 |             warn "Error: $err from search $query"; | 
        
          | 355 |             $result = 0; | 357 |             $result = 0; | 
  
    | Lines 414-431
          sub GuessAuthTypeCode {
      
      
        Link Here | 
        
          | 414 |         '182'=>{authtypecode=>'CHRON_SUBD'}, | 416 |         '182'=>{authtypecode=>'CHRON_SUBD'}, | 
        
          | 415 |         '185'=>{authtypecode=>'FORM_SUBD'}, | 417 |         '185'=>{authtypecode=>'FORM_SUBD'}, | 
        
          | 416 |     }, | 418 |     }, | 
          
            
              | 417 | #200 Personal name	700, 701, 702 4-- with embedded 700, 701, 702 600 | 419 | #200 Personal name        700, 701, 702 4-- with embedded 700, 701, 702 600 | 
        
          | 418 | #                    604 with embedded 700, 701, 702 | 420 | #                    604 with embedded 700, 701, 702 | 
          
            
              | 419 | #210 Corporate or meeting name	710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712 | 421 | #210 Corporate or meeting name        710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712 | 
            
              | 420 | #215 Territorial or geographic name 	710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712 | 422 | #215 Territorial or geographic name         710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712 | 
            
              | 421 | #216 Trademark 	716 [Reserved for future use] | 423 | #216 Trademark         716 [Reserved for future use] | 
            
              | 422 | #220 Family name 	720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722 | 424 | #220 Family name         720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722 | 
            
              | 423 | #230 Title 	500 4-- with embedded 500 605 | 425 | #230 Title         500 4-- with embedded 500 605 | 
            
              | 424 | #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 | 426 | #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 | 
            
              | 425 | #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 | 427 | #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 | 
            
              | 426 | #250 Topical subject 	606 | 428 | #250 Topical subject         606 | 
            
              | 427 | #260 Place access 	620 | 429 | #260 Place access         620 | 
            
              | 428 | #280 Form, genre or physical characteristics 	608 | 430 | #280 Form, genre or physical characteristics         608 | 
        
          | 429 | # | 431 | # | 
        
          | 430 | # | 432 | # | 
        
          | 431 | # Could also be represented with : | 433 | # Could also be represented with : | 
  
    | Lines 593-599
          sub AddAuthority {
      
      
        Link Here | 
        
          | 593 | # pass the MARC::Record to this function, and it will create the records in the authority table | 595 | # pass the MARC::Record to this function, and it will create the records in the authority table | 
        
          | 594 |   my ($record,$authid,$authtypecode) = @_; | 596 |   my ($record,$authid,$authtypecode) = @_; | 
        
          | 595 |   my $dbh=C4::Context->dbh; | 597 |   my $dbh=C4::Context->dbh; | 
          
            
              | 596 | 	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record | 598 |         my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record | 
        
          | 597 |  | 599 |  | 
        
          | 598 | # if authid empty => true add, find a new authid number | 600 | # if authid empty => true add, find a new authid number | 
        
          | 599 |     my $format; | 601 |     my $format; | 
  
    | Lines 615-631
          sub AddAuthority {
      
      
        Link Here | 
        
          | 615 |     } | 617 |     } | 
        
          | 616 |  | 618 |  | 
        
          | 617 |     SetUTF8Flag($record); | 619 |     SetUTF8Flag($record); | 
          
            
              | 618 | 	if ($format eq "MARC21") { | 620 |         if ($format eq "MARC21") { | 
            
              | 619 | 		if (!$record->leader) { | 621 |                 if (!$record->leader) { | 
            
              | 620 | 			$record->leader($leader); | 622 |                         $record->leader($leader); | 
            
              | 621 | 		} | 623 |                 } | 
            
              | 622 | 		if (!$record->field('003')) { | 624 |                 if (!$record->field('003')) { | 
            
              | 623 | 			$record->insert_fields_ordered( | 625 |                         $record->insert_fields_ordered( | 
            
              | 624 | 				MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) | 626 |                                 MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) | 
            
              | 625 | 			); | 627 |                         ); | 
            
              | 626 | 		} | 628 |                 } | 
            
              | 627 | 		my $date=POSIX::strftime("%y%m%d",localtime); | 629 |                 my $date=POSIX::strftime("%y%m%d",localtime); | 
            
              | 628 | 		if (!$record->field('008')) { | 630 |                 if (!$record->field('008')) { | 
        
          | 629 |             # Get a valid default value for field 008 | 631 |             # Get a valid default value for field 008 | 
        
          | 630 |             my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); | 632 |             my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); | 
        
          | 631 |             if(!$default_008 or length($default_008)<34) { | 633 |             if(!$default_008 or length($default_008)<34) { | 
  
    | Lines 636-668
          sub AddAuthority {
      
      
        Link Here | 
        
          | 636 |             } | 638 |             } | 
        
          | 637 |  | 639 |  | 
        
          | 638 |             $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) ); | 640 |             $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) ); | 
          
            
              | 639 | 		} | 641 |                 } | 
            
              | 640 | 		if (!$record->field('040')) { | 642 |                 if (!$record->field('040')) { | 
            
              | 641 | 		 $record->insert_fields_ordered( | 643 |                  $record->insert_fields_ordered( | 
        
          | 642 |         MARC::Field->new('040','','', | 644 |         MARC::Field->new('040','','', | 
          
            
              | 643 | 				'a' => C4::Context->preference('MARCOrgCode'), | 645 |                                 'a' => C4::Context->preference('MARCOrgCode'), | 
            
              | 644 | 				'c' => C4::Context->preference('MARCOrgCode') | 646 |                                 'c' => C4::Context->preference('MARCOrgCode') | 
            
              | 645 | 				)  | 647 |                                 ) | 
            
              | 646 | 			); | 648 |                         ); | 
        
          | 647 |     } | 649 |     } | 
          
            
              | 648 | 	} | 650 |         } | 
        
          | 649 |  | 651 |  | 
        
          | 650 |   if ($format eq "UNIMARCAUTH") { | 652 |   if ($format eq "UNIMARCAUTH") { | 
        
          | 651 |         $record->leader("     nx  j22             ") unless ($record->leader()); | 653 |         $record->leader("     nx  j22             ") unless ($record->leader()); | 
        
          | 652 |         my $date=POSIX::strftime("%Y%m%d",localtime); | 654 |         my $date=POSIX::strftime("%Y%m%d",localtime); | 
          
            
              | 653 | 	my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100'); | 655 |         my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100'); | 
        
          | 654 |     if (my $string=$record->subfield('100',"a")){ | 656 |     if (my $string=$record->subfield('100',"a")){ | 
          
            
              | 655 |       	$string=~s/fre50/frey50/; | 657 |               $string=~s/fre50/frey50/; | 
            
              | 656 |       	$record->field('100')->update('a'=>$string); | 658 |               $record->field('100')->update('a'=>$string); | 
        
          | 657 |     } | 659 |     } | 
        
          | 658 |     elsif ($record->field('100')){ | 660 |     elsif ($record->field('100')){ | 
        
          | 659 |           $record->field('100')->update('a'=>$date.$defaultfield100); | 661 |           $record->field('100')->update('a'=>$date.$defaultfield100); | 
          
            
              | 660 |     } else {       | 662 |     } else { | 
        
          | 661 |         $record->append_fields( | 663 |         $record->append_fields( | 
        
          | 662 |         MARC::Field->new('100',' ',' ' | 664 |         MARC::Field->new('100',' ',' ' | 
        
          | 663 |             ,'a'=>$date.$defaultfield100) | 665 |             ,'a'=>$date.$defaultfield100) | 
        
          | 664 |         ); | 666 |         ); | 
          
            
              | 665 |     }       | 667 |     } | 
        
          | 666 |   } | 668 |   } | 
        
          | 667 |   my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); | 669 |   my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); | 
        
          | 668 |   if (!$authid and $format eq "MARC21") { | 670 |   if (!$authid and $format eq "MARC21") { | 
  
    | Lines 754-760
          sub ModAuthority {
      
      
        Link Here | 
        
          | 754 |   } else { | 756 |   } else { | 
        
          | 755 |       # save a record in need_merge_authorities table | 757 |       # save a record in need_merge_authorities table | 
        
          | 756 |       my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". | 758 |       my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". | 
          
            
              | 757 | 	"VALUES (?,?)"; | 759 |         "VALUES (?,?)"; | 
        
          | 758 |       $dbh->do($sqlinsert,undef,($authid,0)); | 760 |       $dbh->do($sqlinsert,undef,($authid,0)); | 
        
          | 759 |   } | 761 |   } | 
        
          | 760 |   logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); | 762 |   logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); | 
  
    | Lines 1401-1406
          sub _get_authid_subfield{
      
      
        Link Here | 
        
          | 1401 |     my ($field)=@_; | 1403 |     my ($field)=@_; | 
        
          | 1402 |     return $field->subfield('9')||$field->subfield('3'); | 1404 |     return $field->subfield('9')||$field->subfield('3'); | 
        
          | 1403 | } | 1405 | } | 
            
              |  |  | 1406 |  | 
            
              | 1407 |  | 
        
          | 1404 | =head2 GetHeaderAuthority | 1408 | =head2 GetHeaderAuthority | 
        
          | 1405 |  | 1409 |  | 
        
          | 1406 |   $ref= &GetHeaderAuthority( $authid) | 1410 |   $ref= &GetHeaderAuthority( $authid) | 
  
    | Lines 1436-1565
          sub AddAuthorityTrees{
      
      
        Link Here | 
        
          | 1436 |   return $rq->execute($trees,$authid); | 1440 |   return $rq->execute($trees,$authid); | 
        
          | 1437 | } | 1441 | } | 
        
          | 1438 |  | 1442 |  | 
            
              | 1439 | =head2 merge |  |  | 
        
          | 1440 |  | 1443 |  | 
          
            
              | 1441 |   $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) | 1444 | =head2 auth_heading_def | 
            
              |  |  | 1445 |  | 
            
              | 1446 | Returns a hashref of authorities' info by type: | 
        
          | 1442 |  | 1447 |  | 
          
            
              | 1443 | Could add some feature : Migrating from a typecode to an other for instance. | 1448 | =over | 
            
              | 1444 | Then we should add some new parameter : bibliotargettag, authtargettag | 1449 |  | 
            
              |  |  | 1450 | =item type | 
            
              | 1451 |  | 
            
              | 1452 | The authority type, ie authtypecode in the DB. | 
            
              | 1453 |  | 
            
              | 1454 | =item tag | 
            
              | 1455 |  | 
            
              | 1456 | The heading tag of the authority, the one identifying the field to be copied | 
            
              | 1457 | to the linked biblio record field. | 
            
              | 1458 |  | 
            
              | 1459 | =item letters | 
            
              | 1460 |  | 
            
              | 1461 | The subfields from the heading tag that are displayed in an authority editor | 
            
              | 1462 | tab and are not hidden. Those subfields may be removed from biblio fields when | 
            
              | 1463 | AuthBibliosClean syspref is enabled. | 
            
              | 1464 |  | 
            
              | 1465 | =item bibtags | 
            
              | 1466 |  | 
            
              | 1467 | Contains the tags (separated by |) from biblio records that are linked to the | 
            
              | 1468 | authority type. | 
            
              | 1469 |  | 
            
              | 1470 | =back | 
            
              | 1471 |  | 
            
              | 1472 | For example: | 
            
              | 1473 |  | 
            
              | 1474 |  GEO: | 
            
              | 1475 |    type: GEO | 
            
              | 1476 |    tag: 151 | 
            
              | 1477 |    letters: 68abvxyz | 
            
              | 1478 |    bibtags: 691 | 
            
              | 1479 |  PERSO_NAME: | 
            
              | 1480 |    type: PERSO_NAME | 
            
              | 1481 |    tag: 100 | 
            
              | 1482 |    letters: 68abcdefghjklmnopqrstvxyz | 
            
              | 1483 |  THEME: | 
            
              | 1484 |    type: THEME | 
            
              | 1485 |    tag: 150 | 
            
              | 1486 |    letters: 68abvxyz | 
            
              | 1487 |    bibtags: 690|691 | 
        
          | 1445 |  | 1488 |  | 
        
          | 1446 | =cut | 1489 | =cut | 
        
          | 1447 |  | 1490 |  | 
          
            
              | 1448 | sub merge { | 1491 | sub auth_heading_def { | 
            
              | 1449 |     my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; | 1492 |     my $cache = Koha::Cache->get_instance(); | 
            
              | 1450 |     my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);         | 1493 |     my $key = "AuthHeading"; | 
            
              | 1451 |     my $dbh=C4::Context->dbh; | 1494 |     my $heading = $cache->get_from_cache($key); | 
            
              | 1452 |     my $authtypecodefrom = GetAuthTypeCode($mergefrom); | 1495 |     unless ($heading) { | 
            
              | 1453 |     my $authtypecodeto = GetAuthTypeCode($mergeto); | 1496 |         my $sth = C4::Context->dbh->prepare(" | 
            
              | 1454 | #     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto "; | 1497 |             SELECT DISTINCT | 
            
              | 1455 |     # return if authority does not exist | 1498 |               auth_types.authtypecode AS type, | 
            
              | 1456 |     return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0; | 1499 |               auth_tag_to_report AS tag, | 
            
              | 1457 |     return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0; | 1500 |               GROUP_CONCAT(DISTINCT tagsubfield SEPARATOR '') AS letters, | 
            
              | 1458 |     # search the tag to report | 1501 |               (SELECT DISTINCT | 
            
              | 1459 |     my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); | 1502 |                  GROUP_CONCAT(DISTINCT tagfield SEPARATOR '|') | 
            
              | 1460 |     $sth->execute($authtypecodefrom); | 1503 |                FROM | 
            
              | 1461 |     my ($auth_tag_to_report_from) = $sth->fetchrow; | 1504 |                  marc_subfield_structure | 
            
              | 1462 |     $sth->execute($authtypecodeto); | 1505 |                WHERE | 
            
              | 1463 |     my ($auth_tag_to_report_to) = $sth->fetchrow; | 1506 |                  authtypecode = auth_types.authtypecode | 
            
              | 1464 |      | 1507 |               ) AS bibtags | 
            
              | 1465 |     my @record_to; | 1508 |             FROM | 
            
              | 1466 |     @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to); | 1509 |               auth_types, auth_subfield_structure | 
            
              | 1467 |     my @record_from; | 1510 |             WHERE | 
            
              | 1468 |     @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from); | 1511 |               auth_types.authtypecode = auth_subfield_structure.authtypecode | 
            
              | 1469 |      | 1512 |             AND | 
            
              | 1470 |     my @reccache; | 1513 |               tagfield = auth_tag_to_report | 
            
              | 1471 |     # search all biblio tags using this authority. | 1514 |             AND | 
            
              | 1472 |     #Getting marcbiblios impacted by the change. | 1515 |               tab >= 0 | 
            
              | 1473 |     #zebra connection | 1516 |             AND | 
            
              | 1474 |     my $oConnection=C4::Context->Zconn("biblioserver",0); | 1517 |               hidden = 0 | 
            
              | 1475 |     # We used to use XML syntax here, but that no longer works. | 1518 |             GROUP BY | 
            
              | 1476 |     # Thankfully, we don't need it. | 1519 |               auth_types.authtypecode, auth_tag_to_report | 
            
              | 1477 |     my $query; | 1520 |         "); | 
            
              | 1478 |     $query= "an=".$mergefrom; | 1521 |         $sth->execute; | 
            
              | 1479 |     my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); | 1522 |         $heading = { map { $_->{type} => $_ } @{$sth->fetchall_arrayref({})} }; | 
            
              | 1480 |     my $count = 0; | 1523 |         $cache->set_in_cache($key, $heading); | 
            
              | 1481 |     if  ($oResult) { |  |  | 
            
              | 1482 |         $count=$oResult->size(); | 
        
          | 1483 |     } | 1524 |     } | 
          
            
              | 1484 |     my $z=0; | 1525 |     return $heading; | 
            
              | 1485 |     while ( $z<$count ) { | 1526 | } | 
            
              | 1486 |         my $marcrecordzebra = C4::Search::new_record_from_zebra( | 1527 |  | 
            
              | 1487 |             'biblioserver', | 1528 |  | 
            
              | 1488 |             $oResult->record($z)->raw() | 1529 | =head2 GetBibliosByAuthid | 
            
              | 1489 |         ); | 1530 |  | 
            
              | 1490 |         my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' ); | 1531 |   $records = GetBibliosByAuthid($authid) | 
            
              | 1491 |         my $i = ($biblionumbertagfield < 10) | 1532 |  | 
            
              | 1492 |             ? $marcrecordzebra->field( $biblionumbertagfield )->data | 1533 | returns an arrayref of biblio records linked to an authority identified by its | 
            
              | 1493 |             : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield ); | 1534 | authid. | 
            
              | 1494 |         my $marcrecorddb = GetMarcBiblio($i); | 1535 |  | 
            
              | 1495 |         push @reccache, $marcrecorddb; | 1536 | =cut | 
            
              | 1496 |         $z++; | 1537 |  | 
            
              | 1497 |     } | 1538 | sub GetBibliosByAuthid { | 
            
              | 1498 |     $oResult->destroy(); | 1539 |     my $authid = shift; | 
            
              | 1499 |     #warn scalar(@reccache)." biblios to update"; | 1540 |     my $conn = C4::Context->Zconn("biblioserver", 0); | 
            
              | 1500 |     # Get All candidate Tags for the change  | 1541 |     my $result = $conn->search( | 
            
              | 1501 |     # (This will reduce the search scope in marc records). | 1542 |         ZOOM::Query::CCL2RPN->new( "an=$authid", $conn )); | 
            
              | 1502 |     $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); | 1543 |     my @records; | 
            
              | 1503 |     $sth->execute($authtypecodefrom); | 1544 |     if ( my $count = $result && $result->size() ) { | 
            
              | 1504 |     my @tags_using_authtype; | 1545 |         for (my $z = 0; $z < $count; $z++ ) { | 
            
              | 1505 |     while (my ($tagfield) = $sth->fetchrow) { | 1546 |             my $raw = $result->record($z)->raw(); | 
            
              | 1506 |         push @tags_using_authtype,$tagfield ; | 1547 |             my $record = C4::Search::new_record_from_zebra('biblioserver', $raw); | 
            
              |  |  | 1548 |             # Take the biblio from the DB rather than Zebra | 
            
              | 1549 |             push @records, GetMarcBiblio(GetBiblionumber($record)); | 
            
              | 1550 |         } | 
        
          | 1507 |     } | 1551 |     } | 
          
            
              | 1508 |     my $tag_to=0;   | 1552 |     $conn->destroy(); | 
            
              | 1509 |     if ($authtypecodeto ne $authtypecodefrom){   | 1553 |     return \@records; | 
            
              | 1510 |         # If many tags, take the first | 1554 | } | 
            
              | 1511 |         $sth->execute($authtypecodeto);     | 1555 |  | 
            
              | 1512 |         $tag_to=$sth->fetchrow; | 1556 |  | 
            
              | 1513 |         #warn $tag_to;     | 1557 | =head2 merge | 
            
              | 1514 |     }   | 1558 |  | 
            
              | 1515 |     # BulkEdit marc records | 1559 |   $ref= &merge($from_authid, $from_record, $to_authid, $to_record); | 
            
              | 1516 |     # May be used as a template for a bulkedit field   | 1560 |  | 
            
              | 1517 |     foreach my $marcrecord(@reccache){ | 1561 | Merge two authorties, and modify linked biblio records. | 
            
              |  |  | 1562 |  | 
            
              | 1563 | =cut | 
            
              | 1564 |  | 
            
              | 1565 | sub merge { | 
            
              | 1566 |  | 
            
              | 1567 |     # First, build a hashref with two keys, from & to, giving info about | 
            
              | 1568 |     # authorities to be merged: | 
            
              | 1569 |     # from: | 
            
              | 1570 |     #   id: 5391 | 
            
              | 1571 |     #   tag: 151 | 
            
              | 1572 |     #   type: GEO | 
            
              | 1573 |     #   subf: => all MARC::Field heading subfields | 
            
              | 1574 |     #     - | 
            
              | 1575 |     #       - a | 
            
              | 1576 |     #       - Afrique orientale britannique (1888-1920) | 
            
              | 1577 |     #   letters: 68abvxyz | 
            
              | 1578 |     #   bibtags: => biblio records tag containing this authority | 
            
              | 1579 |     #     - 691 | 
            
              | 1580 |     #     - 692 | 
            
              | 1581 |     # to: | 
            
              | 1582 |     my $heading = auth_heading_def(); | 
            
              | 1583 |     my $auth = { map { | 
            
              | 1584 |         my $a = {}; | 
            
              | 1585 |         my $id = $a->{id} = shift; | 
            
              | 1586 |         my $record = shift; | 
            
              | 1587 |         return "Invalid $_ MARC record " . Dump($record) if $record->fields() == 0; | 
            
              | 1588 |         my $type = $a->{type} = GetAuthTypeCode($id); | 
            
              | 1589 |         my $h = $heading->{$type}; | 
            
              | 1590 |         $a->{$_} = $h->{$_} for qw/tag letters bibtags/; | 
            
              | 1591 |         $a->{subf} = [ $record->field($a->{tag})->subfields() ]; | 
            
              | 1592 |         $_ => $a; | 
            
              | 1593 |     } qw/ from to / }; | 
            
              | 1594 |  | 
            
              | 1595 |     # Is is necessary to change biblio record tag since the target authority | 
            
              | 1596 |     # has another type? The first tag linked to target authority is choosed: | 
            
              | 1597 |     # this is disputable. | 
            
              | 1598 |     my $modified_tag = $auth->{to}->{type} ne $auth->{from}->{type} | 
            
              | 1599 |                        ? $auth->{to}->{bibtags}->[0] : 0; | 
            
              | 1600 |     my $auth_clean_biblios = C4::Context->preference('AuthCleanBiblios'); | 
            
              | 1601 |  | 
            
              | 1602 |     # Modify all biblios containing the 'from' authority | 
            
              | 1603 |     my $modified = 0; | 
            
              | 1604 |     foreach my $record ( @{GetBibliosByAuthid($auth->{from}->{id})} ) { | 
        
          | 1518 |         my $update = 0; | 1605 |         my $update = 0; | 
          
            
              | 1519 |         foreach my $tagfield (@tags_using_authtype){ | 1606 |         foreach my $field ($record->field($auth->{from}->{bibtags})) { | 
            
              | 1520 | #             warn "tagfield : $tagfield "; | 1607 |             # biblio is linked to authority with $9 subfield containing authid | 
            
              | 1521 |             foreach my $field ($marcrecord->field($tagfield)){ | 1608 |             next unless $auth->{from}->{id} == $field->subfield('9'); | 
            
              | 1522 |                 # biblio is linked to authority with $9 subfield containing authid | 1609 |             my $field_to = MARC::Field->new( | 
            
              | 1523 |                 my $auth_number=$field->subfield("9"); | 1610 |                 $modified_tag || $field->tag, | 
            
              | 1524 |                 my $tag=$field->tag();           | 1611 |                 $field->indicator(1), $field->indicator(2), | 
            
              | 1525 |                 if ($auth_number==$mergefrom) { | 1612 |                 9 => $auth->{to}->{id} ); | 
            
              | 1526 |                 my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); | 1613 |             my $exclude = '9'; | 
            
              | 1527 | 		my $exclude='9'; | 1614 |             foreach my $subfield (grep {$_->[0] ne '9'} @{$auth->{to}->{subf}}) { | 
            
              | 1528 |                 foreach my $subfield (grep {$_->[0] ne '9'} @record_to) { | 1615 |                 $field_to->add_subfields($subfield->[0] => $subfield->[1]); | 
            
              | 1529 |                     $field_to->add_subfields($subfield->[0] =>$subfield->[1]); | 1616 |                 $exclude .= $subfield->[0]; | 
            
              | 1530 | 		    $exclude.= $subfield->[0]; | 1617 |             } | 
            
              | 1531 |                 } | 1618 |             $exclude .= $auth->{to}->{letters} if $auth_clean_biblios; | 
            
              | 1532 | 		$exclude='['.$exclude.']'; | 1619 |             $exclude = "[$exclude]"; | 
            
              | 1533 | #		add subfields in $field not included in @record_to | 1620 |             # Add subfields that are in the biblio field but are not in | 
            
              | 1534 | 		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); | 1621 |             # authority heading | 
            
              | 1535 |                 foreach my $subfield (@restore) { | 1622 |             my @restore = grep { $_->[0] !~ /$exclude/ } $field->subfields(); | 
            
              | 1536 |                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]); | 1623 |             foreach my $subfield (@restore) { | 
            
              | 1537 | 		} | 1624 |                $field_to->add_subfields($subfield->[0] => $subfield->[1]); | 
            
              | 1538 |                 $marcrecord->delete_field($field); | 1625 |             } | 
            
              | 1539 |                 $marcrecord->insert_grouped_field($field_to);             | 1626 |             $field->replace_with($field_to); | 
            
              | 1540 |                 $update=1; | 1627 |             $update = 1; | 
            
              | 1541 |                 } |  |  | 
            
              | 1542 |             }#for each tag | 
            
              | 1543 |         }#foreach tagfield | 
            
              | 1544 |         my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ; | 
            
              | 1545 |         my $biblionumber; | 
            
              | 1546 |         if ($bibliotag<10){ | 
            
              | 1547 |             $biblionumber=$marcrecord->field($bibliotag)->data; | 
        
          | 1548 |         } | 1628 |         } | 
          
            
              | 1549 |         else { | 1629 |         next unless $update; | 
            
              | 1550 |             $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf); | 1630 |         if ( my $biblionumber = GetBiblionumber($record) ) { | 
            
              |  |  | 1631 |             ModBiblio($record, $biblionumber, GetFrameworkCode($biblionumber)); | 
            
              | 1632 |             $modified++; | 
            
              | 1633 |             warn $modified if ($modified % 10) and $ENV{DEBUG}; | 
        
          | 1551 |         } | 1634 |         } | 
          
            
              | 1552 |         unless ($biblionumber){ | 1635 |         else { | 
            
              | 1553 |             warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted; | 1636 |             warn "No biblionumber in: " . $record->as_formatted; | 
            
              | 1554 |             next; |  |  | 
        
          | 1555 |         } | 1637 |         } | 
          
            
              | 1556 |         if ($update==1){ | 1638 |     } | 
            
              | 1557 |             &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ; | 1639 |     return $modified; | 
            
              | 1558 |             $counteditedbiblio++; |  |  | 
            
              | 1559 |             warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG}); | 
            
              | 1560 |         }     | 
            
              | 1561 |     }#foreach $marc | 
            
              | 1562 |     return $counteditedbiblio;   | 
        
          | 1563 |   # now, find every other authority linked with this authority | 1640 |   # now, find every other authority linked with this authority | 
        
          | 1564 |   # now, find every other authority linked with this authority | 1641 |   # now, find every other authority linked with this authority | 
        
          | 1565 | #   my $oConnection=C4::Context->Zconn("authorityserver"); | 1642 | #   my $oConnection=C4::Context->Zconn("authorityserver"); | 
  
    | Lines 1567-1573
          sub merge {
      
      
        Link Here | 
        
          | 1567 | # # att 9210               Auth-Internal-authtype | 1644 | # # att 9210               Auth-Internal-authtype | 
        
          | 1568 | # # att 9220               Auth-Internal-LN | 1645 | # # att 9220               Auth-Internal-LN | 
        
          | 1569 | # # ccl.properties to add for authorities | 1646 | # # ccl.properties to add for authorities | 
          
            
              | 1570 | #   $query= "= ".$mergefrom; | 1647 | #   $query= "= ".$auth->{from}->{id}; | 
        
          | 1571 | #   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); | 1648 | #   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); | 
        
          | 1572 | #   my $count=$oResult->size() if  ($oResult); | 1649 | #   my $count=$oResult->size() if  ($oResult); | 
        
          | 1573 | #   my @reccache; | 1650 | #   my @reccache; | 
  
    | Lines 1589-1597
          sub merge {
      
      
        Link Here | 
        
          | 1589 | #       my @tags = $marcrecord->field($tagfield); | 1666 | #       my @tags = $marcrecord->field($tagfield); | 
        
          | 1590 | #       foreach my $tag (@tags){ | 1667 | #       foreach my $tag (@tags){ | 
        
          | 1591 | #         my $tagsubs=$tag->subfield("9"); | 1668 | #         my $tagsubs=$tag->subfield("9"); | 
          
            
              | 1592 | #     #warn "$tagfield:$tagsubs:$mergefrom"; | 1669 | #     #warn "$tagfield:$tagsubs:$auth->{from}->{id}"; | 
            
              | 1593 | #         if ($tagsubs== $mergefrom) { | 1670 | #         if ($tagsubs== $auth->{from}->{id}) { | 
            
              | 1594 | #           $tag->update("9" =>$mergeto); | 1671 | #           $tag->update("9" =>$auth->{to}->{id}); | 
        
          | 1595 | #           foreach my $subfield (@record_to) { | 1672 | #           foreach my $subfield (@record_to) { | 
        
          | 1596 | #     #        warn "$subfield,$subfield->[0],$subfield->[1]"; | 1673 | #     #        warn "$subfield,$subfield->[0],$subfield->[1]"; | 
        
          | 1597 | #             $tag->update($subfield->[0] =>$subfield->[1]); | 1674 | #             $tag->update($subfield->[0] =>$subfield->[1]); |