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

(-)a/C4/AuthoritiesMarc.pm (-154 / +261 lines)
Lines 19-30 package C4::AuthoritiesMarc; Link Here
19
use strict;
19
use strict;
20
use warnings;
20
use warnings;
21
use C4::Context;
21
use C4::Context;
22
use List::MoreUtils qw/any none first_index/;
22
use MARC::Record;
23
use MARC::Record;
23
use C4::Biblio;
24
use C4::Biblio;
24
use C4::Search;
25
use C4::Search;
25
use C4::AuthoritiesMarc::MARC21;
26
use C4::AuthoritiesMarc::MARC21;
26
use C4::AuthoritiesMarc::UNIMARC;
27
use C4::AuthoritiesMarc::UNIMARC;
27
use C4::Charset;
28
use C4::Charset;
29
use C4::Debug;
28
use C4::Log;
30
use C4::Log;
29
use Koha::Authority;
31
use Koha::Authority;
30
32
Lines 32-38 use vars qw($VERSION @ISA @EXPORT); Link Here
32
34
33
BEGIN {
35
BEGIN {
34
	# set the version for version checking
36
	# set the version for version checking
35
    $VERSION = 3.07.00.049;
37
    $VERSION = 3.11.00.001;
36
38
37
	require Exporter;
39
	require Exporter;
38
	@ISA = qw(Exporter);
40
	@ISA = qw(Exporter);
Lines 62-67 BEGIN { Link Here
62
64
63
        &GuessAuthTypeCode
65
        &GuessAuthTypeCode
64
        &GuessAuthId
66
        &GuessAuthId
67
        authorityflavour
65
 	);
68
 	);
66
}
69
}
67
70
Lines 95-100 sub GetAuthMARCFromKohaField { Link Here
95
  return  ($tagfield,$tagsubfield);
98
  return  ($tagfield,$tagsubfield);
96
}
99
}
97
100
101
=head2 authorityflavour
102
103
    $authorityflavour = authorityflavour();
104
    return the marc flavour used for authorities
105
106
=cut
107
108
my $authorityflavour;
109
110
sub authorityflavour {
111
    return $authorityflavour if defined $authorityflavour;
112
    $authorityflavour =
113
     (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'?
114
        "UNIMARCAUTH":
115
        C4::Context->preference('marcflavour')
116
        );
117
    return $authorityflavour;
118
}
119
98
=head2 SearchAuthorities 
120
=head2 SearchAuthorities 
99
121
100
  (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
122
  (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
Lines 372-378 sub GetAuthTypeCode { Link Here
372
 
394
 
373
=head2 GuessAuthTypeCode
395
=head2 GuessAuthTypeCode
374
396
375
  my $authtypecode = GuessAuthTypeCode($record);
397
  my $authtypecode = GuessAuthTypeCode($record, [$headingfields]);
376
398
377
Get the record and tries to guess the adequate authtypecode from its content.
399
Get the record and tries to guess the adequate authtypecode from its content.
378
400
Lines 576-590 sub AddAuthority { Link Here
576
	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
598
	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
577
599
578
# if authid empty => true add, find a new authid number
600
# if authid empty => true add, find a new authid number
579
    my $format;
601
#update date/time to 005 for marc and unimarc
580
    if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
581
        $format= 'UNIMARCAUTH';
582
    }
583
    else {
584
        $format= 'MARC21';
585
    }
586
587
    #update date/time to 005 for marc and unimarc
588
    my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
602
    my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
589
    my $f5=$record->field('005');
603
    my $f5=$record->field('005');
590
    if (!$f5) {
604
    if (!$f5) {
Lines 595-601 sub AddAuthority { Link Here
595
    }
609
    }
596
610
597
    SetUTF8Flag($record);
611
    SetUTF8Flag($record);
598
	if ($format eq "MARC21") {
612
    if (authorityflavour() eq "MARC21") {
599
		if (!$record->leader) {
613
		if (!$record->leader) {
600
			$record->leader($leader);
614
			$record->leader($leader);
601
		}
615
		}
Lines 627-633 sub AddAuthority { Link Here
627
    }
641
    }
628
	}
642
	}
629
643
630
  if ($format eq "UNIMARCAUTH") {
644
  if (authorityflavour() eq "UNIMARCAUTH") {
631
        $record->leader("     nx  j22             ") unless ($record->leader());
645
        $record->leader("     nx  j22             ") unless ($record->leader());
632
        my $date=POSIX::strftime("%Y%m%d",localtime);
646
        my $date=POSIX::strftime("%Y%m%d",localtime);
633
	my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100');
647
	my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100');
Lines 645-651 sub AddAuthority { Link Here
645
    }      
659
    }      
646
  }
660
  }
647
  my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
661
  my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
648
  if (!$authid and $format eq "MARC21") {
662
  if (!$authid and authorityflavour() eq "MARC21") {
649
    # only need to do this fix when modifying an existing authority
663
    # only need to do this fix when modifying an existing authority
650
    C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
664
    C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
651
  } 
665
  } 
Lines 677-688 sub AddAuthority { Link Here
677
      $record->add_fields('001',$authid) unless ($record->field('001'));
691
      $record->add_fields('001',$authid) unless ($record->field('001'));
678
#       warn "\n\n\n enregistrement".$record->as_formatted;
692
#       warn "\n\n\n enregistrement".$record->as_formatted;
679
      my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
693
      my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
680
      $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr;
694
      $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()),$authid) or die $sth->errstr;
681
      $sth->finish;
695
      $sth->finish;
682
  }
