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

(-)a/C4/AuthoritiesMarc.pm (-99 / +191 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/;
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 449-464 sub GetAuthTypeCode { Link Here
449
 
451
 
450
=head2 GuessAuthTypeCode
452
=head2 GuessAuthTypeCode
451
453
452
  my $authtypecode = GuessAuthTypeCode($record);
454
  my $authtypecode = GuessAuthTypeCode($record, [$headingfields]);
453
455
454
Get the record and tries to guess the adequate authtypecode from its content.
456
Get the record and tries to guess the adequate authtypecode from its content.
455
457
456
=cut
458
=cut
457
459
458
sub GuessAuthTypeCode {
460
sub GuessAuthTypeCode {
459
    my ($record) = @_;
461
    my ($record, $heading_fields) = @_;
460
    return unless defined $record;
462
    return unless defined $record;
461
my $heading_fields = {
463
    $heading_fields //= {
462
    "MARC21"=>{
464
    "MARC21"=>{
463
        '100'=>{authtypecode=>'PERSO_NAME'},
465
        '100'=>{authtypecode=>'PERSO_NAME'},
464
        '110'=>{authtypecode=>'CORPO_NAME'},
466
        '110'=>{authtypecode=>'CORPO_NAME'},
Lines 1439-1444 sub AddAuthorityTrees{ Link Here
1439
  return $rq->execute($trees,$authid);
1441
  return $rq->execute($trees,$authid);
1440
}
1442
}
1441
1443
1444
1442
=head2 merge
1445
=head2 merge
1443
1446
1444
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1447
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
Lines 1448-1457 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1448
1451
1449
=cut
1452
=cut
1450
1453
1454
# Test if a subfield exist in a subfield list
1455
sub _test_subfcode_presence {
1456
    my ( $subfields, $subfcode ) = @_;
1457
    return grep { $_->[0] eq $subfcode } @$subfields;
1458
}
1459
1460
# Test if a string exists in  a field
1461
sub _test_string {
1462
    my ( $string, @fields ) = @_;
1463
    my $return = 0;
1464
    for my $field (@fields) {
1465
        if ( grep { $_->[1] =~ /$string/i } $field->subfields ) {
1466
            $return = 1;
1467
            last;
1468
        }
1469
    }
1470
    return $return;
1471
}
1472
1473
# _process_subfcode_4_merge sets the correct subfcode
1474
sub _process_subfcode_4_merge {
1475
    my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields,
1476
        $authtypecode )
1477
      = @_;
1478
    return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' );
1479
    my $authtag = GetAuthType($authtypecode);
1480
    my $chronological_auth =
1481
      _test_string( qq{S'emploie uniquement en subdivision chronologique},
1482
        $authorityrecord->field('3..') );
1483
    my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' );
1484
    if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) {
1485
        if (    ( $authtag->{'auth_tag_to_report'} eq '215' )
1486
            and ( $tagfield ne "607" ) )
1487
        {
1488
            return "y";
1489
1490
        }
1491
        elsif ( $chronological_auth and $subfz_absent ) {
1492
            return "z";
1493
        }
1494
        else {
1495
            return "x";
1496
        }
1497
    }
1498
    return;
1499
}
1500
1451
sub merge {
1501
sub merge {
1452
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1502
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1453
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1503
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1454
    my $dbh=C4::Context->dbh;
1504
    my $dbh=C4::Context->dbh;
1505
    my $marcflavour      = C4::Context->preference('marcflavour');
1455
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1506
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1456
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1507
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1457
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1508
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
Lines 1466-1476 sub merge { Link Here
1466
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1517
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1467
    
1518
    
1468
    my @record_to;
1519
    my @record_to;
1469
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1520
    @record_to =
1521
      grep { $_->[0] !~ /[0-9]/ }
1522
      $MARCto->field($auth_tag_to_report_to)->subfields()
1523
      if $MARCto->field($auth_tag_to_report_to);
1524
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1525
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1526
    }
1527
    $debug and warn 'fields to merge', Data::Dumper::Dumper(@record_to);
1528
    my $field_to;
1529
    $field_to = $MARCto->field($auth_tag_to_report_to)
1530
      if $MARCto->field($auth_tag_to_report_to);
1470
    my @record_from;
1531
    my @record_from;
1471
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1532
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1472
    
1533
    
1473
    my @reccache;
1534
    my @reccache;
1535
1474
    # search all biblio tags using this authority.
1536
    # search all biblio tags using this authority.
1475
    #Getting marcbiblios impacted by the change.
1537
    #Getting marcbiblios impacted by the change.
1476
    if (C4::Context->preference('NoZebra')) {
1538
    if (C4::Context->preference('NoZebra')) {
Lines 1513-1564 sub merge { Link Here
1513
        }
1575
        }
1514
        $oResult->destroy();
1576
        $oResult->destroy();
1515
    }
1577
    }
1578
1516
    #warn scalar(@reccache)." biblios to update";
1579
    #warn scalar(@reccache)." biblios to update";
1517
    # Get All candidate Tags for the change 
1580
    # Get All candidate Tags for the change 
1518
    # (This will reduce the search scope in marc records).
1581
    # (This will reduce the search scope in marc records).
1519
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1582
    $sth = $dbh->prepare(
1520
    $sth->execute($authtypecodefrom);
1583
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1584
    );
1585
    $sth->execute();
1521
    my @tags_using_authtype;
1586
    my @tags_using_authtype;
1522
    while (my ($tagfield) = $sth->fetchrow) {
1587
    while (my ($tagfield) = $sth->fetchrow) {
1523
        push @tags_using_authtype,$tagfield ;
1588
        push @tags_using_authtype,$tagfield ;
1524
    }
1589
    }
1525
    my $tag_to=0;  
1590
    my $tag_to = 0;
1526
    if ($authtypecodeto ne $authtypecodefrom){  
1591
1527
        # If many tags, take the first
1592
 #    if ((defined $authtypecodeto) and ($authtypecodeto ne $authtypecodefrom)){
1528
        $sth->execute($authtypecodeto);    
1593
 #        # If many tags, take the first
1529
        $tag_to=$sth->fetchrow;
1594
 #        $sth->execute($authtypecodeto);
1530
        #warn $tag_to;    
1595
 #        $tag_to=$sth->fetchrow;
1531
    }  
1596
 #        #warn $tag_to;
1532
    # BulkEdit marc records
1597
 #    }
1533
    # May be used as a template for a bulkedit field  
1598
    foreach my $marcrecord (@reccache) {
1534
    foreach my $marcrecord(@reccache){
1599
        foreach my $tagfield (@tags_using_authtype) {
1535
        my $update;           
1600
            foreach my $field ( $marcrecord->field($tagfield) ) {
1536
        foreach my $tagfield (@tags_using_authtype){
1601
                my $update;
1537
#             warn "tagfield : $tagfield ";
1602
                my $tag = $field->tag();
1538
            foreach my $field ($marcrecord->field($tagfield)){
1603
                my @newsubfields;
1539
                # biblio is linked to authority with $9 subfield containing authid
1604
                my %indexes;
1540
                my $auth_number=$field->subfield("9");
1605
1541
                my $tag=$field->tag();          
1606
                #get to next field if no subfield
1542
                if ($auth_number==$mergefrom) {
1607
                my @localsubfields = $field->subfields();
1543
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1608
                my $index_9_auth   = 0;
1544
		my $exclude='9';
1609
                my $found          = 0;
1545
                foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
1610
                for my $subf (@localsubfields) {
1546
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1611
1547
		    $exclude.= $subfield->[0];
1612
                    #			$debug && warn Data::Dumper::Dumper($subf);
1613
                    if (    ( $subf->[0] eq "9" )
1614
                        and ( $subf->[1] == $mergefrom ) )
1615
                    {
1616
                        $found = 1;
1617
                        $debug && warn "found $mergefrom " . $subf->[1];
1618
                        last;
1619
                    }
1620
                    $index_9_auth++;
1548
                }
1621
                }
1549
		$exclude='['.$exclude.']';
1622
1550
#		add subfields in $field not included in @record_to
1623
                #$debug && warn "$index_9_auth $#localsubfields $found";
1551
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1624
                next if ( $index_9_auth >= $#localsubfields and !$found );
1552
                foreach my $subfield (@restore) {
1625
1553
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1626
                # Removes the data if before the $9
1554
		}
1627
                my $index = 0;
1555
                $marcrecord->delete_field($field);
1628
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1556
                $marcrecord->insert_grouped_field($field_to);            
1629
                    if ( any { $subf->[1] eq $_->[1] } @record_from ) {
1557
                $update=1;
1630
                        $debug && warn "found $subf->[0] " . $subf->[1];
1631
                        splice @localsubfields, $index, 1;
1632
                        $index_9_auth--;
1633
                    }
1634
                    else {
1635
                        $index++;
1636
                    }
1637
                }
1638
1639
                #Get the next $9 subfield
1640
                my $nextindex_9 = 0;
1641
                for my $subf (
1642
                    @localsubfields[ $index_9_auth + 1 .. $#localsubfields ] )
1643
                {
1644
                    last if ( $subf->[0] =~ /[12456789]/ );
1645
                    $nextindex_9++;
1646
                }
1647
1648
        #Change the first tag if required
1649
        # That is : change the first tag ($a) to what it is in the biblio record
1650
        # Since some composed authorities will place the $a into $x or $y
1651
1652
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1653
                if (
1654
                    my $changesubfcode = _process_subfcode_4_merge(
1655
                        $tag,    \@previous_subfields,
1656
                        $MARCto, \@record_to,
1657
                        $authtypecodeto
1658
                    )
1659
                  )
1660
                {
1661
                    $record_to[0]->[0] = $changesubfcode
1662
                      if defined($changesubfcode);
1558
                }
1663
                }
1559
            }#for each tag
1664
1560
        }#foreach tagfield
1665
#$debug && warn "$index_9_auth $nextindex_9 data to add ".Data::Dumper::Dumper(@record_to);
1561
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1666
# Replace in local subfields the subfields related to recordfrom with data from record_to
1667
1668
                my @localrecord_to = @record_to;
1669
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1670
1671
         #$debug && warn "localrecordto ".Data::Dumper::Dumper(@localrecord_to);
1672
                splice(
1673
                    @localsubfields,  $index_9_auth,
1674
                    $nextindex_9 + 1, @localrecord_to
1675
                );
1676
1677
      #$debug && warn "after splice ".Data::Dumper::Dumper(@localsubfields);
1678
      #very nice api for MARC::Record
1679
      # It seems that some elements localsubfields can be undefined so skip them
1680
                @newsubfields =
1681
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1682
1683
                #filter to subfields which are not in the subfield
1684
                my $field_to = MARC::Field->new(
1685
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1686
                    $field->indicator(2), @newsubfields
1687
                );
1688
                $marcrecord->delete_field($field);
1689
                $marcrecord->insert_fields_ordered($field_to);
1690
            }    #for each tag
1691
        }    #foreach tagfield
1692
        my ( $bibliotag, $bibliosubf ) =
1693
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1562
        my $biblionumber;
1694
        my $biblionumber;
1563
        if ($bibliotag<10){
1695
        if ($bibliotag<10){
1564
            $biblionumber=$marcrecord->field($bibliotag)->data;
1696
            $biblionumber=$marcrecord->field($bibliotag)->data;
Lines 1566-1631 sub merge { Link Here
1566
        else {
1698
        else {
1567
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1699
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1568
        }
1700
        }
1569
        unless ($biblionumber){
1701
1570
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1702
        #    $debug && warn $biblionumber,$marcrecord->as_formatted;
1703
        unless ($biblionumber) {
1704
            warn "no biblionumber in: "
1705
              . $marcrecord->as_formatted;
1571
            next;
1706
            next;
1572
        }
1707
        }
1573
        if ($update==1){
1708
1574
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1709
        #if ( $update == 1 ) {
1575
            $counteditedbiblio++;
1710
        &ModBiblio( $marcrecord, $biblionumber,
1576
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1711
            GetFrameworkCode($biblionumber) );
1577
        }    
1712
        $counteditedbiblio++;
1578
    }#foreach $marc
1713
        warn $counteditedbiblio
1579
    return $counteditedbiblio;  
1714
          if ( ( $counteditedbiblio % 10 ) and $ENV{DEBUG} );
1580
  # now, find every other authority linked with this authority
1715
1581
  # now, find every other authority linked with this authority
1716
        #}
1582
#   my $oConnection=C4::Context->Zconn("authorityserver");
1717
    }    #foreach $marc
1583
#   my $query;
1718
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1584
# # att 9210               Auth-Internal-authtype
1719
    return $counteditedbiblio;
1585
# # att 9220               Auth-Internal-LN
1720
}    #sub
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
1721
1630
=head2 get_auth_type_location
1722
=head2 get_auth_type_location
1631
1723
(-)a/misc/migration_tools/bulkmarcimport.pl (-53 / +165 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);
252
            my $authid= ($id?$id:GuessAuthId($record));
302
            my $authid= ($id?$id:GuessAuthId($record));
253
            if ($authid && GetAuthority($authid)){
303
            if ($authid && GetAuthority($authid) && $update ){
254
            ## Authority has an id and is in database : Replace
304
            ## Authority has an id and is in database : Replace
255
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
305
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
256
                if ($@){
306
                if ($@){
Lines 283-288 RECORD: while ( ) { Link Here
283
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
333
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
284
				}
334
				}
285
 	        }
335
 	        }
336
            if ($yamlfile) {
337
            $yamlhash->{$originalid}->{'authid'} = $authid;
338
            my @subfields;
339
            foreach my $field ( $record->field("2..") ) {
340
                push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
341
            }
342
            $yamlhash->{$originalid}->{'subfields'} = \@subfields;
343
            }
286
        }
344
        }
287
        else {
345
        else {
288
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
346
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
Lines 306-325 RECORD: while ( ) { Link Here
306
			}
364
			}
307
					# create biblio, unless we already have it ( either match or isbn )
365
					# create biblio, unless we already have it ( either match or isbn )
308
            if ($biblionumber) {
366
            if ($biblionumber) {
309
				eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};}
367
                eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};};
310
			}
368
                if ($update) {
311
			else 
369
                    eval { ( $biblionumber, $biblioitemnumber ) = ModBiblio( $record, $biblionumber, GetFrameworkcode($biblionumber) ) };
312
			{
370
                    if ($@) {
313
                eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio($record, $framework, { defer_marc_save => 1 }) };
371
                        warn "ERROR: Edit biblio $biblionumber failed: $@\n";
372
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ERROR" } ) if ($logfile);
373
                        next RECORD;
374
                    } else {
375
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ok" } ) if ($logfile);
376
                    }
377
                } else {
378
                    printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "warning : already in database" } ) if ($logfile);
379
                }
380
            } else {
381
                if ($insert) {
382
                    eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '', { defer_marc_save => 1 } ) };
383
                    if ($@) {
384
                        warn "ERROR: Adding biblio $biblionumber failed: $@\n";
385
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ERROR" } ) if ($logfile);
386
                        next RECORD;
387
                    } else {
388
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ok" } ) if ($logfile);
389
                    }
390
                } else {
391
                    printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "warning : not in database" } ) if ($logfile);
392
                }
