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