696
  }
683
  else {
697
  else {
684
    my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
698
    my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
685
    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
699
    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()));
686
    $sth->finish;
700
    $sth->finish;
687
    logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
701
    logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
688
  }
702
  }
Lines 733-741 sub ModAuthority { Link Here
733
      &merge($authid,$oldrecord,$authid,$record);
747
      &merge($authid,$oldrecord,$authid,$record);
734
  } else {
748
  } else {
735
      # save a record in need_merge_authorities table
749
      # save a record in need_merge_authorities table
736
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
750
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, init_value, done) VALUES (?,?,?)";
737
	"VALUES (?,?)";
751
      $dbh->do($sqlinsert,undef,($authid,$oldrecord->as_xml_record(authorityflavour()),0));
738
      $dbh->do($sqlinsert,undef,($authid,0));
739
  }
752
  }
740
  logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
753
  logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
741
  return $authid;
754
  return $authid;
Lines 1372-1377 sub AddAuthorityTrees{ Link Here
1372
  return $rq->execute($trees,$authid);
1385
  return $rq->execute($trees,$authid);
1373
}
1386
}
1374
1387
1388
1375
=head2 merge
1389
=head2 merge
1376
1390
1377
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1391
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
Lines 1381-1548 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1381
1395
1382
=cut
1396
=cut
1383
1397
1398
1399
# Test if a subfield exist in a subfield list
1400
sub _test_subfcode_presence {
1401
    my ( $subfields, $subfcode ) = @_;
1402
    return grep { $_->[0] eq $subfcode } @$subfields;
1403
}
1404
1405
# Test if a string exists in  a field
1406
sub _test_string {
1407
    my ( $string, @fields ) = @_;
1408
    my $return = 0;
1409
    for my $field (@fields) {
1410
        if ( grep { $_->[1] =~ /$string/i } $field->subfields ) {
1411
            $return = 1;
1412
            last;
1413
        }
1414
    }
1415
    return $return;
1416
}
1417
1418
# _process_subfcode_4_merge sets the correct subfcode
1419
sub _process_subfcode_4_merge {
1420
    my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields,
1421
        $authtypecode )
1422
      = @_;
1423
    return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' );
1424
    if (   $tagfield eq "600"
1425
        or $tagfield eq "606"
1426
        or $tagfield eq "607"
1427
        or $tagfield eq "700"
1428
        or $tagfield eq "701"
1429
        or $tagfield eq "702"
1430
        or $tagfield eq "710"
1431
        or $tagfield eq "711"
1432
        or $tagfield eq "712" )
