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

(-)a/C4/AuthoritiesMarc.pm (-100 / +199 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-1273 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)=(0,0,0);        
1270
    my $dbh=C4::Context->dbh;
1320
    my $dbh=C4::Context->dbh;
1321
    my $marcflavour      = C4::Context->preference('marcflavour');
1271
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1322
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1272
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1323
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1273
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1324
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
Lines 1282-1292 sub merge { Link Here
1282
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1333
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1283
    
1334
    
1284
    my @record_to;
1335
    my @record_to;
1285
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1336
    @record_to =
1337
      grep { $_->[0] !~ /[0-9]/ }
1338
      $MARCto->field($auth_tag_to_report_to)->subfields()
1339
      if $MARCto->field($auth_tag_to_report_to);
1340
    if ( uc($marcflavour) eq 'UNIMARC' and $MARCto->field('009') ) {
1341
        unshift @record_to, [ 3 => $MARCto->field('009')->data() ];
1342
    }
1343
    $debug and warn 'fields to merge', Data::Dumper::Dumper(@record_to);
1344
    my $field_to;
1345
    $field_to = $MARCto->field($auth_tag_to_report_to)
1346
      if $MARCto->field($auth_tag_to_report_to);
1286
    my @record_from;
1347
    my @record_from;
1287
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1348
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1288
    
1349
    
1289
    my @reccache;
1350
    my @reccache;
1351
1290
    # search all biblio tags using this authority.
1352
    # search all biblio tags using this authority.
1291
    #Getting marcbiblios impacted by the change.
1353
    #Getting marcbiblios impacted by the change.
1292
    if (C4::Context->preference('NoZebra')) {
1354
    if (C4::Context->preference('NoZebra')) {
Lines 1322-1380 sub merge { Link Here
1322
            my $marcdata = $rec->raw();
1384
            my $marcdata = $rec->raw();
1323
            my $marcrecordzebra= MARC::Record->new_from_xml($marcdata,"utf8",C4::Context->preference("marcflavour"));
1385
            my $marcrecordzebra= MARC::Record->new_from_xml($marcdata,"utf8",C4::Context->preference("marcflavour"));
1324
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1386
            my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1325
            my $i = $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1387
            my $bibnum;
1326
            my $marcrecorddb=GetMarcBiblio($i);
1388
            if ($biblionumbertagfield gt "009"){
1389
                $bibnum = $marcrecordzebra->subfield($biblionumbertagfield, $biblionumbertagsubfield);
1390
            }
1391
            else {
1392
                $bibnum = $marcrecordzebra->field($biblionumbertagfield)->data();
1393
            }
1394
            my $marcrecorddb=GetMarcBiblio($bibnum);
1327
            push @reccache, $marcrecorddb;
1395
            push @reccache, $marcrecorddb;
1328
            $z++;
1396
            $z++;
1329
        }
1397
        }
1330
        $oResult->destroy();
1398
        $oResult->destroy();
1331
        $oConnection->option("preferredRecordSyntax"=>$oldSyntax);
1399
        $oConnection->option("preferredRecordSyntax"=>$oldSyntax);
1332
    }
1400
    }
1401
1333
    #warn scalar(@reccache)." biblios to update";
1402
    #warn scalar(@reccache)." biblios to update";
1334
    # Get All candidate Tags for the change 
1403
    # Get All candidate Tags for the change 
1335
    # (This will reduce the search scope in marc records).
1404
    # (This will reduce the search scope in marc records).
1336
    $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
1405
    $sth = $dbh->prepare(
1337
    $sth->execute($authtypecodefrom);
1406
"select distinct tagfield from marc_subfield_structure where authtypecode<>''"
1407
    );
1408
    $sth->execute();
1338
    my @tags_using_authtype;
1409
    my @tags_using_authtype;
1339
    while (my ($tagfield) = $sth->fetchrow) {
1410
    while (my ($tagfield) = $sth->fetchrow) {
1340
        push @tags_using_authtype,$tagfield ;
1411
        push @tags_using_authtype,$tagfield ;
1341
    }
1412
    }
