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

(-)a/C4/AuthoritiesMarc.pm (-167 / +280 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
my $authorityflavour;
108
109
sub authorityflavour {
110
    return $authorityflavour if defined $authorityflavour;
111
    $authorityflavour =
112
     (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC'?
113
        "UNIMARCAUTH":
114
        C4::Context->preference('marcflavour')
115
        );
116
    return $authorityflavour;
117
}
118
98
=head2 SearchAuthorities 
119
=head2 SearchAuthorities 
99
120
100
  (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
121
  (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, 
Lines 449-464 sub GetAuthTypeCode { Link Here
449
 
470
 
450
=head2 GuessAuthTypeCode
471
=head2 GuessAuthTypeCode
451
472
452
  my $authtypecode = GuessAuthTypeCode($record);
473
  my $authtypecode = GuessAuthTypeCode($record, [$headingfields]);
453
474
454
Get the record and tries to guess the adequate authtypecode from its content.
475
Get the record and tries to guess the adequate authtypecode from its content.
455
476
456
=cut
477
=cut
457
478
458
sub GuessAuthTypeCode {
479
sub GuessAuthTypeCode {
459
    my ($record) = @_;
480
    my ($record, $heading_fields) = @_;
460
    return unless defined $record;
481
    return unless defined $record;
461
my $heading_fields = {
482
    $heading_fields //= {
462
    "MARC21"=>{
483
    "MARC21"=>{
463
        '100'=>{authtypecode=>'PERSO_NAME'},
484
        '100'=>{authtypecode=>'PERSO_NAME'},
464
        '110'=>{authtypecode=>'CORPO_NAME'},
485
        '110'=>{authtypecode=>'CORPO_NAME'},
Lines 653-667 sub AddAuthority { Link Here
653
	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
674
	my $leader='     nz  a22     o  4500';#Leader for incomplete MARC21 record
654
675
655
# if authid empty => true add, find a new authid number
676
# if authid empty => true add, find a new authid number
656
    my $format;
677
#update date/time to 005 for marc and unimarc
657
    if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
658
        $format= 'UNIMARCAUTH';
659
    }
660
    else {
661
        $format= 'MARC21';
662
    }
663
664
    #update date/time to 005 for marc and unimarc
665
    my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
678
    my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
666
    my $f5=$record->field('005');
679
    my $f5=$record->field('005');
667
    if (!$f5) {
680
    if (!$f5) {
Lines 672-678 sub AddAuthority { Link Here
672
    }
685
    }
673
686
674
    SetUTF8Flag($record);
687
    SetUTF8Flag($record);
675
	if ($format eq "MARC21") {
688
	if (authorityflavour() eq "MARC21") {
676
		if (!$record->leader) {
689
		if (!$record->leader) {
677
			$record->leader($leader);
690
			$record->leader($leader);
678
		}
691
		}
Lines 704-710 sub AddAuthority { Link Here
704
    }
717
    }
705
	}
718
	}
706
719
707
  if ($format eq "UNIMARCAUTH") {
720
  if (authorityflavour() eq "UNIMARCAUTH") {
708
        $record->leader("     nx  j22             ") unless ($record->leader());
721
        $record->leader("     nx  j22             ") unless ($record->leader());
709
        my $date=POSIX::strftime("%Y%m%d",localtime);    
722
        my $date=POSIX::strftime("%Y%m%d",localtime);    
710
    if (my $string=$record->subfield('100',"a")){
723
    if (my $string=$record->subfield('100',"a")){
Lines 721-727 sub AddAuthority { Link Here
721
    }      
734
    }      
722
  }
735
  }
723
  my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
736
  my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode);
724
  if (!$authid and $format eq "MARC21") {
737
  if (!$authid and authorityflavour() eq "MARC21") {
725
    # only need to do this fix when modifying an existing authority
738
    # only need to do this fix when modifying an existing authority
726
    C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
739
    C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
727
  } 
740
  } 
Lines 753-764 sub AddAuthority { Link Here
753
      $record->add_fields('001',$authid) unless ($record->field('001'));
766
      $record->add_fields('001',$authid) unless ($record->field('001'));
754
#       warn "\n\n\n enregistrement".$record->as_formatted;
767
#       warn "\n\n\n enregistrement".$record->as_formatted;
755
      my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
768
      my $sth=$dbh->prepare("update auth_header set authtypecode=?,marc=?,marcxml=? where authid=?");
756
      $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$authid) or die $sth->errstr;
769
      $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()),$authid) or die $sth->errstr;
757
      $sth->finish;
770
      $sth->finish;
758
  }
771
  }
759
  else {
772
  else {
760
    my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
773
    my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
761
    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format));
774
    $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record(authorityflavour()));
762
    $sth->finish;
775
    $sth->finish;
763
    logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
776
    logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
764
  }
777
  }
Lines 809-817 sub ModAuthority { Link Here
809
      &merge($authid,$oldrecord,$authid,$record);
822
      &merge($authid,$oldrecord,$authid,$record);
810
  } else {
823
  } else {
811
      # save a record in need_merge_authorities table
824
      # save a record in need_merge_authorities table
812
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ".
825
      my $sqlinsert="INSERT INTO need_merge_authorities (authid, init_value, done) ".
813
	"VALUES (?,?)";
826
	"VALUES (?,?,?)";
814
      $dbh->do($sqlinsert,undef,($authid,0));
827
      $dbh->do($sqlinsert,undef,($authid,$oldrecord->as_xml_record(authorityflavour()),0));
815
  }
828
  }
816
  logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
829
  logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
817
  return $authid;
830
  return $authid;
Lines 1439-1444 sub AddAuthorityTrees{ Link Here
1439
  return $rq->execute($trees,$authid);
1452
  return $rq->execute($trees,$authid);
1440
}
1453
}
1441
1454
1455
1442
=head2 merge
1456
=head2 merge
1443
1457
1444
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1458
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
Lines 1448-1631 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1448
1462
1449
=cut
1463
=cut
1450
1464
1465
1466
# Test if a subfield exist in a subfield list
1467
sub _test_subfcode_presence {
1468
    my ( $subfields, $subfcode ) = @_;
1469
    return grep { $_->[0] eq $subfcode } @$subfields;
1470
}
1471
1472
# Test if a string exists in  a field
1473
sub _test_string {
1474
    my ( $string, @fields ) = @_;
1475
    my $return = 0;
1476
    for my $field (@fields) {
1477
        if ( grep { $_->[1] =~ /$string/i } $field->subfields ) {
1478
            $return = 1;
1479
            last;
1480
        }
1481
    }
1482
    return $return;
1483
}
1484
1485
# _process_subfcode_4_merge sets the correct subfcode
1486
sub _process_subfcode_4_merge {
1487
    my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields,
1488
        $authtypecode )