1433
    {
1434
        my $authtag = GetAuthType($authtypecode);
1435
        my $chronological_auth =
1436
          _test_string( qq{S'emploie uniquement en subdivision chronologique},
1437
            $authorityrecord->field('3..') );
1438
        my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' );
1439
        if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) {
1440
            if (    ( $authtag->{'auth_tag_to_report'} eq '215' )
1441
                and ( $tagfield ne "607" ) )
1442
            {
1443
                return "y";
1444
1445
            }
1446
            elsif ( $chronological_auth and $subfz_absent ) {
1447
                return "z";
1448
            }
1449
            else {
1450
                return "x";
1451
            }
1452
        }
1453
        return;
1454
    }
1455
    return;
1456
}
1457
1384
sub merge {
1458
sub merge {
1385
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1459
    my ( $mergefrom, $MARCfrom, $mergeto, $MARCto ) = @_;
1386
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1460
    my $dbh              = C4::Context->dbh;
1387
    my $dbh=C4::Context->dbh;
1461
    my $marcflavour      = C4::Context->preference('marcflavour');
1388
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1462
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1389
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1463
    my $authtypecodeto   = GetAuthTypeCode($mergeto);
1390
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1464
    $MARCfrom ||= GetAuthority($mergefrom);
1465
    $MARCto   ||= GetAuthority($mergeto);
1466
    my @editedbiblios = ();
1467
1391
    # return if authority does not exist
1468
    # return if authority does not exist
1392
    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1469
    return "error MARCFROM not a marcrecord " . Data::Dumper::Dumper($MARCfrom)
1393
    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
1470
      if ( !$MARCfrom or scalar( $MARCfrom->fields() ) == 0 );
1471
    return "error MARCTO not a marcrecord" . Data::Dumper::Dumper($MARCto)
1472
      if ( !$MARCto or scalar( $MARCto->fields() ) == 0 );
1473
1394
    # search the tag to report
1474
    # search the tag to report
1395
    my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
1475
    my $sth = $dbh->prepare(
1476
        "select auth_tag_to_report from auth_types where authtypecode=?");
1396
    $sth->execute($authtypecodefrom);
1477
    $sth->execute($authtypecodefrom);
1397
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1478
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1398
    $sth->execute($authtypecodeto);
1479
    $sth->execute($authtypecodeto);
1399
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1480
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1400
    
1481
1401
    my @record_to;
1482
    my @record_to;
1402
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1483
    @record_to =
1484
      grep { $_->[0] !~ /[0-9]/ }
1485
      $MARCto->field($auth_tag_to_report_to)->subfields()
1486
      if $MARCto->field($auth_tag_to_report_to);
1487
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1488
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1489
    }
1490
    my $field_to;
1491
    $field_to = $MARCto->field($auth_tag_to_report_to)
1492
      if $MARCto->field($auth_tag_to_report_to);
1403
    my @record_from;
1493
    my @record_from;
1404
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1494
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields()
1405
    
1495
      if $MARCfrom->field($auth_tag_to_report_from);
1496
1406
    my @reccache;
1497
    my @reccache;
1498
1407
    # search all biblio tags using this authority.
1499
    # search all biblio tags using this authority.
1408
    #Getting marcbiblios impacted by the change.
1500
    #Getting marcbiblios impacted by the change.
1409
    #zebra connection
1501
    #zebra connection
1410
    my $oConnection=C4::Context->Zconn("biblioserver",0);
1502
    my ( $err, $res, $result ) =
1411
    # We used to use XML syntax here, but that no longer works.
1503
      C4::Search::SimpleSearch( "an=$mergefrom", 0, 999999 );
1412
    # Thankfully, we don't need it.
1504
    my $z = 0;
1413
    my $query;
1505
    foreach my $rawrecord (@$res) {
1414
    $query= "an=".$mergefrom;
1506
        my $marcrecord = MARC::File::USMARC::decode($rawrecord);
1415
    my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1507
        SetUTF8Flag($marcrecord);
1416
    my $count = 0;
1508
        push @reccache, $marcrecord;
1417
    if  ($oResult) {
1418
        $count=$oResult->size();
1419
    }
1420
    my $z=0;
1421
    while ( $z<$count ) {
1422
        my $rec;
1423
        $rec=$oResult->record($z);
1424
        my $marcdata = $rec->raw();
1425
        my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata);
1426
        my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1427
        my $i = ($biblionumbertagfield < 10) ? $marcrecordzebra->field($biblionumbertagfield)->data : $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1428
        my $marcrecorddb=GetMarcBiblio($i);
1429
        push @reccache, $marcrecorddb;
1430
        $z++;
1431
    }
1509
    }
