View | Details | Raw Unified | Return to bug 5572
Collapse All | Expand All

(-)a/C4/AuthoritiesMarc.pm (-180 / +235 lines)
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]);
(-)a/C4/Biblio.pm (+21 lines)
Lines 93-98 BEGIN { Link Here
93
      &GetMarcFromKohaField
93
      &GetMarcFromKohaField
94
      &GetMarcSubfieldStructureFromKohaField
94
      &GetMarcSubfieldStructureFromKohaField
95
      &GetFrameworkCode
95
      &GetFrameworkCode
96
      &GetBiblionumber
96
      &TransformKohaToMarc
97
      &TransformKohaToMarc
97
      &PrepHostMarcField
98
      &PrepHostMarcField
98
99
Lines 2196-2201 sub GetFrameworkCode { Link Here
2196
    return $frameworkcode;
2197
    return $frameworkcode;
2197
}
2198
}
2198
2199
2200
2201
=head2 GetBiblionumber
2202
2203
  $biblionumber = GetBiblionumber($record);
2204
2205
Returns the biblionumber of a given biblio record.
2206
2207
=cut
2208
sub GetBiblionumber {
2209
    my $record = shift;
2210
2211
    return unless $record;
2212
2213
    my ($tag, $letter) = GetMarcFromKohaField("biblio.biblionumber", "");
2214
    $tag < 10
2215
        ? $record->field($tag)->data
2216
        : $record->subfield($tag, $letter);
2217
}
2218
2219
2199
=head2 TransformKohaToMarc
2220
=head2 TransformKohaToMarc
2200
2221
2201
    $record = TransformKohaToMarc( $hash )
2222
    $record = TransformKohaToMarc( $hash )
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 120-125 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
120
('DisplayMultiPlaceHold','1','','Display the ability to place multiple holds or not','YesNo'),
120
('DisplayMultiPlaceHold','1','','Display the ability to place multiple holds or not','YesNo'),
121
('DisplayOPACiconsXSLT','1','','If ON, displays the format, audience, and material type icons in XSLT MARC21 results and detail pages in the OPAC.','YesNo'),
121
('DisplayOPACiconsXSLT','1','','If ON, displays the format, audience, and material type icons in XSLT MARC21 results and detail pages in the OPAC.','YesNo'),
122
('dontmerge','1',NULL,'If ON, modifying an authority record will not update all associated bibliographic records immediately, ask your system administrator to enable the merge_authorities.pl cron job','YesNo'),
122
('dontmerge','1',NULL,'If ON, modifying an authority record will not update all associated bibliographic records immediately, ask your system administrator to enable the merge_authorities.pl cron job','YesNo'),
123
('AuthCleanBiblios','0',NULL,'If ON, attached biblio records related fields are cleaned when an authority is updated','YesNo'),
123
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
124
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
124
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
125
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
125
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
126
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
(-)a/installer/data/mysql/updatedatabase.pl (+10 lines)
Lines 11341-11346 if ( CheckVersion($DBversion) ) { Link Here
11341
    SetVersion($DBversion);
11341
    SetVersion($DBversion);
11342
}
11342
}
11343
11343
11344
$DBversion = "3.21.00.XXX";
11345
if ( CheckVersion($DBversion) ) {
11346
    $dbh->do(q{
11347
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type)
11348
        VALUES ('AuthCleanBiblios','0','If ON, attached biblio records related fields are cleaned when an authority is updated','','YesNo')
11349
    });
11350
    print "Upgrade to $DBversion done (Bug 5572: Cleaning attached biblio records when updating an authority)\n";
11351
    SetVersion($DBversion);
11352
}
11353
11344
# DEVELOPER PROCESS, search for anything to execute in the db_update directory
11354
# DEVELOPER PROCESS, search for anything to execute in the db_update directory
11345
# SEE bug 13068
11355
# SEE bug 13068
11346
# if there is anything in the atomicupdate, read and execute it.
11356
# if there is anything in the atomicupdate, read and execute it.
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref (-1 / +8 lines)
Lines 31-36 Authorities: Link Here
31
                  no: Do
31
                  no: Do
32
            - automatically update attached biblios when changing an authority record. If this is off, please ask your administrator to enable the merge_authority.pl cronjob.
32
            - automatically update attached biblios when changing an authority record. If this is off, please ask your administrator to enable the merge_authority.pl cronjob.
33
        -
33
        -
34
            - When updating an authority
35
            - pref: AuthCleanBiblios
36
              default: no
37
              choices:
38
                  yes: clean
39
                  no: "don't clean"
40
            - the attached biblio records (see merge preference). Cleaning means removing subfields of the biblio record fields linked to the authority that are not present in the authority heading tag, specifically the subfields that are neither ignored nor hidden in the authority editor.
41
        -
34
            - Use the following text for the contents of MARC21 authority control field 008 position 06-39 (fixed length data elements). Do NOT include the date (position 00-05).
42
            - Use the following text for the contents of MARC21 authority control field 008 position 06-39 (fixed length data elements). Do NOT include the date (position 00-05).
35
            - pref: MARCAuthorityControlField008
43
            - pref: MARCAuthorityControlField008
36
              default: "|| aca||aabn           | a|a     d"
44
              default: "|| aca||aabn           | a|a     d"
37
- 

Return to bug 5572