1489
      = @_;
1490
    return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' );
1491
    if (   $tagfield eq "600"
1492
        or $tagfield eq "606"
1493
        or $tagfield eq "607"
1494
        or $tagfield eq "700"
1495
        or $tagfield eq "701"
1496
        or $tagfield eq "702"
1497
        or $tagfield eq "710"
1498
        or $tagfield eq "711"
1499
        or $tagfield eq "712" )
1500
    {
1501
        my $authtag = GetAuthType($authtypecode);
1502
        my $chronological_auth =
1503
          _test_string( qq{S'emploie uniquement en subdivision chronologique},
1504
            $authorityrecord->field('3..') );
1505
        my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' );
1506
        if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) {
1507
            if (    ( $authtag->{'auth_tag_to_report'} eq '215' )
1508
                and ( $tagfield ne "607" ) )
1509
            {
1510
                return "y";
1511
1512
            }
1513
            elsif ( $chronological_auth and $subfz_absent ) {
1514
                return "z";
1515
            }
1516
            else {
1517
                return "x";
1518
            }
1519
        }
1520
        return;
1521
    }
1522
    return;
1523
}
1524
1451
sub merge {
1525
sub merge {
1452
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1526
    my ( $mergefrom, $MARCfrom, $mergeto, $MARCto ) = @_;
1453
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1527
    my $dbh              = C4::Context->dbh;
1454
    my $dbh=C4::Context->dbh;
1528
    my $marcflavour      = C4::Context->preference('marcflavour');
1455
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1529
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1456
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1530
    my $authtypecodeto   = GetAuthTypeCode($mergeto);
1457
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1531
    $MARCfrom ||= GetAuthority($mergefrom);
1532
    $MARCto   ||= GetAuthority($mergeto);
1533
    my @editedbiblios = ();
1534
1458
    # return if authority does not exist
1535
    # return if authority does not exist
1459
    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1536
    return "error MARCFROM not a marcrecord " . Data::Dumper::Dumper($MARCfrom)
1460
    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
1537
      if ( !$MARCfrom or scalar( $MARCfrom->fields() ) == 0 );
1538
    return "error MARCTO not a marcrecord" . Data::Dumper::Dumper($MARCto)
1539
      if ( !$MARCto or scalar( $MARCto->fields() ) == 0 );
1540
1461
    # search the tag to report
1541
    # search the tag to report
1462
    my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
1542
    my $sth = $dbh->prepare(
1543
        "select auth_tag_to_report from auth_types where authtypecode=?");
1463
    $sth->execute($authtypecodefrom);
1544
    $sth->execute($authtypecodefrom);
1464
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1545
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1465
    $sth->execute($authtypecodeto);
1546
    $sth->execute($authtypecodeto);
1466
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1547
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1467
    
1548
1468
    my @record_to;
1549
    my @record_to;
1469
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1550
    @record_to =
1551
      grep { $_->[0] !~ /[0-9]/ }
1552
      $MARCto->field($auth_tag_to_report_to)->subfields()
1553
      if $MARCto->field($auth_tag_to_report_to);
1554
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1555
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1556
    }
1557
    my $field_to;
1558
    $field_to = $MARCto->field($auth_tag_to_report_to)
1559
      if $MARCto->field($auth_tag_to_report_to);
1470
    my @record_from;
1560
    my @record_from;
1471
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1561
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields()
1472
    
1562
      if $MARCfrom->field($auth_tag_to_report_from);
1563
1473
    my @reccache;
1564
    my @reccache;
1565
1474
    # search all biblio tags using this authority.
1566
    # search all biblio tags using this authority.
1475
    #Getting marcbiblios impacted by the change.
1567
    #Getting marcbiblios impacted by the change.
1476
    if (C4::Context->preference('NoZebra')) {
1568
    if ( C4::Context->preference('NoZebra') ) {
1477
        #nozebra way    
1569
1478
        my $dbh=C4::Context->dbh;
1570
        #nozebra way
1479
        my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
1571
        my $dbh = C4::Context->dbh;
1572
        my $rq  = $dbh->prepare(
1573
qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )
1574
        );
1480
        $rq->execute;
1575
        $rq->execute;
1481
        while (my $biblionumbers=$rq->fetchrow){
1576
        while ( my $biblionumbers = $rq->fetchrow ) {
1482
            my @biblionumbers=split /;/,$biblionumbers;
1577
            my @biblionumbers = split /;/, $biblionumbers;
1483
            foreach (@biblionumbers) {
1578
            foreach (@biblionumbers) {
1484
                if ($_=~/(\d+),.*/) {
1579
                if ( $_ =~ /(\d+),.*/ ) {
1485
                    my $marc=GetMarcBiblio($1);
1580
                    my $marc = GetMarcBiblio($1);
1486
                    push @reccache,$marc;
1581
                    push @reccache, $marc;
1487
                }
1582
                }
1488
            }
1583
            }
1489
        }
1584
        }
1490
    } else {
1585
    }
1491
        #zebra connection  
1586
    else {
1492
        my $oConnection=C4::Context->Zconn("biblioserver",0);
1587
1493
        # We used to use XML syntax here, but that no longer works.
1588
        #zebra connection
1494
        # Thankfully, we don't need it.
1589
        my ( $err, $res, $result ) =
1495
        my $query;
1590
          C4::Search::SimpleSearch( "an=$mergefrom", 0, 999999 );
1496
        $query= "an=".$mergefrom;
1591
        my $z = 0;
1497
        my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1592
        foreach my $rawrecord (@$res) {
1498
        my $count = 0;
1593
            my $marcrecord = MARC::File::USMARC::decode($rawrecord);
1499
        if  ($oResult) {
1594
            SetUTF8Flag($marcrecord);
1500
            $count=$oResult->size();
1595
            push @reccache, $marcrecord;
1501
        }
1502
        my $z=0;
1503
        while ( $z<$count ) {
1504
            my $rec;
1505
            $rec=$oResult->record($z);
1506
            my $marcdata = $rec->raw();
1507
            my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata);
1508
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1509
            my $i = ($biblionumbertagfield < 10) ? $marcrecordzebra->field($biblionumbertagfield)->data : $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1510
            my $marcrecorddb=GetMarcBiblio($i);
1511
            push @reccache, $marcrecorddb;
1512
            $z++;
1513
        }
1596
        }
1514
        $oResult->destroy();
1515
    }