1432
    $oResult->destroy();
1510
    # Get All candidate Tags for the change
1433
    #warn scalar(@reccache)." biblios to update";
1434
    # Get All candidate Tags for the change 
1435
    # (This will reduce the search scope in marc records).
1511
    # (This will reduce the search scope in marc records).
1436
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1512
    $sth = $dbh->prepare(
1437
    $sth->execute($authtypecodefrom);
1513
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1514
    );
1515
    $sth->execute();
1438
    my @tags_using_authtype;
1516
    my @tags_using_authtype;
1439
    while (my ($tagfield) = $sth->fetchrow) {
1517
    while ( my ($tagfield) = $sth->fetchrow ) {
1440
        push @tags_using_authtype,$tagfield ;
1518
        push @tags_using_authtype, $tagfield;
1519
    }
1520
    my $tag_to = 0;
1521
1522
    # if any element in this list matchs exactly a subfield in the biblio field
1523
    # which is before the $9, the subfield is removed.
1524
    my @data_to_remove = map { $_->[1] } @record_from;
1525
    if ( uc( C4::Context->preference('marcflavour') ) eq "UNIMARC" ) {
1526
1527
        # If in UNIMARC, we also want to remove PPN if it's before $9 (it will
1528
        # be reinserted after)
1529
        foreach my $record ( $MARCto, $MARCfrom ) {
1530
            my $field = $record->field('009');
1531
            if ( $field and ( my $data = $field->data() ) ) {
1532
                push @data_to_remove, $data;
1533
            }
1534
        }
1441
    }
1535
    }
1442
    my $tag_to=0;  
