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

(-)a/C4/AuthoritiesMarc.pm (-182 / +259 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
        &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]);
(-)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 11390-11395 if ( CheckVersion($DBversion) ) { Link Here
11390
    SetVersion ($DBversion);
11390
    SetVersion ($DBversion);
11391
}
11391
}
11392
11392
11393
$DBversion = "3.23.00.XXX";
11394
if ( CheckVersion($DBversion) ) {
11395
    $dbh->do(q{
11396
        INSERT IGNORE INTO systempreferences (variable,value,explanation,options,type)
11397
        VALUES ('AuthCleanBiblios','0','If ON, attached biblio records related fields are cleaned when an authority is updated','','YesNo')
11398
    });
11399
    print "Upgrade to $DBversion done (Bug 5572: Cleaning attached biblio records when updating an authority)\n";
11400
    SetVersion($DBversion);
11401
}
11402
11393
# DEVELOPER PROCESS, search for anything to execute in the db_update directory
11403
# DEVELOPER PROCESS, search for anything to execute in the db_update directory
11394
# SEE bug 13068
11404
# SEE bug 13068
11395
# if there is anything in the atomicupdate, read and execute it.
11405
# 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