1597
    }
1516
    #warn scalar(@reccache)." biblios to update";
1598
1517
    # Get All candidate Tags for the change 
1599
    # Get All candidate Tags for the change
1518
    # (This will reduce the search scope in marc records).
1600
    # (This will reduce the search scope in marc records).
1519
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1601
    $sth = $dbh->prepare(
1520
    $sth->execute($authtypecodefrom);
1602
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1603
    );
1604
    $sth->execute();
1521
    my @tags_using_authtype;
1605
    my @tags_using_authtype;
1522
    while (my ($tagfield) = $sth->fetchrow) {
1606
    while ( my ($tagfield) = $sth->fetchrow ) {
1523
        push @tags_using_authtype,$tagfield ;
1607
        push @tags_using_authtype, $tagfield;
1524
    }
1608
    }
1525
    my $tag_to=0;  
1609
    my $tag_to = 0;
1526
    if ($authtypecodeto ne $authtypecodefrom){  
1610
1527
        # If many tags, take the first
1611
    # if any element in this list matchs exactly a subfield in the biblio field
1528
        $sth->execute($authtypecodeto);    
1612
    # which is before the $9, the subfield is removed.
1529
        $tag_to=$sth->fetchrow;
1613
    my @data_to_remove = map { $_->[1] } @record_from;
1530
        #warn $tag_to;    
1614
    if ( uc( C4::Context->preference('marcflavour') ) eq "UNIMARC" ) {
1531
    }  
1615
1532
    # BulkEdit marc records
1616
        # If in UNIMARC, we also want to remove PPN if it's before $9 (it will
1533
    # May be used as a template for a bulkedit field  
1617
        # be reinserted after)
1534
    foreach my $marcrecord(@reccache){
1618
        foreach my $record ( $MARCto, $MARCfrom ) {
1535
        my $update;           
1619
            my $field = $record->field('009');
1536
        foreach my $tagfield (@tags_using_authtype){
1620
            if ( $field and ( my $data = $field->data() ) ) {
1537
#             warn "tagfield : $tagfield ";
1621
                push @data_to_remove, $data;
1538
            foreach my $field ($marcrecord->field($tagfield)){
1622
            }
1539
                # biblio is linked to authority with $9 subfield containing authid
1623
        }
1540
                my $auth_number=$field->subfield("9");
1624
    }
1541
                my $tag=$field->tag();          
1625
1542
                if ($auth_number==$mergefrom) {
1626
    foreach my $marcrecord (@reccache) {
1543
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1627
        foreach my $tagfield (@tags_using_authtype) {
1544
		my $exclude='9';
1628
            foreach my $field ( $marcrecord->field($tagfield) ) {
1545
                foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
1629
                my $update;
1546
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1630
                my $tag = $field->tag();
1547
		    $exclude.= $subfield->[0];
1631
                my @newsubfields;
1632
                my %indexes;
1633
1634
                #get to next field if no subfield
1635
                my @localsubfields = $field->subfields();
1636
                my $index_9_auth   = first_index {
1637
                          ( $_->[0] eq 9 )
1638
                      and ( $_->[1] eq "$mergefrom" );
1548
                }
1639
                }
1549
		$exclude='['.$exclude.']';
1640
                @localsubfields;
1550
#		add subfields in $field not included in @record_to
1641
                next if ( $index_9_auth < 0 );
1551
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1642
1552
                foreach my $subfield (@restore) {
1643
                # Removes the data if before the $9
1553
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1644
                my $index = 0;
1554
		}
1645
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1646
                    if ( any { $subf->[1] eq $_ } @data_to_remove ) {
1647
                        $debug && warn "found $subf->[0] " . $subf->[1];
1648
                        splice @localsubfields, $index, 1;
1649
                        $index_9_auth--;
1650
                    }
1651
                    else {
1652
                        $index++;
1653
                    }
1654
                }
1655
1656
                #Get the next $9 subfield
1657
                my $nextindex_9 =
1658
                  first_index { $_->[0] =~ /[12456789]/ }
1659
                @localsubfields[ $index_9_auth + 1 .. $#localsubfields ];
1660
1661
        #Change the first tag if required
1662
        # That is : change the first tag ($a) to what it is in the biblio record
1663
        # Since some composed authorities will place the $a into $x or $y
1664
1665
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1666
1667
# Changing the record_to first $a subfield code is quite a dangerous idea.
1668
# But in order to clone the subfield structure and avoid the side effect affectation
1669
# one would need to parse the whole subfield structure
1670
# This would break performance a little more.
1671
                my $changesubfcode;
1672
                if (
1673
                    $changesubfcode = _process_subfcode_4_merge(
1674
                        $tag,    \@previous_subfields,
1675
                        $MARCto, \@record_to,
1676
                        $authtypecodeto
1677
                    )
1678
                  )
1679
                {
1680
                    my $index_subf_a =
1681
                      first_index { $_->[0] eq "a" } @record_to;
1682
                    $record_to[$index_subf_a]->[0] = $changesubfcode
1683
                      if defined($changesubfcode);
1684
                }
1685
1686
# Replace in local subfields the subfields related to recordfrom with data from record_to
1687
1688
                my @localrecord_to = @record_to;
1689
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1690
                my $length =
1691
                  ( $nextindex_9 > 0 )
1692
                  ? $nextindex_9 + 1
1693
                  : $#localsubfields - $#previous_subfields + 1;
1694
                splice(
1695
                    @localsubfields, $index_9_auth,
1696
                    $length,         @localrecord_to
1697
                );
1698
1699
      # very nice api for MARC::Record
1700
      # It seems that some elements localsubfields can be undefined so skip them
1701
                @newsubfields =
1702
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1703
1704
                #filter to subfields which are not in the subfield
1705
                my $field_to = MARC::Field->new(
1706
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1707
                    $field->indicator(2), @newsubfields
1708
                );
1555
                $marcrecord->delete_field($field);
1709
                $marcrecord->delete_field($field);
1556
                $marcrecord->insert_grouped_field($field_to);            
1710
                $marcrecord->insert_fields_ordered($field_to);
1557
                $update=1;
1711
1712
                # if the first $a was change, restore it before next iteration
1713
                if ($changesubfcode) {
1714
                    my $index_subf =
1715
                      first_index { $_->[0] eq $changesubfcode } @record_to;
1716
                    $record_to[$index_subf]->[0] = "a";
1558
                }
1717
                }
1559
            }#for each tag
1718
            }    #for each tag
1560
        }#foreach tagfield
1719
        }    #foreach tagfield
1561
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1720
        my ( $bibliotag, $bibliosubf ) =
1721
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1562
        my $biblionumber;
1722
        my $biblionumber;
1563
        if ($bibliotag<10){
1723
        if ( $bibliotag < 10 ) {
1564
            $biblionumber=$marcrecord->field($bibliotag)->data;
1724
            $biblionumber = $marcrecord->field($bibliotag)->data;
1565
        }
1725
        }
1566
        else {
1726
        else {
1567
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1727
            $biblionumber = $marcrecord->subfield( $bibliotag, $bibliosubf );
1568
        }
1728
        }
1569
        unless ($biblionumber){
1729
        unless ($biblionumber) {
1570
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1730
            warn "No biblionumber in : "
1731
              . $marcrecord->as_formatted;
1571
            next;
1732
            next;
1572
        }
1733
        }
1573
        if ($update==1){
1734
        my $mod_ok =
1574
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1735
          &ModBiblio( $marcrecord, $biblionumber,
1575
            $counteditedbiblio++;
1736
            GetFrameworkCode($biblionumber) );
1576
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1737
        push @editedbiblios, $biblionumber if $mod_ok;
1577
        }    
1738
    }    #foreach $marc