1536
1443
    if ($authtypecodeto ne $authtypecodefrom){  
1537
    foreach my $marcrecord (@reccache) {
1444
        # If many tags, take the first
1538
        foreach my $tagfield (@tags_using_authtype) {
1445
        $sth->execute($authtypecodeto);    
1539
            foreach my $field ( $marcrecord->field($tagfield) ) {
1446
        $tag_to=$sth->fetchrow;
1540
                my $update;
1447
        #warn $tag_to;    
1541
                my $tag = $field->tag();
1448
    }  
1542
                my @newsubfields;
1449
    # BulkEdit marc records
1543
                my %indexes;
1450
    # May be used as a template for a bulkedit field  
1544
1451
    foreach my $marcrecord(@reccache){
1545
                #get to next field if no subfield
1452
        my $update;           
1546
                my @localsubfields = $field->subfields();
1453
        foreach my $tagfield (@tags_using_authtype){
1547
                my $index_9_auth   = first_index {
1454
#             warn "tagfield : $tagfield ";
1548
                          ( $_->[0] eq 9 )
1455
            foreach my $field ($marcrecord->field($tagfield)){
1549
                      and ( $_->[1] eq "$mergefrom" );
1456
                # biblio is linked to authority with $9 subfield containing authid
1457
                my $auth_number=$field->subfield("9");
1458
                my $tag=$field->tag();          
1459
                if ($auth_number==$mergefrom) {
1460
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1461
		my $exclude='9';
1462
                foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
1463
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1464
		    $exclude.= $subfield->[0];
1465
                }
1550
                }
1466
		$exclude='['.$exclude.']';
1551
                @localsubfields;
1467
#		add subfields in $field not included in @record_to
1552
                next if ( $index_9_auth < 0 );
1468
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1553
1469
                foreach my $subfield (@restore) {
1554
                # Removes the data if before the $9
1470
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1555
                my $index = 0;
1471
		}
1556
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1557
                    if ( any { $subf->[1] eq $_ } @data_to_remove ) {
1558
                        $debug && warn "found $subf->[0] " . $subf->[1];
1559
                        splice @localsubfields, $index, 1;
1560
                        $index_9_auth--;
1561
                    }
1562
                    else {
1563
                        $index++;
1564
                    }
1565
                }
1566
1567
                #Get the next $9 subfield
1568
                my $nextindex_9 =
1569
                  first_index { $_->[0] =~ /[12456789]/ }
1570
                @localsubfields[ $index_9_auth + 1 .. $#localsubfields ];
1571
1572
        #Change the first tag if required
1573
        # That is : change the first tag ($a) to what it is in the biblio record
1574
        # Since some composed authorities will place the $a into $x or $y
1575
1576
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1577
1578
# Changing the record_to first $a subfield code is quite a dangerous idea.
1579
# But in order to clone the subfield structure and avoid the side effect affectation
1580
# one would need to parse the whole subfield structure
1581
# This would break performance a little more.
1582
                my $changesubfcode;
1583
                if (
1584
                    $changesubfcode = _process_subfcode_4_merge(
1585
                        $tag,    \@previous_subfields,
1586
                        $MARCto, \@record_to,
1587
                        $authtypecodeto
1588
                    )
1589
                  )
1590
                {
1591
                    my $index_subf_a =
1592
                      first_index { $_->[0] eq "a" } @record_to;
1593
                    $record_to[$index_subf_a]->[0] = $changesubfcode
1594
                      if defined($changesubfcode);
1595
                }
1596
1597
# Replace in local subfields the subfields related to recordfrom with data from record_to
1598
1599
                my @localrecord_to = @record_to;
1600
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1601
                my $length =
1602
                  ( $nextindex_9 > 0 )
1603
                  ? $nextindex_9 + 1
1604
                  : $#localsubfields - $#previous_subfields + 1;
1605
                splice(
1606
                    @localsubfields, $index_9_auth,
1607
                    $length,         @localrecord_to
1608
                );
1609
1610
      # very nice api for MARC::Record
1611
      # It seems that some elements localsubfields can be undefined so skip them
1612
                @newsubfields =
1613
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1614
1615
                #filter to subfields which are not in the subfield
1616
                my $field_to = MARC::Field->new(
1617
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1618
                    $field->indicator(2), @newsubfields
1619
                );
1472
                $marcrecord->delete_field($field);
1620
                $marcrecord->delete_field($field);
1473
                $marcrecord->insert_grouped_field($field_to);            
1621
                $marcrecord->insert_fields_ordered($field_to);
1474
                $update=1;
1622
1623
                # if the first $a was change, restore it before next iteration
1624
                if ($changesubfcode) {
1625
                    my $index_subf =
1626
                      first_index { $_->[0] eq $changesubfcode } @record_to;
1627
                    $record_to[$index_subf]->[0] = "a";
1475
                }
1628
                }
1476
            }#for each tag
1629
            }    #for each tag
1477
        }#foreach tagfield
1630
        }    #foreach tagfield
1478
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1631
        my ( $bibliotag, $bibliosubf ) =
1632
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1479
        my $biblionumber;
1633
        my $biblionumber;
1480
        if ($bibliotag<10){
1634
        if ( $bibliotag < 10 ) {
1481
            $biblionumber=$marcrecord->field($bibliotag)->data;
1635
            $biblionumber = $marcrecord->field($bibliotag)->data;
1482
        }
1636
        }
1483
        else {
1637
        else {
1484
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1638
            $biblionumber = $marcrecord->subfield( $bibliotag, $bibliosubf );
1485
        }
1639
        }
1486
        unless ($biblionumber){
1640
        unless ($biblionumber) {
1487
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1641
            warn "No biblionumber in : "
1642
              . $marcrecord->as_formatted;
1488
            next;
1643
            next;
1489
        }
1644
        }
1490
        if ($update==1){
1645
        my $mod_ok =
1491
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1646
          &ModBiblio( $marcrecord, $biblionumber,
1492
            $counteditedbiblio++;
1647
            GetFrameworkCode($biblionumber) );
1493
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1648
        push @editedbiblios, $biblionumber if $mod_ok;
1494
        }    
1649
    }    #foreach $marc