314
            }
393
            }
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, '' ); };
394
            eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
324
            my $error_adding = $@;
395
            my $error_adding = $@;
325
            # Work on a clone so that if there are real errors, we can maybe
396
            # 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) {
455
            if ($#{ $errors_ref } > -1) {
385
                report_item_errors($biblionumber, $errors_ref);
456
                report_item_errors($biblionumber, $errors_ref);
386
            }
457
            }
458
            $yamlhash->{$originalid} = $biblionumber if ($yamlfile);
387
        }
459
        }
388
        $dbh->commit() if (0 == $i % $commitnum);
460
        $dbh->commit() if (0 == $i % $commitnum);
389
    }
461
    }
Lines 407-412 if ($logfile){ Link Here
407
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
479
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
408
  $loghandle->close;
480
  $loghandle->close;
409
}
481
}
482
if ($yamlfile) {
483
    open YAML, "> $yamlfile" or die "cannot open $yamlfile \n";
484
    print YAML Dump($yamlhash);
485
}
410
exit 0;
486
exit 0;
411
487
412
sub GetRecordId{
488
sub GetRecordId{
Lines 462-470 sub report_item_errors { Link Here
462
}
538
}
463
sub printlog{
539
sub printlog{
464
	my $logelements=shift;
540
	my $logelements=shift;
465
	print $loghandle join (";",@$logelements{qw<id op status>}),"\n";
541
    print $loghandle join( ";", map { defined $_ ? $_ : "" } @$logelements{qw<id op status>} ), "\n";
466
}
542
}
543
sub get_heading_fields{
544
    my $headingfields;
545
    if ($authtypes){
546
        $headingfields=YAML::LoadFile($authtypes);
467
547
548
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
549
        $debug && warn YAML::Dump($headingfields);
550
    }
551
    unless ($headingfields){
552
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
553
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
554
    }
555
    return $headingfields;
556
}
468
557
469
=head1 NAME
558
=head1 NAME
470
559
Lines 526-532 The I<NUMBER> of records to wait before performing a 'commit' operation Link Here
526
615
527
File logs actions done for each record and their status into file
616
File logs actions done for each record and their status into file
528
617
529
=item B<-t>
618
=item B<-t, -test>
530
619
531
Test mode: parses the file, saying what he would do, but doing nothing.
620
Test mode: parses the file, saying what he would do, but doing nothing.
532
621
Lines 549-554 biblioitems, items Link Here
549
638
550
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
639
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
551
640
641
=item B<-authtypes>
642
643
file yamlfile with authoritiesTypes and distinguishable record field in order
644
to store the correct authtype
645
646
=item B<-yaml>
647
648
yaml file  format a yaml file with ids
649
keepids field store ids in field (usefull for authorities,
650
where 001 contains the authid for Koha, that can contain a very valuable
651
info for authorities coming from LOC or BNF. useless for biblios probably
652
653
=item B<-insert>
654
655
if set, only insert when possible
656
657
=item B<-update>
658
659
if set, only updates (any biblio should have a matching record)
660
661
=item B<-all>
662
663
if set, do whatever is required
664
552
=item B<-k, -keepids>=<FIELD>
665
=item B<-k, -keepids>=<FIELD>
553
666
554
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
667
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
555
- 

Return to bug 8304