1578
    }#foreach $marc
1739
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1579
    return $counteditedbiblio;  
1740
    return @editedbiblios;
1580
  # now, find every other authority linked with this authority
1741
}    #sub
1581
  # now, find every other authority linked with this authority
1582
#   my $oConnection=C4::Context->Zconn("authorityserver");
1583
#   my $query;
1584
# # att 9210               Auth-Internal-authtype
1585
# # att 9220               Auth-Internal-LN
1586
# # ccl.properties to add for authorities
1587
#   $query= "= ".$mergefrom;
1588
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1589
#   my $count=$oResult->size() if  ($oResult);
1590
#   my @reccache;
1591
#   my $z=0;
1592
#   while ( $z<$count ) {
1593
#   my $rec;
1594
#           $rec=$oResult->record($z);
1595
#       my $marcdata = $rec->raw();
1596
#   push @reccache, $marcdata;
1597
#   $z++;
1598
#   }
1599
#   $oResult->destroy();
1600
#   foreach my $marc(@reccache){
1601
#     my $update;
1602
#     my $marcrecord;
1603
#     $marcrecord = MARC::File::USMARC::decode($marc);
1604
#     foreach my $tagfield (@tags_using_authtype){
1605
#       $tagfield=substr($tagfield,0,3);
1606
#       my @tags = $marcrecord->field($tagfield);
1607
#       foreach my $tag (@tags){
1608
#         my $tagsubs=$tag->subfield("9");
1609
#     #warn "$tagfield:$tagsubs:$mergefrom";
1610
#         if ($tagsubs== $mergefrom) {
1611
#           $tag->update("9" =>$mergeto);
1612
#           foreach my $subfield (@record_to) {
1613
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1614
#             $tag->update($subfield->[0] =>$subfield->[1]);
1615
#           }#for $subfield
1616
#         }
1617
#         $marcrecord->delete_field($tag);
1618
#         $marcrecord->add_fields($tag);
1619
#         $update=1;
1620
#       }#for each tag
1621
#     }#foreach tagfield
1622
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1623
#     if ($update==1){
1624
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1625
#     }
1626
# 
1627
#   }#foreach $marc
1628
}#sub
1629
1742
1630
=head2 get_auth_type_location
1743
=head2 get_auth_type_location
1631
1744
(-)a/C4/Charset.pm (+45 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 1158-1163 sub char_decode5426 { Link Here
1158
  return $result;
1160
  return $result;
1159
}
1161
}
1160
1162
1163
=head2 SanitizeEntity
1164
1165
  my $utf8string = SanitizeEntity($record);
