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

(-)a/C4/AuthoritiesMarc.pm (-128 / +238 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 436-451 sub GetAuthTypeCode { Link Here
436
 
438
 
437
=head2 GuessAuthTypeCode
439
=head2 GuessAuthTypeCode
438
440
439
  my $authtypecode = GuessAuthTypeCode($record);
441
  my $authtypecode = GuessAuthTypeCode($record, [$headingfields]);
440
442
441
Get the record and tries to guess the adequate authtypecode from its content.
443
Get the record and tries to guess the adequate authtypecode from its content.
442
444
443
=cut
445
=cut
444
446
445
sub GuessAuthTypeCode {
447
sub GuessAuthTypeCode {
446
    my ($record) = @_;
448
    my ($record, $heading_fields) = @_;
447
    return unless defined $record;
449
    return unless defined $record;
448
my $heading_fields = {
450
    $heading_fields //= {
449
    "MARC21"=>{
451
    "MARC21"=>{
450
        '100'=>{authtypecode=>'PERSO_NAME'},
452
        '100'=>{authtypecode=>'PERSO_NAME'},
451
        '110'=>{authtypecode=>'CORPO_NAME'},
453
        '110'=>{authtypecode=>'CORPO_NAME'},
Lines 1255-1260 sub AddAuthorityTrees{ Link Here
1255
  return $rq->execute($trees,$authid);
1257
  return $rq->execute($trees,$authid);
1256
}
1258
}
1257
1259
1260
1258
=head2 merge
1261
=head2 merge
1259
1262
1260
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1263
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
Lines 1264-1310 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1264
1267
1265
=cut
1268
=cut
1266
1269
1270
# Test if a subfield exist in a subfield list
1271
sub _test_subfcode_presence {
1272
    my ( $subfields, $subfcode ) = @_;
1273
    return grep { $_->[0] eq $subfcode } @$subfields;
1274
}
1275
1276
# Test if a string exists in  a field
1277
sub _test_string {
1278
    my ( $string, @fields ) = @_;
1279
    my $return = 0;
1280
    for my $field (@fields) {
1281
        if ( grep { $_->[1] =~ /$string/i } $field->subfields ) {
1282
            $return = 1;
1283
            last;
1284
        }
1285
    }
1286
    return $return;
1287
}
1288
1289
# _process_subfcode_4_merge sets the correct subfcode
1290
sub _process_subfcode_4_merge {
1291
    my ( $tagfield, $bibliosubfields, $authorityrecord, $authoritysubfields,
1292
        $authtypecode )
1293
      = @_;
1294
    return unless ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' );
1295
    my $authtag = GetAuthType($authtypecode);
1296
    my $chronological_auth =
1297
      _test_string( qq{S'emploie uniquement en subdivision chronologique},
1298
        $authorityrecord->field('3..') );
1299
    my $subfz_absent = not _test_subfcode_presence( $bibliosubfields, 'z' );
1300
    if ( _test_subfcode_presence( $bibliosubfields, "a" ) ) {
1301
        if (    ( $authtag->{'auth_tag_to_report'} eq '215' )
1302
            and ( $tagfield ne "607" ) )
1303
        {
1304
            return "y";
1305
1306
        }
1307
        elsif ( $chronological_auth and $subfz_absent ) {
1308
            return "z";
1309
        }
1310
        else {
1311
            return "x";
1312
        }
1313
    }
1314
    return;
1315
}
1316
1267
sub merge {
1317
sub merge {
1268
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1318
    my ( $mergefrom, $MARCfrom, $mergeto, $MARCto ) = @_;
1269
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1319
    my ( $counteditedbiblio, $countunmodifiedbiblio, $counterrors ) =
1270
    my $dbh=C4::Context->dbh;
1320
      ( 0, 0, 0 );
1321
    my $dbh              = C4::Context->dbh;
1322
    my $marcflavour      = C4::Context->preference('marcflavour');
1271
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1323
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1272
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1324
    my $authtypecodeto   = GetAuthTypeCode($mergeto);
1325
1273
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1326
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1274
    # return if authority does not exist
1327
# return if authority does not exist
1275
    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1328
    die "error MARCFROM not a marcrecord " . Data::Dumper::Dumper($MARCfrom)
1276
    return "error MARCTO not a marcrecord".Data::Dumper::Dumper($MARCto) if scalar($MARCto->fields()) == 0;
1329
      if scalar( $MARCfrom->fields() ) == 0;
1330
    die "error MARCTO not a marcrecord" . Data::Dumper::Dumper($MARCto)
1331
      if scalar( $MARCto->fields() ) == 0;
1332
1277
    # search the tag to report
1333
    # search the tag to report
1278
    my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
1334
    my $sth = $dbh->prepare(
1335
        "select auth_tag_to_report from auth_types where authtypecode=?");
1279
    $sth->execute($authtypecodefrom);
1336
    $sth->execute($authtypecodefrom);
1280
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1337
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1281
    $sth->execute($authtypecodeto);
1338
    $sth->execute($authtypecodeto);
1282
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1339
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1283
    
1340
1284
    my @record_to;
1341
    my @record_to;
1285
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1342
    @record_to =
1343
      grep { $_->[0] !~ /[0-9]/ }
1344
      $MARCto->field($auth_tag_to_report_to)->subfields()
1345
      if $MARCto->field($auth_tag_to_report_to);
1346
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1347
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1348
    }
1349
    $debug and warn 'fields to merge', Data::Dumper::Dumper(@record_to);
1350
    my $field_to;
1351
    $field_to = $MARCto->field($auth_tag_to_report_to)
1352
      if $MARCto->field($auth_tag_to_report_to);
1286
    my @record_from;
1353
    my @record_from;
1287
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1354
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields()
1288
    
1355
      if $MARCfrom->field($auth_tag_to_report_from);
1356
1289
    my @reccache;
1357
    my @reccache;
1358
1290
    # search all biblio tags using this authority.
1359
    # search all biblio tags using this authority.
1291
    #Getting marcbiblios impacted by the change.
1360
    #Getting marcbiblios impacted by the change.
1292
    if (C4::Context->preference('NoZebra')) {
1361
    if ( C4::Context->preference('NoZebra') ) {
1293
        #nozebra way    
1362
1294
        my $dbh=C4::Context->dbh;
1363
        #nozebra way
1295
        my $rq=$dbh->prepare(qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" ));
1364
        my $dbh = C4::Context->dbh;
1365
        my $rq  = $dbh->prepare(
1366
qq(SELECT biblionumbers from nozebra where indexname="an" and server="biblioserver" and value="$mergefrom" )
1367
        );
1296
        $rq->execute;
1368
        $rq->execute;
1297
        while (my $biblionumbers=$rq->fetchrow){
1369
        while ( my $biblionumbers = $rq->fetchrow ) {
1298
            my @biblionumbers=split /;/,$biblionumbers;
1370
            my @biblionumbers = split /;/, $biblionumbers;
1299
            foreach (@biblionumbers) {
1371
            foreach (@biblionumbers) {
1300
                if ($_=~/(\d+),.*/) {
1372
                if ( $_ =~ /(\d+),.*/ ) {
1301
                    my $marc=GetMarcBiblio($1);
1373
                    my $marc = GetMarcBiblio($1);
1302
                    push @reccache,$marc;
1374
                    push @reccache, $marc;
1303
                }
1375
                }
1304
            }
1376
            }
1305
        }
1377
        }
1306
    } else {
1378
    }
1307
        #zebra connection  
1379
    else {
1380
1308
        my $oConnection=C4::Context->Zconn("biblioserver",0);
1381
        my $oConnection=C4::Context->Zconn("biblioserver",0);
1309
        my $oldSyntax = $oConnection->option("preferredRecordSyntax");
1382
        my $oldSyntax = $oConnection->option("preferredRecordSyntax");
1310
        $oConnection->option("preferredRecordSyntax"=>"XML");
1383
        $oConnection->option("preferredRecordSyntax"=>"XML");
Lines 1322-1447 sub merge { Link Here
1322
            my $marcdata = $rec->raw();
1395
            my $marcdata = $rec->raw();
1323
            my $marcrecordzebra= MARC::Record->new_from_xml($marcdata,"utf8",C4::Context->preference("marcflavour"));
1396
            my $marcrecordzebra= MARC::Record->new_from_xml($marcdata,"utf8",C4::Context->preference("marcflavour"));
1324
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1397
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1325
            my $i = $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1398
            my $bibnum;
1326
            my $marcrecorddb=GetMarcBiblio($i);
1399
            if ($biblionumbertagfield gt "009"){
1400
                $bibnum = $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1401
            }
1402
            else {
1403
                $bibnum = $marcrecordzebra->field($biblionumbertagfield)->data();
1404
            }
1405
            my $marcrecorddb=GetMarcBiblio($bibnum);
1327
            push @reccache, $marcrecorddb;
1406
            push @reccache, $marcrecorddb;
1328
            $z++;
1407
            $z++;
1329
        }
1408
        }
1330
        $oResult->destroy();
1409
        $oResult->destroy();
1331
        $oConnection->option("preferredRecordSyntax"=>$oldSyntax);
1410
        $oConnection->option("preferredRecordSyntax"=>$oldSyntax);
1332
    }
1411
    }
1412
1333
    #warn scalar(@reccache)." biblios to update";
1413
    #warn scalar(@reccache)." biblios to update";
1334
    # Get All candidate Tags for the change 
1414
    # Get All candidate Tags for the change
1335
    # (This will reduce the search scope in marc records).
1415
    # (This will reduce the search scope in marc records).
1336
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1416
    $sth = $dbh->prepare(
1337
    $sth->execute($authtypecodefrom);
1417
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1418
    );
1419
    $sth->execute();
1338
    my @tags_using_authtype;
1420
    my @tags_using_authtype;
1339
    while (my ($tagfield) = $sth->fetchrow) {
1421
    while ( my ($tagfield) = $sth->fetchrow ) {
1340
        push @tags_using_authtype,$tagfield ;
1422
        push @tags_using_authtype, $tagfield;
1341
    }
1423
    }
1342
    my $tag_to=0;  
1424
    my $tag_to = 0;
1343
    if ($authtypecodeto ne $authtypecodefrom){  
1425
1344
        # If many tags, take the first
1426
 #    if ((defined $authtypecodeto) and ($authtypecodeto ne $authtypecodefrom)){
1345
        $sth->execute($authtypecodeto);    
1427
 #        # If many tags, take the first
1346
        $tag_to=$sth->fetchrow;
1428
 #        $sth->execute($authtypecodeto);
1347
        #warn $tag_to;    
1429
 #        $tag_to=$sth->fetchrow;
1348
    }  
1430
 #        #warn $tag_to;
1349
    # BulkEdit marc records
1431
 #    }
1350
    # May be used as a template for a bulkedit field  
1432
    foreach my $marcrecord (@reccache) {
1351
    foreach my $marcrecord(@reccache){
1433
        foreach my $tagfield (@tags_using_authtype) {
1352
        my $update;           
1434
            foreach my $field ( $marcrecord->field($tagfield) ) {
1353
        foreach my $tagfield (@tags_using_authtype){
1435
                my $update;
1354
#             warn "tagfield : $tagfield ";
1436
                my $tag = $field->tag();
1355
            foreach my $field ($marcrecord->field($tagfield)){
1437
                my @newsubfields;
1356
                my $auth_number=$field->subfield("9");
1438
                my %indexes;
1357
                my $tag=$field->tag();          
1439
1358
                if ($auth_number==$mergefrom) {
1440
                #get to next field if no subfield
1359
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1441
                my @localsubfields = $field->subfields();
1360
		my $exclude='9';
1442
                my $index_9_auth   = 0;
1361
                foreach my $subfield (@record_to) {
1443
                my $found          = 0;
1362
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1444
                for my $subf (@localsubfields) {
1363
		    $exclude.= $subfield->[0];
1445
1446
                    #			$debug && warn Data::Dumper::Dumper($subf);
1447
                    if (    ( $subf->[0] eq "9" )
1448
                        and ( $subf->[1] == $mergefrom ) )
1449
                    {
1450
                        $found = 1;
1451
                        $debug && warn "found $mergefrom " . $subf->[1];
1452
                        last;
1453
                    }
1454
                    $index_9_auth++;
1364
                }
1455
                }
1365
		$exclude='['.$exclude.']';
1456
1366
#		add subfields in $field not included in @record_to
1457
                #$debug && warn "$index_9_auth $#localsubfields $found";
1367
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1458
                next if ( $index_9_auth >= $#localsubfields and !$found );
1368
                foreach my $subfield (@restore) {
1459
1369
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1460
                # Removes the data if before the $9
1370
		}
1461
                my $index = 0;
1371
                $marcrecord->delete_field($field);
1462
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1372
                $marcrecord->insert_grouped_field($field_to);            
1463
                    if ( any { $subf->[1] eq $_->[1] } @record_from ) {
1373
                $update=1;
1464
                        $debug && warn "found $subf->[0] " . $subf->[1];
1465
                        splice @localsubfields, $index, 1;
1466
                        $index_9_auth--;
1467
                    }
1468
                    else {
1469
                        $index++;
1470
                    }
1471
                }
1472
1473
                #Get the next $9 subfield
1474
                my $nextindex_9 = 0;
1475
                for my $subf (
1476
                    @localsubfields[ $index_9_auth + 1 .. $#localsubfields ] )
1477
                {
1478
                    last if ( $subf->[0] =~ /[12456789]/ );
1479
                    $nextindex_9++;
1480
                }
1481
1482
        #Change the first tag if required
1483
        # That is : change the first tag ($a) to what it is in the biblio record
1484
        # Since some composed authorities will place the $a into $x or $y
1485
1486
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1487
                if (
1488
                    my $changesubfcode = _process_subfcode_4_merge(
1489
                        $tag,    \@previous_subfields,
1490
                        $MARCto, \@record_to,
1491
                        $authtypecodeto
1492
                    )
1493
                  )
1494
                {
1495
                    $record_to[0]->[0] = $changesubfcode
1496
                      if defined($changesubfcode);
1374
                }
1497
                }
1375
            }#for each tag
1498
1376
        }#foreach tagfield
1499
#$debug && warn "$index_9_auth $nextindex_9 data to add ".Data::Dumper::Dumper(@record_to);
1377
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1500
# Replace in local subfields the subfields related to recordfrom with data from record_to
1501
1502
                my @localrecord_to = @record_to;
1503
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1504
1505
         #$debug && warn "localrecordto ".Data::Dumper::Dumper(@localrecord_to);
1506
                splice(
1507
                    @localsubfields,  $index_9_auth,
1508
                    $nextindex_9 + 1, @localrecord_to
1509
                );
1510
1511
      #$debug && warn "after splice ".Data::Dumper::Dumper(@localsubfields);
1512
      #very nice api for MARC::Record
1513
      # It seems that some elements localsubfields can be undefined so skip them
1514
                @newsubfields =
1515
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1516
1517
                #filter to subfields which are not in the subfield
1518
                my $field_to = MARC::Field->new(
1519
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1520
                    $field->indicator(2), @newsubfields
1521
                );
1522
                $marcrecord->delete_field($field);
1523
                $marcrecord->insert_fields_ordered($field_to);
1524
            }    #for each tag
1525
        }    #foreach tagfield
1526
        my ( $bibliotag, $bibliosubf ) =
1527
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1378
        my $biblionumber;
1528
        my $biblionumber;
1379
        if ($bibliotag<10){
1529
        if ( $bibliotag le "009" ) {
1380
            $biblionumber=$marcrecord->field($bibliotag)->data;
1530
            $biblionumber = $marcrecord->field($bibliotag)->data;
1381
        }
1531
        }
1382
        else {
1532
        else {
1383
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1533
            $biblionumber = $marcrecord->subfield( $bibliotag, $bibliosubf );
1384
        }
1534
        }
1385
        unless ($biblionumber){
1535
1386
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1536
        #    $debug && warn $biblionumber,$marcrecord->as_formatted;
1537
        unless ($biblionumber) {
1538
            warn "no biblionumber in: "
1539
              . $marcrecord->as_formatted;
1387
            next;
1540
            next;
1388
        }
1541
        }
1389
        if ($update==1){
1542
1390
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1543
        #if ( $update == 1 ) {
1391
            $counteditedbiblio++;
1544
        &ModBiblio( $marcrecord, $biblionumber,
1392
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1545
            GetFrameworkCode($biblionumber) );
1393
        }    
1546
        $counteditedbiblio++;
1394
    }#foreach $marc
1547
        warn $counteditedbiblio
1395
    return $counteditedbiblio;  
1548
          if ( ( $counteditedbiblio % 10 ) and $ENV{DEBUG} );
1396
  # now, find every other authority linked with this authority
1549
1397
  # now, find every other authority linked with this authority
1550
        #}
1398
#   my $oConnection=C4::Context->Zconn("authorityserver");
1551
    }    #foreach $marc
1399
#   my $query;
1552
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1400
# # att 9210               Auth-Internal-authtype
1553
    return $counteditedbiblio;
1401
# # att 9220               Auth-Internal-LN
1554
}    #sub
1402
# # ccl.properties to add for authorities
1403
#   $query= "= ".$mergefrom;
1404
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1405
#   my $count=$oResult->size() if  ($oResult);
1406
#   my @reccache;
1407
#   my $z=0;
1408
#   while ( $z<$count ) {
1409
#   my $rec;
1410
#           $rec=$oResult->record($z);
1411
#       my $marcdata = $rec->raw();
1412
#   push @reccache, $marcdata;
1413
#   $z++;
1414
#   }
1415
#   $oResult->destroy();
1416
#   foreach my $marc(@reccache){
1417
#     my $update;
1418
#     my $marcrecord;
1419
#     $marcrecord = MARC::File::USMARC::decode($marc);
1420
#     foreach my $tagfield (@tags_using_authtype){
1421
#       $tagfield=substr($tagfield,0,3);
1422
#       my @tags = $marcrecord->field($tagfield);
1423
#       foreach my $tag (@tags){
1424
#         my $tagsubs=$tag->subfield("9");
1425
#     #warn "$tagfield:$tagsubs:$mergefrom";
1426
#         if ($tagsubs== $mergefrom) {
1427
#           $tag->update("9" =>$mergeto);
1428
#           foreach my $subfield (@record_to) {
1429
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1430
#             $tag->update($subfield->[0] =>$subfield->[1]);
1431
#           }#for $subfield
1432
#         }
1433
#         $marcrecord->delete_field($tag);
1434
#         $marcrecord->add_fields($tag);
1435
#         $update=1;
1436
#       }#for each tag
1437
#     }#foreach tagfield
1438
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1439
#     if ($update==1){
1440
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1441
#     }
1442
# 
1443
#   }#foreach $marc
1444
}#sub
1445
1555
1446
=head2 get_auth_type_location
1556
=head2 get_auth_type_location
1447
1557
(-)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