1342
    my $tag_to=0;  
1413
    my $tag_to = 0;
1343
    if ($authtypecodeto ne $authtypecodefrom){  
1414
1344
        # If many tags, take the first
1415
 #    if ((defined $authtypecodeto) and ($authtypecodeto ne $authtypecodefrom)){
1345
        $sth->execute($authtypecodeto);    
1416
 #        # If many tags, take the first
1346
        $tag_to=$sth->fetchrow;
1417
 #        $sth->execute($authtypecodeto);
1347
        #warn $tag_to;    
1418
 #        $tag_to=$sth->fetchrow;
1348
    }  
1419
 #        #warn $tag_to;
1349
    # BulkEdit marc records
1420
 #    }
1350
    # May be used as a template for a bulkedit field  
1421
    foreach my $marcrecord (@reccache) {
1351
    foreach my $marcrecord(@reccache){
1422
        foreach my $tagfield (@tags_using_authtype) {
1352
        my $update;           
1423
            foreach my $field ( $marcrecord->field($tagfield) ) {
1353
        foreach my $tagfield (@tags_using_authtype){
1424
                my $update;
1354
#             warn "tagfield : $tagfield ";
1425
                my $tag = $field->tag();
1355
            foreach my $field ($marcrecord->field($tagfield)){
1426
                my @newsubfields;
1356
                my $auth_number=$field->subfield("9");
1427
                my %indexes;
1357
                my $tag=$field->tag();          
1428
1358
                if ($auth_number==$mergefrom) {
1429
                #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);
1430
                my @localsubfields = $field->subfields();
1360
		my $exclude='9';
1431
                my $index_9_auth   = 0;
1361
                foreach my $subfield (@record_to) {
1432
                my $found          = 0;
1362
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1433
                for my $subf (@localsubfields) {
1363
		    $exclude.= $subfield->[0];
1434
1435
                    #			$debug && warn Data::Dumper::Dumper($subf);
1436
                    if (    ( $subf->[0] eq "9" )
1437
                        and ( $subf->[1] == $mergefrom ) )
1438
                    {
1439
                        $found = 1;
1440
                        $debug && warn "found $mergefrom " . $subf->[1];
1441
                        last;
1442
                    }
1443
                    $index_9_auth++;
1364
                }
1444
                }
1365
		$exclude='['.$exclude.']';
1445
1366
#		add subfields in $field not included in @record_to
1446
                #$debug && warn "$index_9_auth $#localsubfields $found";
1367
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1447
                next if ( $index_9_auth >= $#localsubfields and !$found );
1368
                foreach my $subfield (@restore) {
1448
1369
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1449
                # Removes the data if before the $9
1370
		}
1450
                my $index = 0;
1371
                $marcrecord->delete_field($field);
1451
                for my $subf ( @localsubfields[ 0 .. $index_9_auth ] ) {
1372
                $marcrecord->insert_grouped_field($field_to);            
1452
                    if ( any { $subf->[1] eq $_->[1] } @record_from ) {
1373
                $update=1;
1453
                        $debug && warn "found $subf->[0] " . $subf->[1];
1454
                        splice @localsubfields, $index, 1;
1455
                        $index_9_auth--;
1456
                    }
1457
                    else {
1458
                        $index++;
1459
                    }
1460
                }
1461
1462
                #Get the next $9 subfield
1463
                my $nextindex_9 = 0;
1464
                for my $subf (
1465
                    @localsubfields[ $index_9_auth + 1 .. $#localsubfields ] )
1466
                {
1467
                    last if ( $subf->[0] =~ /[12456789]/ );
1468
                    $nextindex_9++;
1469
                }
1470
1471
        #Change the first tag if required
1472
        # That is : change the first tag ($a) to what it is in the biblio record
1473
        # Since some composed authorities will place the $a into $x or $y
1474
1475
                my @previous_subfields = @localsubfields[ 0 .. $index_9_auth ];
1476
                if (
1477
                    my $changesubfcode = _process_subfcode_4_merge(
1478
                        $tag,    \@previous_subfields,
1479
                        $MARCto, \@record_to,
1480
                        $authtypecodeto
1481
                    )
1482
                  )
1483
                {
1484
                    $record_to[0]->[0] = $changesubfcode
1485
                      if defined($changesubfcode);
1374
                }
1486
                }
1375
            }#for each tag
1487
1376
        }#foreach tagfield
1488
#$debug && warn "$index_9_auth $nextindex_9 data to add ".Data::Dumper::Dumper(@record_to);
1377
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1489
# Replace in local subfields the subfields related to recordfrom with data from record_to
1490
1491
                my @localrecord_to = @record_to;
1492
                @localrecord_to = ( [ 9, $mergeto ], @localrecord_to );
1493
1494
         #$debug && warn "localrecordto ".Data::Dumper::Dumper(@localrecord_to);
1495
                splice(
1496
                    @localsubfields,  $index_9_auth,
1497
                    $nextindex_9 + 1, @localrecord_to
1498
                );
1499
1500
      #$debug && warn "after splice ".Data::Dumper::Dumper(@localsubfields);
1501
      #very nice api for MARC::Record
1502
      # It seems that some elements localsubfields can be undefined so skip them
1503
                @newsubfields =
1504
                  map { ( defined $_ ? @$_ : () ) } @localsubfields;
1505
1506
                #filter to subfields which are not in the subfield
1507
                my $field_to = MARC::Field->new(
1508
                    ( $tag_to ? $tag_to : $tag ), $field->indicator(1),
1509
                    $field->indicator(2), @newsubfields
1510
                );
1511
                $marcrecord->delete_field($field);
1512
                $marcrecord->insert_fields_ordered($field_to);
1513
            }    #for each tag
1514
        }    #foreach tagfield
1515
        my ( $bibliotag, $bibliosubf ) =
1516
          GetMarcFromKohaField( "biblio.biblionumber", "" );
1378
        my $biblionumber;
1517
        my $biblionumber;
1379
        if ($bibliotag<10){
1518
        if ($bibliotag<10){
1380
            $biblionumber=$marcrecord->field($bibliotag)->data;
1519
            $biblionumber=$marcrecord->field($bibliotag)->data;
Lines 1382-1447 sub merge { Link Here
1382
        else {
1521
        else {
1383
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1522
            $biblionumber=$marcrecord->subfield($bibliotag,$bibliosubf);
1384
        }
1523
        }
1385
        unless ($biblionumber){
1524
1386
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1525
        #    $debug && warn $biblionumber,$marcrecord->as_formatted;
1526
        unless ($biblionumber) {
1527
            warn "no biblionumber in: "
1528
              . $marcrecord->as_formatted;
1387
            next;
1529
            next;
1388
        }
1530
        }
1389
        if ($update==1){
1531
1390
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1532
        #if ( $update == 1 ) {
1391
            $counteditedbiblio++;
1533
        &ModBiblio( $marcrecord, $biblionumber,
1392
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1534
            GetFrameworkCode($biblionumber) );
1393
        }    
1535
        $counteditedbiblio++;
1394
    }#foreach $marc
1536
        warn $counteditedbiblio
1395
    return $counteditedbiblio;  
1537
          if ( ( $counteditedbiblio % 10 ) and $ENV{DEBUG} );
1396
  # now, find every other authority linked with this authority
1538
1397
  # now, find every other authority linked with this authority
1539
        #}
1398
#   my $oConnection=C4::Context->Zconn("authorityserver");
1540
    }    #foreach $marc
1399
#   my $query;
1541
    DelAuthority($mergefrom) if ( $mergefrom != $mergeto );
1400
# # att 9210               Auth-Internal-authtype
1542
    return $counteditedbiblio;
1401
# # att 9220               Auth-Internal-LN
1543
}    #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
1544
1446
=head2 get_auth_type_location
1545
=head2 get_auth_type_location
1447
1546
(-)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