1166
1167
Removes &amp; from records (since zebra is adding multiple &amps
1168
1169
=cut
1170
1171
sub SanitizeEntity {
1172
    my $record = shift;
1173
1174
    foreach my $field ($record->fields()) {
1175
        if ($field->is_control_field()) {
1176
            $field->update(entity_clean($field->data()));
1177
        } else {
1178
            my @subfields = $field->subfields();
1179
            my @new_subfields;
1180
            foreach my $subfield (@subfields) {
1181
                push @new_subfields, $subfield->[0] => entity_clean($subfield->[1]);
1182
            }
1183
            if (scalar(@new_subfields) > 0) {
1184
                my $new_field;
1185
                eval {
1186
                    $new_field = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @new_subfields);
1187
                };
1188
                if ($@) {
1189
		    warn "error : $@";
1190
                } else {
1191
                    $field->replace_with($new_field);
1192
                }
1193
1194
            }
1195
        }
1196
    }
1197
    return $record;
1198
}
1199
1200
sub entity_clean {
1201
    my $string=shift;
1202
    $string=~s/(&)(amp;)+/$1/g;
1203
    return $string;
1204
}
1205
1161
1;
1206
1;
1162
1207
1163
1208
(-)a/installer/data/mysql/kohastructure.sql (+1 lines)
Lines 1358-1363 DROP TABLE IF EXISTS `need_merge_authorities`; Link Here
1358
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)
1358
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)
1359
  `id` int NOT NULL auto_increment PRIMARY KEY, -- unique id
1359
  `id` int NOT NULL auto_increment PRIMARY KEY, -- unique id
1360
  `authid` bigint NOT NULL, -- reference to authority record
1360
  `authid` bigint NOT NULL, -- reference to authority record
1361
  `init_value` longtext DEFAULT NULL,  -- previous value of the record (required when 'merging')
1361
  `done` tinyint DEFAULT 0  -- indication whether merge has been executed (0=not done, 1= done, 2= in progress)
1362
  `done` tinyint DEFAULT 0  -- indication whether merge has been executed (0=not done, 1= done, 2= in progress)
1362
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
1363
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
1363
1364
(-)a/installer/data/mysql/updatedatabase.pl (+10 lines)
Lines 6411-6416 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
6411
    SetVersion($DBversion);
6411
    SetVersion($DBversion);
6412
}
6412
}
6413
6413
6414
$DBversion = "XXX.XX.XX.XXX";
6415
if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
6416
    $dbh->do(qq{
6417
        ALTER TABLE need_merge_authorities ADD COLUMN init_value LONGTEXT DEFAULT NULL AFTER authid;
6418
    });
6419
6420
    print "Upgrade to $DBversion done (Bug 8304: Support For Rameau merge fixing)\n";
6421
    SetVersion($DBversion);