1495
    }#foreach $marc
1650
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1496
    return $counteditedbiblio;  
1651
    return @editedbiblios;
1497
  # now, find every other authority linked with this authority
1652
}    #sub
1498
  # now, find every other authority linked with this authority
1499
#   my $oConnection=C4::Context->Zconn("authorityserver");
1500
#   my $query;
1501
# # att 9210               Auth-Internal-authtype
1502
# # att 9220               Auth-Internal-LN
1503
# # ccl.properties to add for authorities
1504
#   $query= "= ".$mergefrom;
1505
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1506
#   my $count=$oResult->size() if  ($oResult);
1507
#   my @reccache;
1508
#   my $z=0;
1509
#   while ( $z<$count ) {
1510
#   my $rec;
1511
#           $rec=$oResult->record($z);
1512
#       my $marcdata = $rec->raw();
1513
#   push @reccache, $marcdata;
1514
#   $z++;
1515
#   }
1516
#   $oResult->destroy();
1517
#   foreach my $marc(@reccache){
1518
#     my $update;
1519
#     my $marcrecord;
1520
#     $marcrecord = MARC::File::USMARC::decode($marc);
1521
#     foreach my $tagfield (@tags_using_authtype){
1522
#       $tagfield=substr($tagfield,0,3);
1523
#       my @tags = $marcrecord->field($tagfield);
1524
#       foreach my $tag (@tags){
1525
#         my $tagsubs=$tag->subfield("9");
1526
#     #warn "$tagfield:$tagsubs:$mergefrom";
1527
#         if ($tagsubs== $mergefrom) {
1528
#           $tag->update("9" =>$mergeto);
1529
#           foreach my $subfield (@record_to) {
1530
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1531
#             $tag->update($subfield->[0] =>$subfield->[1]);
1532
#           }#for $subfield
1533
#         }
1534
#         $marcrecord->delete_field($tag);
1535
#         $marcrecord->add_fields($tag);
1536
#         $update=1;
1537
#       }#for each tag
1538
#     }#foreach tagfield
1539
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1540
#     if ($update==1){
1541
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1542
#     }
1543
# 
1544
#   }#foreach $marc
1545
}#sub
1546
1653
1547
=head2 get_auth_type_location
1654
=head2 get_auth_type_location
1548
1655
(-)a/C4/Charset.pm (-2 / +48 lines)
Lines 40-45 BEGIN { Link Here
40
        SetMarcUnicodeFlag
40
        SetMarcUnicodeFlag
41
        StripNonXmlChars
41
        StripNonXmlChars
42
        nsb_clean
42
        nsb_clean
43
        SanitizeEntity
43
    );
44
    );
44
}
45
}
45
46
Lines 188-193 sub NormalizeString{ Link Here
188
    return $string; 
189
    return $string; 
189
}
190
}
190
191
192
191
=head2 MarcToUTF8Record
193
=head2 MarcToUTF8Record
192
194
193
  ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, 
195
  ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, 
