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

(-)a/C4/AuthoritiesMarc.pm (-100 / +203 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
31
30
use vars qw($VERSION @ISA @EXPORT);
32
use vars qw($VERSION @ISA @EXPORT);
Lines 332-337 sub SearchAuthorities { Link Here
332
            my $authrecord;
334
            my $authrecord;
333
            my $separator=C4::Context->preference('authoritysep');
335
            my $separator=C4::Context->preference('authoritysep');
334
            $authrecord = MARC::File::USMARC::decode($marcdata);
336
            $authrecord = MARC::File::USMARC::decode($marcdata);
337
            unless ($authrecord->field('001')) {
338
                $nbresults--;
339
                next;
340
            }
335
            my $authid=$authrecord->field('001')->data(); 
341
            my $authid=$authrecord->field('001')->data(); 
336
            my %newline;
342
            my %newline;
337
            $newline{authid} = $authid;
343
            $newline{authid} = $authid;
Lines 440-455 sub GetAuthTypeCode { Link Here
440
 
446
 
441
=head2 GuessAuthTypeCode
447
=head2 GuessAuthTypeCode
442
448
443
  my $authtypecode = GuessAuthTypeCode($record);
449
  my $authtypecode = GuessAuthTypeCode($record, [$headingfields]);
444
450
445
Get the record and tries to guess the adequate authtypecode from its content.
451
Get the record and tries to guess the adequate authtypecode from its content.
446
452
447
=cut
453
=cut
448
454
449
sub GuessAuthTypeCode {
455
sub GuessAuthTypeCode {
450
    my ($record) = @_;
456
    my ($record, $heading_fields) = @_;
451
    return unless defined $record;
457
    return unless defined $record;
452
my $heading_fields = {
458
    $heading_fields //= {
453
    "MARC21"=>{
459
    "MARC21"=>{
454
        '100'=>{authtypecode=>'PERSO_NAME'},
460
        '100'=>{authtypecode=>'PERSO_NAME'},
455
        '110'=>{authtypecode=>'CORPO_NAME'},
461
        '110'=>{authtypecode=>'CORPO_NAME'},
Lines 1289-1294 sub AddAuthorityTrees{ Link Here
1289
  return $rq->execute($trees,$authid);
1295
  return $rq->execute($trees,$authid);
1290
}
1296
}
1291
1297
1298
1292
=head2 merge
1299
=head2 merge
1293
1300
1294
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1301
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
Lines 1298-1307 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1298
1305
1299
=cut
1306
=cut
1300
1307
1308
# Test if a subfield exist in a subfield list
1309
sub _test_subfcode_presence {
1310
    my ( $subfields, $subfcode ) = @_;
1311
    return grep { $_->[0] eq $subfcode } @$subfields;
1312
}
1313
1314
# Test if a string exists in  a field
1315
sub _test_string {
1316
    my ( $string, @fields ) = @_;
1317
    my $return = 0;
1318
    for my $field (@fields) {
1319
        if ( grep { $_->[1] =~ /$string/i } $field->subfields ) {
1320
            $return = 1;
1321
            last;
1322
        }
1323
    }
1324
    return $return;
1325
}
1326
1327
# _process_subfcode_4_merge sets the correct subfcode
1328
sub _process_subfcode_4_merge {
1329
    my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields,
1330
        $authtypecode )
1331
      = @_;
1332
    return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' );
1333
    my $authtag = GetAuthType($authtypecode);
1334
    my $chronological_auth =
1335
      _test_string( qq{S'emploie uniquement en subdivision chronologique},
1336
        $authorityrecord->field('3..') );
1337
    my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' );
1338
    if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) {
1339
        if (    ( $authtag->{'auth_tag_to_report'} eq '215' )
1340
            and ( $tagfield ne "607" ) )
1341
        {
1342
            return "y";
1343
1344
        }
1345
        elsif ( $chronological_auth and $subfz_absent ) {
1346
            return "z";
1347
        }
1348
        else {
1349
            return "x";
1350
        }
1351
    }
1352
    return;
1353
}
1354
1301
sub merge {
1355
sub merge {
1302
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1356
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1303
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1357
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1304
    my $dbh=C4::Context->dbh;
1358
    my $dbh=C4::Context->dbh;
1359
    my $marcflavour      = C4::Context->preference('marcflavour');
1305
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1360
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1306
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1361
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1307
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1362
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
Lines 1316-1326 sub merge { Link Here
1316
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1371
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1317
    
1372
    
1318
    my @record_to;
1373
    my @record_to;
1319
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1374
    @record_to =
1375
      grep { $_->[0] !~ /[0-9]/ }
1376
      $MARCto->field($auth_tag_to_report_to)->subfields()
1377
      if $MARCto->field($auth_tag_to_report_to);
1378
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1379
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1380
    }
1381
    $debug and warn 'fields to merge', Data::Dumper::Dumper(@record_to);
1382
    my $field_to;
1383
    $field_to = $MARCto->field($auth_tag_to_report_to)
1384
      if $MARCto->field($auth_tag_to_report_to);
1320
    my @record_from;
1385
    my @record_from;
1321
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1386
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1322
    
1387
    
1323
    my @reccache;
1388
    my @reccache;
1389
1324
    # search all biblio tags using this authority.
1390
    # search all biblio tags using this authority.
1325
    #Getting marcbiblios impacted by the change.
1391
    #Getting marcbiblios impacted by the change.
1326
    if (C4::Context->preference('NoZebra')) {
1392
    if (C4::Context->preference('NoZebra')) {
Lines 1356-1413 sub merge { Link Here
1356
            my $marcdata = $rec->raw();
1422
            my $marcdata = $rec->raw();
1357
            my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata);
1423
            my $marcrecordzebra= MARC::Record->new_from_usmarc($marcdata);
1358
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1424
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1359
            my $i = ($biblionumbertagfield < 10) ? $marcrecordzebra->field($biblionumbertagfield)->data : $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1425
            my $bibnum;
1360
            my $marcrecorddb=GetMarcBiblio($i);
1426
            if ($biblionumbertagfield < 10) {
1427
                $bibnum = $marcrecordzebra->field($biblionumbertagfield)->data;
1428
            }
1429
            else {
1430
                $bibnum = $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1431
            }
1432
            my $marcrecorddb=GetMarcBiblio($bibnum);
1361
            push @reccache, $marcrecorddb;
1433
            push @reccache, $marcrecorddb;
1362
            $z++;
1434
            $z++;
1363
        }
1435
        }
1364
        $oResult->destroy();
1436
        $oResult->destroy();
1365
    }
1437
    }
1438
1366
    #warn scalar(@reccache)." biblios to update";
1439
    #warn scalar(@reccache)." biblios to update";
1367
    # Get All candidate Tags for the change 
1440
    # Get All candidate Tags for the change 
1368
    # (This will reduce the search scope in marc records).
1441
    # (This will reduce the search scope in marc records).
1369
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1442
    $sth = $dbh->prepare(
1370
    $sth->execute($authtypecodefrom);
1443
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1444
    );
1445
    $sth->execute();
1371
    my @tags_using_authtype;
1446
    my @tags_using_authtype;
1372
    while (my ($tagfield) = $sth->fetchrow) {
1447
    while (my ($tagfield) = $sth->fetchrow) {
1373
        push @tags_using_authtype,$tagfield ;
1448
        push @tags_using_authtype,$tagfield ;
1374
    }
1449
    }
1375
    my $tag_to=0;  
1450
    my $tag_to = 0;
1376
    if ($authtypecodeto ne $authtypecodefrom){  
1451
1377
        # If many tags, take the first
1452
 #    if ((defined $authtypecodeto) and ($authtypecodeto ne $authtypecodefrom)){
1378
        $sth->execute($authtypecodeto);    
1453
 #        # If many tags, take the first
1379
        $tag_to=$sth->fetchrow;
1454
 #        $sth->execute($authtypecodeto);
1380
        #warn $tag_to;    
1455
 #        $tag_to=$sth->fetchrow;
1381
    }  
1456
 #        #warn $tag_to;
1382
    # BulkEdit marc records
1457
 #    }
1383
    # May be used as a template for a bulkedit field  
1458
    foreach my $marcrecord (@reccache) {
1384
    foreach my $marcrecord(@reccache){
1459
        foreach my $tagfield (@tags_using_authtype) {
1385
        my $update;           
1460
            foreach my $field ( $marcrecord->field($tagfield) ) {
1386
        foreach my $tagfield (@tags_using_authtype){
1461
                my $update;
1387
#             warn "tagfield : $tagfield ";
1462
                my $tag = $field->tag();
1388
            foreach my $field ($marcrecord->field($tagfield)){
1463
                my @newsubfields;
1389
                my $auth_number=$field->subfield("9");
1464
                my %indexes;
1390
                my $tag=$field->tag();          
1465
1391
                if ($auth_number==$mergefrom) {
1466
                #get to next field if no subfield
1392
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1467
                my @localsubfields = $field->subfields();
1393
		my $exclude='9';
1468
                my $index_9_auth   = 0;
1394
                foreach my $subfield (@record_to) {
1469
                my $found          = 0;
1395
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1470
                for my $subf (@localsubfields) {
1396
		    $exclude.= $subfield->[0];
1471
1472
                    #			$debug && warn Data::Dumper::Dumper($subf);
1473
                    if (    ( $subf->[0] eq "9" )
1474
                        and ( $subf->[1] == $mergefrom ) )
1475
                    {
1476
                        $found = 1;
1477
                        $debug && warn "found $mergefrom " . $subf->[1];
1478
                        last;
1479
                    }
1480
                    $index_9_auth++;
1397
                }
1481
                }
1398
		$exclude='['.$exclude.']';
1482
1399
#		add subfields in $field not included in @record_to
1483
                #$debug && warn "$index_9_auth $#localsubfields $found";
1400
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1484
                next if ( $index_9_auth >= $#localsubfields and !$found );
1401
                foreach my $subfield (@restore) {
1485
1402
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1486
                # Removes the data if before the $9
1403
		}
1487
                my $index = 0;
1404
                $marcrecord->delete_field($field);
1488
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1405
                $marcrecord->insert_grouped_field($field_to);            
1489
                    if ( any { $subf->[1] eq $_->[1] } @record_from ) {
1406
                $update=1;
1490
                        $debug && warn "found $subf->[0] " . $subf->[1];
1491
                        splice @localsubfields, $index, 1;
1492
                        $index_9_auth--;
1493
                    }
1494
                    else {
1495
                        $index++;
1496
                    }
1497
                }
1498
1499
                #Get the next $9 subfield
1500
                my $nextindex_9 = 0;
1501
                for my $subf (
1502
                    @localsubfields[ $index_9_auth + 1 .. $#localsubfields ] )
1503
                {
1504
                    last if ( $subf->[0] =~ /[12456789]/ );
1505
                    $nextindex_9++;
1506
                }
1507
1508
        #Change the first tag if required
1509
        # That is : change the first tag ($a) to what it is in the biblio record
1510
        # Since some composed authorities will place the $a into $x or $y
1511
1512
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1513
                if (
1514
                    my $changesubfcode = _process_subfcode_4_merge(
1515
                        $tag,    \@previous_subfields,
1516
                        $MARCto, \@record_to,
1517
                        $authtypecodeto
1518
                    )
1519
                  )
1520
                {
1521
                    $record_to[0]->[0] = $changesubfcode
1522
                      if defined($changesubfcode);
1407
                }
1523
                }
1408
            }#for each tag
1524
1409
        }#foreach tagfield
1525
#$debug && warn "$index_9_auth $nextindex_9 data to add ".Data::Dumper::Dumper(@record_to);
1410
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1526
# Replace in local subfields the subfields related to recordfrom with data from record_to
1527
1528
                my @localrecord_to = @record_to;
1529
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1530
1531
         #$debug && warn "localrecordto ".Data::Dumper::Dumper(@localrecord_to);
1532
                splice(
1533
                    @localsubfields,  $index_9_auth,
1534
                    $nextindex_9 + 1, @localrecord_to
1535
                );
1536
1537
      #$debug && warn "after splice ".Data::Dumper::Dumper(@localsubfields);
1538
      #very nice api for MARC::Record
1539
      # It seems that some elements localsubfields can be undefined so skip them
1540
                @newsubfields =
1541
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1542
1543
                #filter to subfields which are not in the subfield
1544
                my $field_to = MARC::Field->new(
1545
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1546
                    $field->indicator(2), @newsubfields
1547
                );
1548
                $marcrecord->delete_field($field);
1549
                $marcrecord->insert_fields_ordered($field_to);
1550
            }    #for each tag
1551
        }    #foreach tagfield
1552
        my ( $bibliotag, $bibliosubf ) =
1553
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1411
        my $biblionumber;
1554
        my $biblionumber;
1412
        if ($bibliotag<10){
1555
        if ($bibliotag<10){
1413
            $biblionumber=$marcrecord->field($bibliotag)->data;
1556
            $biblionumber=$marcrecord->field($bibliotag)->data;
Lines 1415-1480 sub merge { Link Here
1415
        else {
1558
        else {
1416
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1559
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1417
        }
1560
        }
1418
        unless ($biblionumber){
1561
1419
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1562
        #    $debug && warn $biblionumber,$marcrecord->as_formatted;
1563
        unless ($biblionumber) {
1564
            warn "no biblionumber in: "
1565
              . $marcrecord->as_formatted;
1420
            next;
1566
            next;
1421
        }
1567
        }
1422
        if ($update==1){
1568
1423
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1569
        #if ( $update == 1 ) {
1424
            $counteditedbiblio++;
1570
        &ModBiblio( $marcrecord, $biblionumber,
1425
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1571
            GetFrameworkCode($biblionumber) );
1426
        }    
1572
        $counteditedbiblio++;
1427
    }#foreach $marc
1573
        warn $counteditedbiblio
1428
    return $counteditedbiblio;  
1574
          if ( ( $counteditedbiblio % 10 ) and $ENV{DEBUG} );
1429
  # now, find every other authority linked with this authority
1575
1430
  # now, find every other authority linked with this authority
1576
        #}
1431
#   my $oConnection=C4::Context->Zconn("authorityserver");
1577
    }    #foreach $marc
1432
#   my $query;
1578
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1433
# # att 9210               Auth-Internal-authtype
1579
    return $counteditedbiblio;
1434
# # att 9220               Auth-Internal-LN
1580
}    #sub
1435
# # ccl.properties to add for authorities
1436
#   $query= "= ".$mergefrom;
1437
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1438
#   my $count=$oResult->size() if  ($oResult);
1439
#   my @reccache;
1440
#   my $z=0;
1441
#   while ( $z<$count ) {
1442
#   my $rec;
1443
#           $rec=$oResult->record($z);
1444
#       my $marcdata = $rec->raw();
1445
#   push @reccache, $marcdata;
1446
#   $z++;
1447
#   }
1448
#   $oResult->destroy();
1449
#   foreach my $marc(@reccache){
1450
#     my $update;
1451
#     my $marcrecord;
1452
#     $marcrecord = MARC::File::USMARC::decode($marc);
1453
#     foreach my $tagfield (@tags_using_authtype){
1454
#       $tagfield=substr($tagfield,0,3);
1455
#       my @tags = $marcrecord->field($tagfield);
1456
#       foreach my $tag (@tags){
1457
#         my $tagsubs=$tag->subfield("9");
1458
#     #warn "$tagfield:$tagsubs:$mergefrom";
1459
#         if ($tagsubs== $mergefrom) {
1460
#           $tag->update("9" =>$mergeto);
1461
#           foreach my $subfield (@record_to) {
1462
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1463
#             $tag->update($subfield->[0] =>$subfield->[1]);
1464
#           }#for $subfield
1465
#         }
1466
#         $marcrecord->delete_field($tag);
1467
#         $marcrecord->add_fields($tag);
1468
#         $update=1;
1469
#       }#for each tag
1470
#     }#foreach tagfield
1471
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1472
#     if ($update==1){
1473
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1474
#     }
1475
# 
1476
#   }#foreach $marc
1477
}#sub
1478
1581
1479
=head2 get_auth_type_location
1582
=head2 get_auth_type_location
1480
1583
(-)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
42
Lines 45-51 GetOptions( Link Here
45
    'o|offset:f' => \$offset,
49
    'o|offset:f' => \$offset,
46
    'h' => \$version,
50
    'h' => \$version,
47
    'd' => \$delete,
51
    'd' => \$delete,
48
    't' => \$test_parameter,
52
    't|test' => \$test_parameter,
49
    's' => \$skip_marc8_conversion,
53
    's' => \$skip_marc8_conversion,
50
    'c:s' => \$char_encoding,
54
    'c:s' => \$char_encoding,
51
    'v:s' => \$verbose,
55
    'v:s' => \$verbose,
Lines 55-60 GetOptions( Link Here
55
    'k|keepids:s' => \$keepids,
59
    'k|keepids:s' => \$keepids,
56
    'b|biblios' => \$biblios,
60
    'b|biblios' => \$biblios,
57
    'a|authorities' => \$authorities,
61
    'a|authorities' => \$authorities,
62
    'authtypes:s' => \$authtypes,
63
    'filter=s@'     => \$filters,
64
    'insert'        => \$insert,
65
    'update'        => \$update,
66
    'all'           => \$all,
58
    'match=s@'    => \$match,
67
    'match=s@'    => \$match,
59
    'i|isbn' => \$isbn_check,
68
    'i|isbn' => \$isbn_check,
60
    'x:s' => \$sourcetag,
69
    'x:s' => \$sourcetag,
Lines 62-75 GetOptions( Link Here
62
    'idmap:s' => \$idmapfl,
71
    'idmap:s' => \$idmapfl,
63
    'cleanisbn!'     => \$cleanisbn,
72
    'cleanisbn!'     => \$cleanisbn,
64
    'dedupbarcode' => \$dedup_barcode,
73
    'dedupbarcode' => \$dedup_barcode,
74
    'yaml:s'        => \$yamlfile,
65
);
75
);
66
$biblios=!$authorities||$biblios;
76
$biblios ||= !$authorities;
77
$insert  ||= !$update;
78
79
if ($all) {
80
    $insert = 1;
81
    $update = 1;
82
}
67
83
68
if ($version || ($input_marc_file eq '')) {
84
if ($version || ($input_marc_file eq '')) {
69
    pod2usage( -verbose => 2 );
85
    pod2usage( -verbose => 2 );
70
    exit;
86
    exit;
71
}
87
}
72
88
89
my $heading_fields=get_heading_fields();
90
73
if (defined $idmapfl) {
91
if (defined $idmapfl) {
74
  open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n";
92
  open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n";
75
}
93
}
Lines 140-146 $batch->warnings_off(); Link Here
140
$batch->strict_off();
158
$batch->strict_off();
141
my $i=0;
159
my $i=0;
142
my $commitnum = $commit ? $commit : 50;
160
my $commitnum = $commit ? $commit : 50;
143
161
my $yamlhash;
144
162
145
# Skip file offset
163
# Skip file offset
146
if ( $offset ) {
164
if ( $offset ) {
Lines 197-202 RECORD: while ( ) { Link Here
197
            next RECORD;            
215
            next RECORD;            
198
        }
216
        }
199
    }
217
    }
218
    SetUTF8Flag($record);
200
    my $isbn;
219
    my $isbn;
201
    # remove trailing - in isbn (only for biblios, of course)
220
    # remove trailing - in isbn (only for biblios, of course)
202
    if ($biblios && $cleanisbn) {
221
    if ($biblios && $cleanisbn) {
Lines 210-254 RECORD: while ( ) { Link Here
210
    }
229
    }
211
    my $id;
230
    my $id;
212
    # search for duplicates (based on Local-number)
231
    # search for duplicates (based on Local-number)
213
    if ($match){
232
    my $originalid;
214
       require C4::Search;
233
    $originalid = GetRecordId( $record, $tagid, $subfieldid );
215
       my $query=build_query($match,$record);
234
    if ($match) {
216
       my $server=($authorities?'authorityserver':'biblioserver');
235
        require C4::Search;
217
       my ($error, $results,$totalhits)=C4::Search::SimpleSearch( $query, 0, 3, [$server] );
236
        my $query = build_query( $match, $record );
218
       die "unable to search the database for duplicates : $error" if (defined $error);
237
        my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
219
       #warn "$query $server : $totalhits";
238
        $debug && warn $query;
220
       if ( @{$results} == 1 ){
239
        my ( $error, $results, $totalhits ) = C4::Search::SimpleSearch( $query, 0, 3, [$server] );
221
           my $marcrecord = MARC::File::USMARC::decode($results->[0]);
240
        die "unable to search the database for duplicates : $error" if ( defined $error );
222
	   	   $id=GetRecordId($marcrecord,$tagid,$subfieldid);
241
        $debug && warn "$query $server : $totalhits";
223
       } 
242
        if ( $results && scalar(@$results) == 1 ) {
224
       elsif  ( @{$results} > 1){
243
            my $marcrecord = MARC::File::USMARC::decode( $results->[0] );
225
           $debug && warn "more than one match for $query";
244
            SetUTF8Flag($marcrecord);
226
       } 
245
            $id = GetRecordId( $marcrecord, $tagid, $subfieldid );
227
       else {
246
            if ( $authorities && $marcFlavour ) {
228
           $debug && warn "nomatch for $query";
247
                #Skip if authority in database is the same as the on in database
229
       }
248
                if ( $marcrecord->field('005')->data >= $record->field('005')->data ) {
249
                    if ($yamlfile) {
250
                        $yamlhash->{$originalid}->{'authid'} = $id;
251
252
                        # On récupère tous les souschamps des champs vedettes d'autorités
253
                        my @subfields;
254
                        foreach my $field ( $marcrecord->field("2..") ) {
255
                            push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
256
                        }
257
                        $yamlhash->{$originalid}->{'subfields'} = \@subfields;
258
                    }
259
                    next;
260
                }
261
            }
262
        } elsif ( $results && scalar(@$results) > 1 ) {
263
            $debug && warn "more than one match for $query";
264
        } else {
265
            $debug && warn "nomatch for $query";
266
        }
230
    }
267
    }
231
	my $originalid;
268
    if ($keepids && $originalid) {
232
    if ($keepids){
269
            my $storeidfield;
233
	  $originalid=GetRecordId($record,$tagid,$subfieldid);
270
            if ( length($keepids) == 3 ) {
234
      if ($originalid){
271
                $storeidfield = MARC::Field->new( $keepids, $originalid );
235
		 my $storeidfield;
272
            } else {
236
		 if (length($keepids)==3){
273
                $storeidfield = MARC::Field->new( substr( $keepids, 0, 3 ), "", "", substr( $keepids, 3, 1 ), $originalid );
237
		 	$storeidfield=MARC::Field->new($keepids,$originalid);
274
            }
238
		 }
275
            $record->insert_fields_ordered($storeidfield);
239
		 else  {
276
            $record->delete_field( $record->field($tagid) );
240
			$storeidfield=MARC::Field->new(substr($keepids,0,3),"","",substr($keepids,3,1),$originalid);
241
		 }
242
         $record->insert_fields_ordered($storeidfield);
243
	     $record->delete_field($record->field($tagid));
244
      }
245
    }
277
    }
278
    foreach my $stringfilter (@$filters) {
279
        if ( length($stringfilter) == 3 ) {
280
            foreach my $field ( $record->field($stringfilter) ) {
281
                $record->delete_field($field);
282
                $debug && warn "removed : ", $field->as_string;
283
            }
284
        } else {
285
            my ( $removetag, $removesubfield, $removematch ) = ( $1, $2, $3 )
286
              if $stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/;
287
            if ( ( $removetag > "010" ) && $removesubfield ) {
288
                foreach my $field ( $record->field($removetag) ) {
289
                    $field->delete_subfield( code => "$removesubfield", match => $removematch );
290
                    $debug && warn "Potentially removed : ", $field->subfield($removesubfield);
291
                }
292
            }
293
        }
294
    }
295
246
    unless ($test_parameter) {
296
    unless ($test_parameter) {
247
        if ($authorities){
297
        if ($authorities){
248
            use C4::AuthoritiesMarc;
298
            use C4::AuthoritiesMarc;
249
            my $authtypecode=GuessAuthTypeCode($record);
299
            my $authtypecode=GuessAuthTypeCode($record, $heading_fields);
250
            my $authid= ($id?$id:GuessAuthId($record));
300
            my $authid= ($id?$id:GuessAuthId($record));
251
            if ($authid && GetAuthority($authid)){
301
            if ($authid && GetAuthority($authid) && $update ){
252
            ## Authority has an id and is in database : Replace
302
            ## Authority has an id and is in database : Replace
253
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
303
                eval { ( $authid ) = ModAuthority($authid,$record, $authtypecode) };
254
                if ($@){
304
                if ($@){
Lines 281-286 RECORD: while ( ) { Link Here
281
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
331
					printlog({id=>$originalid||$id||$authid, op=>"insert",status=>"ok"}) if ($logfile);
282
				}
332
				}
283
 	        }
333
 	        }
334
            if ($yamlfile) {
335
            $yamlhash->{$originalid}->{'authid'} = $authid;
336
            my @subfields;
337
            foreach my $field ( $record->field("2..") ) {
338
                push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
339
            }
340
            $yamlhash->{$originalid}->{'subfields'} = \@subfields;
341
            }
284
        }
342
        }
285
        else {
343
        else {
286
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
344
            my ( $biblionumber, $biblioitemnumber, $itemnumbers_ref, $errors_ref );
Lines 304-323 RECORD: while ( ) { Link Here
304
			}
362
			}
305
					# create biblio, unless we already have it ( either match or isbn )
363
					# create biblio, unless we already have it ( either match or isbn )
306
            if ($biblionumber) {
364
            if ($biblionumber) {
307
				eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};}
365
                eval{$biblioitemnumber=GetBiblioData($biblionumber)->{biblioitemnumber};};
308
			}
366
                if ($update) {
309
			else 
367
                    eval { ( $biblionumber, $biblioitemnumber ) = ModBiblio( $record, $biblionumber, GetFrameworkcode($biblionumber) ) };
310
			{
368
                    if ($@) {
311
                eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio($record, '', { defer_marc_save => 1 }) };
369
                        warn "ERROR: Edit biblio $biblionumber failed: $@\n";
370
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ERROR" } ) if ($logfile);
371
                        next RECORD;
372
                    } else {
373
                        printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "ok" } ) if ($logfile);
374
                    }
375
                } else {
376
                    printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "warning : already in database" } ) if ($logfile);
377
                }
378
            } else {
379
                if ($insert) {
380
                    eval { ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '', { defer_marc_save => 1 } ) };
381
                    if ($@) {
382
                        warn "ERROR: Adding biblio $biblionumber failed: $@\n";
383
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ERROR" } ) if ($logfile);
384
                        next RECORD;
385
                    } else {
386
                        printlog( { id => $id || $originalid || $biblionumber, op => "insert", status => "ok" } ) if ($logfile);
387
                    }
388
                } else {
389
                    printlog( { id => $id || $originalid || $biblionumber, op => "update", status => "warning : not in database" } ) if ($logfile);
390
                }
312
            }
391
            }
313
            if ( $@ ) {
314
                warn "ERROR: Adding biblio $biblionumber failed: $@\n";
315
				printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ERROR"}) if ($logfile);
316
                next RECORD;
317
            } 
318
 			else{
319
				printlog({id=>$id||$originalid||$biblionumber, op=>"insert",status=>"ok"}) if ($logfile);
320
			}
321
            eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
392
            eval { ( $itemnumbers_ref, $errors_ref ) = AddItemBatchFromMarc( $record, $biblionumber, $biblioitemnumber, '' ); };
322
            my $error_adding = $@;
393
            my $error_adding = $@;
323
            # Work on a clone so that if there are real errors, we can maybe
394
            # Work on a clone so that if there are real errors, we can maybe
Lines 382-387 RECORD: while ( ) { Link Here
382
            if ($#{ $errors_ref } > -1) {
453
            if ($#{ $errors_ref } > -1) {
383
                report_item_errors($biblionumber, $errors_ref);
454
                report_item_errors($biblionumber, $errors_ref);
384
            }
455
            }
456
            $yamlhash->{$originalid} = $biblionumber if ($yamlfile);
385
        }
457
        }
386
        $dbh->commit() if (0 == $i % $commitnum);
458
        $dbh->commit() if (0 == $i % $commitnum);
387
    }
459
    }
Lines 405-410 if ($logfile){ Link Here
405
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
477
  print $loghandle "$i MARC records done in $timeneeded seconds\n";
406
  $loghandle->close;
478
  $loghandle->close;
407
}
479
}
480
if ($yamlfile) {
481
    open YAML, "> $yamlfile" or die "cannot open $yamlfile \n";
482
    print YAML Dump($yamlhash);
483
}
408
exit 0;
484
exit 0;
409
485
410
sub GetRecordId{
486
sub GetRecordId{
Lines 460-468 sub report_item_errors { Link Here
460
}
536
}
461
sub printlog{
537
sub printlog{
462
	my $logelements=shift;
538
	my $logelements=shift;
463
	print $loghandle join (";",@$logelements{qw<id op status>}),"\n";
539
    print $loghandle join( ";", map { defined $_ ? $_ : "" } @$logelements{qw<id op status>} ), "\n";
464
}
540
}
541
sub get_heading_fields{
542
    my $headingfields;
543
    if ($authtypes){
544
        $headingfields=YAML::LoadFile($authtypes);
465
545
546
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
547
        $debug && warn YAML::Dump($headingfields);
548
    }
549
    unless ($headingfields){
550
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
551
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
552
    }
553
    return $headingfields;
554
}
466
555
467
=head1 NAME
556
=head1 NAME
468
557
Lines 524-530 The I<NUMBER> of records to wait before performing a 'commit' operation Link Here
524
613
525
File logs actions done for each record and their status into file
614
File logs actions done for each record and their status into file
526
615
527
=item B<-t>
616
=item B<-t, -test>
528
617
529
Test mode: parses the file, saying what he would do, but doing nothing.
618
Test mode: parses the file, saying what he would do, but doing nothing.
530
619
Lines 547-552 biblioitems, items Link Here
547
636
548
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
637
Input file I<FORMAT>: I<MARCXML> or I<ISO2709> (defaults to ISO2709)
549
638
639
=item B<-authtypes>
640
641
file yamlfile with authoritiesTypes and distinguishable record field in order
642
to store the correct authtype
643
644
=item B<-yaml>
645
646
yaml file  format a yaml file with ids
647
keepids field store ids in field (usefull for authorities,
648
where 001 contains the authid for Koha, that can contain a very valuable
649
info for authorities coming from LOC or BNF. useless for biblios probably
650
651
=item B<-insert>
652
653
if set, only insert when possible
654
655
=item B<-update>
656
657
if set, only updates (any biblio should have a matching record)
658
659
=item B<-all>
660
661
if set, do whatever is required
662
550
=item B<-k, -keepids>=<FIELD>
663
=item B<-k, -keepids>=<FIELD>
551
664
552
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
665
Field store ids in I<FIELD> (usefull for authorities, where 001 contains the
553
- 

Return to bug 8304