6422
}
6423
6414
=head1 FUNCTIONS
6424
=head1 FUNCTIONS
6415
6425
6416
=head2 TableExists($table)
6426
=head2 TableExists($table)
(-)a/installer/data/mysql/versions/bug_8304.sql (+7 lines)
Line 0 Link Here
1
-- Bug 8304: Support For Rameau merge fixing
2
--
3
-- This patch adds a new column to need_merge_authorities storing the previous version of 
4
-- edited authority in order to be able to delete the values of the heading reported in
5
-- the biblio record when merging.
6
7
ALTER TABLE need_merge_authorities ADD COLUMN init_value LONGTEXT DEFAULT NULL AFTER authid;
(-)a/misc/migration_tools/bulkmarcimport.pl (-52 / +166 lines)
Lines 24-38 use C4::Koha; Link Here
24
use C4::Debug;
24
use C4::Debug;
25
use C4::Charset;
25
use C4::Charset;
26
use C4::Items;
26
use C4::Items;
27
use YAML;
27
use Unicode::Normalize;
28
use Unicode::Normalize;
28
use Time::HiRes qw(gettimeofday);
29
use Time::HiRes qw(gettimeofday);
29
use Getopt::Long;
30
use Getopt::Long;
30
use IO::File;
31
use IO::File;
31
use Pod::Usage;
32
use Pod::Usage;
32
33
33
binmode STDOUT, ':encoding(UTF-8)';
34
use open qw( :std :utf8 );
35
binmode( STDOUT, ":utf8" );
34
my ( $input_marc_file, $number, $offset) = ('',0,0);
36
my ( $input_marc_file, $number, $offset) = ('',0,0);
35
my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off,$format,$biblios,$authorities,$keepids,$match, $isbn_check, $logfile);
37
my ($version, $delete, $test_parameter, $skip_marc8_conversion, $char_encoding, $verbose, $commit, $fk_off,$format,$biblios,$authorities,$keepids,$match, $isbn_check, $logfile);
38
39
my ( $insert, $filters, $update, $all, $yamlfile, $authtypes );
36
my $cleanisbn = 1;
40
my $cleanisbn = 1;
37
my ($sourcetag,$sourcesubfield,$idmapfl, $dedup_barcode);
41
my ($sourcetag,$sourcesubfield,$idmapfl, $dedup_barcode);
38
my $framework = '';
42
my $framework = '';
Lines 46-52 GetOptions( Link Here
46
    'o|offset:f' => \$offset,
50
    'o|offset:f' => \$offset,
47
    'h' => \$version,
51
    'h' => \$version,
48
    'd' => \$delete,
52
    'd' => \$delete,
49
    't' => \$test_parameter,
53
    't|test' => \$test_parameter,
50
    's' => \$skip_marc8_conversion,
54
    's' => \$skip_marc8_conversion,
51
    'c:s' => \$char_encoding,
55
    'c:s' => \$char_encoding,
52
    'v:s' => \$verbose,
56
    'v:s' => \$verbose,
Lines 56-61 GetOptions( Link Here
56
    'k|keepids:s' => \$keepids,
60
    'k|keepids:s' => \$keepids,
57
    'b|biblios' => \$biblios,
61
    'b|biblios' => \$biblios,
58
    'a|authorities' => \$authorities,
62
    'a|authorities' => \$authorities,
63
    'authtypes:s' => \$authtypes,
64
    'filter=s@'     => \$filters,
65
    'insert'        => \$insert,
66
    'update'        => \$update,
67
    'all'           => \$all,
59
    'match=s@'    => \$match,
68
    'match=s@'    => \$match,
60
    'i|isbn' => \$isbn_check,
69
    'i|isbn' => \$isbn_check,
61
    'x:s' => \$sourcetag,
70
    'x:s' => \$sourcetag,
Lines 64-77 GetOptions( Link Here
64
    'cleanisbn!'     => \$cleanisbn,
73
    'cleanisbn!'     => \$cleanisbn,
65
    'dedupbarcode' => \$dedup_barcode,
74
    'dedupbarcode' => \$dedup_barcode,
66
    'framework=s' => \$framework,
75
    'framework=s' => \$framework,
76
    'yaml:s'        => \$yamlfile,
67
);
77
);
68
$biblios=!$authorities||$biblios;
78
$biblios ||= !$authorities;
79
$insert  ||= !$update;
80
81
if ($all) {
82
    $insert = 1;
83
    $update = 1;
84
}
69
85
70
if ($version || ($input_marc_file eq '')) {
86
if ($version || ($input_marc_file eq '')) {
71
    pod2usage( -verbose => 2 );
87
    pod2usage( -verbose => 2 );
72
    exit;
88
    exit;
73
}
89
}
74
90
91
my $heading_fields=get_heading_fields();
92
75
if (defined $idmapfl) {
93
if (defined $idmapfl) {
76
  open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n";
94
  open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n";
77
}
95
}
Lines 142-148 $batch->warnings_off(); Link Here
142
$batch->strict_off();
160
$batch->strict_off();
143
my $i=0;
161
my $i=0;
144
my $commitnum = $commit ? $commit : 50;
162
my $commitnum = $commit ? $commit : 50;
145
163
my $yamlhash;
146
164
147
# Skip file offset
165
# Skip file offset
148
if ( $offset ) {
166
if ( $offset ) {
Lines 199-204 RECORD: while ( ) { Link Here
199
            next RECORD;            
217
            next RECORD;            
200
        }
218
        }
201
    }
219
    }
220
    SetUTF8Flag($record);
202
    my $isbn;
221
    my $isbn;
203
    # remove trailing - in isbn (only for biblios, of course)
222
    # remove trailing - in isbn (only for biblios, of course)