Lines 390-404 sub StripNonXmlChars { Link Here
390
392
391
=head2 nsb_clean
393
=head2 nsb_clean
392
394
393
=over 4
395
=over
394
396
395
nsb_clean($string);
397
=item nsb_clean($string);
396
398
397
=back
399
=back
398
400
399
Removes Non Sorting Block characters
401
Removes Non Sorting Block characters
400
402
401
=cut
403
=cut
404
402
sub nsb_clean {
405
sub nsb_clean {
403
    my $NSB  = '\x88' ;        # NSB : begin Non Sorting Block
406
    my $NSB  = '\x88' ;        # NSB : begin Non Sorting Block
404
    my $NSE  = '\x89' ;        # NSE : Non Sorting Block end
407
    my $NSE  = '\x89' ;        # NSE : Non Sorting Block end
Lines 1161-1166 sub char_decode5426 { Link Here
1161
  return $result;
1164
  return $result;
1162
}
1165
}
1163
1166
1167
=head2 SanitizeEntity
1168
1169
  my $utf8string = SanitizeEntity($record);
1170
1171
Removes &amp; from records (since zebra is adding multiple &amps
1172
1173
=cut
1174
1175
sub SanitizeEntity {
1176
    my $record = shift;
1177
1178
    foreach my $field ($record->fields()) {
1179
        if ($field->is_control_field()) {
1180
            $field->update(entity_clean($field->data()));
1181
        } else {
1182
            my @subfields = $field->subfields();
1183
            my @new_subfields;
1184
            foreach my $subfield (@subfields) {
1185
                push @new_subfields, $subfield->[0] => entity_clean($subfield->[1]);
1186
            }
1187
            if (scalar(@new_subfields) > 0) {
1188
                my $new_field;
1189
                eval {
1190
                    $new_field = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @new_subfields);
1191
                };
1192
                if ($@) {
1193
                warn "error : $@";
1194
                } else {
1195
                    $field->replace_with($new_field);
1196
                }
1197
1198
            }
1199
        }
1200
    }
1201
    return $record;
1202
}
1203
1204
sub entity_clean {
1205
    my $string=shift;
1206
    $string=~s/(&)(amp;)+/$1/g;
1207
    return $string;
1208
}
1209
1164
1;
1210
1;
1165
1211
1166
1212
(-)a/installer/data/mysql/kohastructure.sql (+1 lines)
Lines 1471-1476 DROP TABLE IF EXISTS `need_merge_authorities`; Link Here
1471
CREATE TABLE `need_merge_authorities` ( -- keeping track of authority records still to be merged by merge_authority cron job (used only if pref dontmerge is ON)
1471
CREATE TABLE `need_merge_authorities` ( -- keeping track of authority records still to be merged by merge_authority cron job (used only if pref dontmerge is ON)
1472
  `id` int NOT NULL auto_increment PRIMARY KEY, -- unique id
1472
  `id` int NOT NULL auto_increment PRIMARY KEY, -- unique id
1473
  `authid` bigint NOT NULL, -- reference to authority record
1473
  `authid` bigint NOT NULL, -- reference to authority record
1474
  `init_value` longtext DEFAULT NULL,  -- previous value of the record (required when 'merging')
1474
  `done` tinyint DEFAULT 0  -- indication whether merge has been executed (0=not done, 1= done, 2= in progress)
1475
  `done` tinyint DEFAULT 0  -- indication whether merge has been executed (0=not done, 1= done, 2= in progress)
1475
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
1476
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
1476
1477
(-)a/installer/data/mysql/updatedatabase.pl (+9 lines)
Lines 6946-6951 $DBversion = '3.13.00.003'; Link Here
6946
if ( CheckVersion($DBversion) ) {
6946
if ( CheckVersion($DBversion) ) {
6947
    $dbh->do("ALTER TABLE serial DROP itemnumber");
6947
    $dbh->do("ALTER TABLE serial DROP itemnumber");
6948
    print "Upgrade to $DBversion done (Bug 7718 - Remove itemnumber column from serials table)\n";
6948
    print "Upgrade to $DBversion done (Bug 7718 - Remove itemnumber column from serials table)\n";
6949
    SetVersion ($DBversion);
6950
}
6951
6952
$DBversion = "3.13.00.XXX";
6953
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
6954
    $dbh->do(qq{
6955
        ALTER TABLE need_merge_authorities ADD COLUMN init_value LONGTEXT DEFAULT NULL AFTER authid;
6956
    });
6957
    print "Upgrade to $DBversion done (Bug 8304: Support For Rameau merge fixing)\n";
6949
    SetVersion($DBversion);
6958
    SetVersion($DBversion);
6950
}
6959
}
6951
6960
(-)a/misc/migration_tools/bulkmarcimport.pl (-1 / +3 lines)
Lines 293-302 RECORD: while ( ) { Link Here
293
            }
293
            }
294
        }
294
        }