204
    if ($biblios && $cleanisbn) {
223
    if ($biblios && $cleanisbn) {
Lines 212-256 RECORD: while ( ) { Link Here
212
    }
231
    }
213
    my $id;
232
    my $id;
214
    # search for duplicates (based on Local-number)
233
    # search for duplicates (based on Local-number)
215
    if ($match){
234
    my $originalid;
216
       require C4::Search;
235
    $originalid = GetRecordId( $record, $tagid, $subfieldid );
217
       my $query=build_query($match,$record);
236
    if ($match) {
218
       my $server=($authorities?'authorityserver':'biblioserver');
237
        require C4::Search;
219
       my ($error, $results,$totalhits)=C4::Search::SimpleSearch( $query, 0, 3, [$server] );
238
        my $query = build_query( $match, $record );
220
       die "unable to search the database for duplicates : $error" if (defined $error);
239
        my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
221
       #warn "$query $server : $totalhits";
240
        $debug && warn $query;
222
       if ( @{$results} == 1 ){
241
        my ( $error, $results, $totalhits ) = C4::Search::SimpleSearch( $query, 0, 3, [$server] );
223
           my $marcrecord = MARC::File::USMARC::decode($results->[0]);
242
        die "unable to search the database for duplicates : $error" if ( defined $error );
224
	   	   $id=GetRecordId($marcrecord,$tagid,$subfieldid);
243
        $debug && warn "$query $server : $totalhits";
225
       } 
244
        if ( $results && scalar(@$results) == 1 ) {
226
       elsif  ( @{$results} > 1){
245
            my $marcrecord = MARC::File::USMARC::decode( $results->[0] );
227
           $debug && warn "more than one match for $query";
246
            SetUTF8Flag($marcrecord);
228
       } 
247
            $id = GetRecordId( $marcrecord, $tagid, $subfieldid );
229
       else {
248
            if ( $authorities && $marcFlavour ) {
230
           $debug && warn "nomatch for $query";
249
                #Skip if authority in database is the same as the on in database
231
       }
250
                if ( $marcrecord->field('005')->data >= $record->field('005')->data ) {
251
                    if ($yamlfile) {
252
                        $yamlhash->{$originalid}->{'authid'} = $id;
253
254
                        # On récupère tous les souschamps des champs vedettes d'autorités
255
                        my @subfields;
256
                        foreach my $field ( $marcrecord->field("2..") ) {
257
                            push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
258
                        }
259
                        $yamlhash->{$originalid}->{'subfields'} = \@subfields;
260
                    }
261
                    next;
262
                }
263
            }
264
        } elsif ( $results && scalar(@$results) > 1 ) {
265
            $debug && warn "more than one match for $query";
266
        } else {
267
            $debug && warn "nomatch for $query";
268
        }
232
    }
269
    }
233
	my $originalid;
270
    if ($keepids && $originalid) {
234
    if ($keepids){
271
            my $storeidfield;
235
	  $originalid=GetRecordId($record,$tagid,$subfieldid);
272
            if ( length($keepids) == 3 ) {
236
      if ($originalid){
273
                $storeidfield = MARC::Field->new( $keepids, $originalid );
237
		 my $storeidfield;
274
            } else {
238
		 if (length($keepids)==3){
275
                $storeidfield = MARC::Field->new( substr( $keepids, 0, 3 ), "", "", substr( $keepids, 3, 1 ), $originalid );
239
		 	$storeidfield=MARC::Field->new($keepids,$originalid);
276
            }
240
		 }
277
            $record->insert_fields_ordered($storeidfield);
241
		 else  {
278
            $record->delete_field( $record->field($tagid) );
242
			$storeidfield=MARC::Field->new(substr($keepids,0,3),"","",substr($keepids,3,1),$originalid);
243
		 }
244
         $record->insert_fields_ordered($storeidfield);
245
	     $record->delete_field($record->field($tagid));
246
      }
247
    }
279
    }
280
    foreach my $stringfilter (@$filters) {
281
        if ( length($stringfilter) == 3 ) {
282
            foreach my $field ( $record->field($stringfilter) ) {
283
                $record->delete_field($field);
284
                $debug && warn "removed : ", $field->as_string;
285
            }
286
        } else {
287
            my ( $removetag, $removesubfield, $removematch ) = ( $1, $2, $3 )
288
              if $stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/;
289
            if ( ( $removetag > "010" ) && $removesubfield ) {
290
                foreach my $field ( $record->field($removetag) ) {
291
                    $field->delete_subfield( code => "$removesubfield", match => $removematch );
292
                    $debug && warn "Potentially removed : ", $field->subfield($removesubfield);
293
                }
294
            }
295
        }
296
    }
297
248
    unless ($test_parameter) {
298
    unless ($test_parameter) {
249
        if ($authorities){
299
        if ($authorities){
250
            use C4::AuthoritiesMarc;
300
            use C4::AuthoritiesMarc;
251
            my $authtypecode=GuessAuthTypeCode($record);
301
            my $authtypecode=GuessAuthTypeCode($record, $heading_fields);
302
            $authtypecode//='SNC';
252
            my $authid= ($id?$id:GuessAuthId($record));
303
            my $authid= ($id?$id:GuessAuthId($record));
253
            if ($authid && GetAuthority($authid)){
304
            if ($authid && GetAuthority($authid) && $update ){
254
            ## Authority has an id and is in database : Replace
305
            ## Authority has an id and is in database : Replace
255
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
306
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
256
                if ($@){
307
                if ($@){
Lines 283-288 RECORD: while ( ) { Link Here
283
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
334
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
284
				}
335
				}
285
 	        }
336
 	        }
337
            if ($yamlfile) {
338
            $yamlhash->{$originalid}->{'authid'} = $authid;
339
            my @subfields;
340
            foreach my $field ( $record->field("2..") ) {
341
                push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
342
            }
343
            $yamlhash->{$originalid}->{'subfields'} = \@subfields;
344
            }
286
        }
345
        }
287
        else {
346
        else {
288
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
347
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
Lines 306-325 RECORD: while ( ) { Link Here
306
			}
365
			}
307
					# create biblio, unless we already have it ( either match or isbn )
366
					# create biblio, unless we already have it ( either match or isbn )
308
            if ($biblionumber) {
367
            if ($biblionumber) {
309
				eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};}
368
                eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};};
310
			}
369
                if ($update) {
311
			else 
370
                    eval { ( $biblionumber, $biblioitemnumber ) = ModBiblio( $record, $biblionumber, GetFrameworkcode($biblionumber) ) };
312
			{
371
                    if ($@) {
313
                eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio($record, $framework, { defer_marc_save => 1 }) };
372
                        warn "ERROR: Edit biblio $biblionumber failed: $@\n";
373
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ERROR" } ) if ($logfile);
374
                        next RECORD;
375
                    } else {
376
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ok" } ) if ($logfile);
377
                    }
378
                } else {
379
                    printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "warning : already in database" } ) if ($logfile);
380
                }
381
            } else {
382
                if ($insert) {
383
                    eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '', { defer_marc_save => 1 } ) };
384
                    if ($@) {
385
                        warn "ERROR: Adding biblio $biblionumber failed: $@\n";
386
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ERROR" } ) if ($logfile);
387
                        next RECORD;
388
                    } else {
389
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ok" } ) if ($logfile);
390
                    }
391
                } else {
392
                    printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "warning : not in database" } ) if ($logfile);
393
                }
314
            }
394
            }
315
            if ( $@ ) {
316
                warn "ERROR: Adding biblio $biblionumber failed: $@\n";
317
				printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ERROR"}) if ($logfile);
318
                next RECORD;
319
            } 
320
 			else{
321
				printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile);
322
			}
323
            eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
395
            eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
324
            my $error_adding = $@;
396
            my $error_adding = $@;
325
            # Work on a clone so that if there are real errors, we can maybe
397
            # Work on a clone so that if there are real errors, we can maybe
Lines 384-389 RECORD: while ( ) { Link Here
384
            if ($#{ $errors_ref } > -1) {
456
            if ($#{ $errors_ref } > -1) {
385
                report_item_errors($biblionumber, $errors_ref);
457
                report_item_errors($biblionumber, $errors_ref);
386
            }
458
            }
459
            $yamlhash->{$originalid} = $biblionumber if ($yamlfile);
387
        }
460
        }
388
        $dbh->commit() if (0 == $i % $commitnum);
461
        $dbh->commit() if (0 == $i % $commitnum);
389
    }
462
    }
Lines 407-412 if ($logfile){ Link Here
407
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
480
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
408
  $loghandle->close;
481
  $loghandle->close;
409
}
482
}
483
if ($yamlfile) {
484
    open YAML, "> $yamlfile" or die "cannot open $yamlfile \n";
485
    print YAML Dump($yamlhash);
486
}
410
exit 0;
487
exit 0;
411
488
412
sub GetRecordId{
489
sub GetRecordId{
Lines 462-470 sub report_item_errors { Link Here
462
}
539
}
463
sub printlog{
540
sub printlog{
464
	my $logelements=shift;
541
	my $logelements=shift;
465
	print $loghandle join (";",@$logelements{qw<id op status>}),"\n";
542
    print $loghandle join( ";", map { defined $_ ? $_ : "" } @$logelements{qw<id op status>} ), "\n";
466
}
543
}
544
sub get_heading_fields{
545
    my $headingfields;
546
    if ($authtypes){
547
        $headingfields=YAML::LoadFile($authtypes);
467
548
549
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
550
        $debug && warn YAML::Dump($headingfields);
551
    }
552
    unless ($headingfields){
553
        $headingfields=C4::Context->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=>{}});
554
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
555
    }
556
    return $headingfields;
557
}
468
558
469
=head1 NAME
559
=head1 NAME
470
560
Lines 526-532 The I<NUMBER> of records to wait before performing a 'commit' operation Link Here
526
616
527
File logs actions done for each record and their status into file
617
File logs actions done for each record and their status into file
528
618
529
=item B<-t>
619
=item B<-t, -test>
530
620
531
Test mode: parses the file, saying what he would do, but doing nothing.
621
Test mode: parses the file, saying what he would do, but doing nothing.
532
622
Lines 549-554 biblioitems, items Link Here
549
639
550
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
640
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
551
641
642
=item B<-authtypes>
643
644
file yamlfile with authoritiesTypes and distinguishable record field in order
645
to store the correct authtype
646
647
=item B<-yaml>
648
649
yaml file  format a yaml file with ids
650
keepids field store ids in field (usefull for authorities,
651
where 001 contains the authid for Koha, that can contain a very valuable
652
info for authorities coming from LOC or BNF. useless for biblios probably
653
654
=item B<-insert>
655
656
if set, only insert when possible
657
658
=item B<-update>
659
660
if set, only updates (any biblio should have a matching record)
661
662
=item B<-all>
663
664
if set, do whatever is required
665
552
=item B<-k, -keepids>=<FIELD>
666
=item B<-k, -keepids>=<FIELD>
553
667
554
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
668
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
(-)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];
84
      my $MARCinit=eval{MARC::Record->new_from_xml($value_init, "utf-8",authorityflavour())} if defined $value_init;
85
      # if no valid xml record, then we may use MARCauth (the way it was before)
86
      $MARCinit//=$MARCauth;
83
      print "managing $authid\n" if $verbose;
87
      print "managing $authid\n" if $verbose;
84
      my $MARCauth = GetAuthority($authid) ;
88
      my $MARCauth = GetAuthority($authid) ;
85
      next unless ($MARCauth);
89
      next unless ($MARCauth);
86
      merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
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