295
    }
295
    }
296
296
    unless ($test_parameter) {
297
    unless ($test_parameter) {
297
        if ($authorities){
298
        if ($authorities){
298
            use C4::AuthoritiesMarc;
299
            use C4::AuthoritiesMarc;
299
            my $authtypecode=GuessAuthTypeCode($record, $heading_fields);
300
            my $authtypecode=GuessAuthTypeCode($record, $heading_fields);
301
            $authtypecode//='SNC';
300
            my $authid= ($id?$id:GuessAuthId($record));
302
            my $authid= ($id?$id:GuessAuthId($record));
301
            if ($authid && GetAuthority($authid) && $update ){
303
            if ($authid && GetAuthority($authid) && $update ){
302
            ## Authority has an id and is in database : Replace
304
            ## Authority has an id and is in database : Replace
Lines 564-570 sub get_heading_fields{ Link Here
564
        $debug && warn YAML::Dump($headingfields);
566
        $debug && warn YAML::Dump($headingfields);
565
    }
567
    }
566
    unless ($headingfields){
568
    unless ($headingfields){
567
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
569
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types where auth_tag_to_report <>'' or auth_tag_to_report IS NOT NULL",'auth_tag_to_report',{Slice=>{}});
568
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
570
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
569
    }
571
    }
570
    return $headingfields;
572
    return $headingfields;
(-)a/misc/migration_tools/merge_authority.pl (-6 / +7 lines)
Lines 77-95 print "Merging\n" unless $noconfirm; Link Here
77
if ($batch) {
77
if ($batch) {
78
  my $authref;
78
  my $authref;
79
  $dbh->do("update need_merge_authorities set done=2 where done=0"); #temporary status 2 means: selected for merge
79
  $dbh->do("update need_merge_authorities set done=2 where done=0"); #temporary status 2 means: selected for merge
80
  $authref=$dbh->selectall_arrayref("select distinct authid from need_merge_authorities where done=2");
80
  $authref=$dbh->selectall_arrayref("select distinct authid, init_value from need_merge_authorities where done=2");
81
  foreach(@$authref) {
81
  foreach(@$authref) {
82
      my $authid=$_->[0];
82
      my $authid=$_->[0];
83
      my $value_init=$_->[1];
83
      print "managing $authid\n" if $verbose;
84
      print "managing $authid\n" if $verbose;
84
      my $MARCauth = GetAuthority($authid) ;
85
      my $MARCauth = GetAuthority($authid) ;
85
      next unless ($MARCauth);
86
      next unless ($MARCauth);
86
      merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
87
      my $MARCinit=$MARCauth;
88
      $MARCinit=eval{MARC::Record->new_from_xml($value_init, "utf-8",authorityflavour())} if defined $value_init;
89
      # if no valid xml record, then we may use MARCauth (the way it was before)
90
      merge($authid,$MARCinit,$authid,$MARCauth) if ($MARCauth);
87
  }
91
  }
88
  $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
92
  $dbh->do("update need_merge_authorities set done=1 where done=2"); #DONE
89
} else {
93
} else {
90
  my $MARCfrom = GetAuthority($mergefrom);
94
  &merge($mergefrom,$authfrom,$mergeto,$authto);
91
  my $MARCto = GetAuthority($mergeto);
92
  &merge($mergefrom,$MARCfrom,$mergeto,$MARCto);
93
  #Could add mergefrom authority to mergeto rejected forms before deletion 
95
  #Could add mergefrom authority to mergeto rejected forms before deletion 
94
  DelAuthority($mergefrom) if ($mergefrom != $mergeto);
96
  DelAuthority($mergefrom) if ($mergefrom != $mergeto);
95
}
97
}
96
- 

Return to bug 8304