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

(-)a/C4/AuthoritiesMarc.pm (-84 / +43 lines)
Lines 1407-1425 sub AddAuthorityTrees{ Link Here
1407
1407
1408
=head2 merge
1408
=head2 merge
1409
1409
1410
  $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto)
1410
  my @edited_biblionumbers = merge(mergefrom, $MARCfrom, $mergeto, $MARCto);
1411
1411
1412
Could add some feature : Migrating from a typecode to an other for instance.
1412
Could add some feature : Migrating from a typecode to an other for instance.
1413
Then we should add some new parameter : bibliotargettag, authtargettag
1413
Then we should add some new parameter : bibliotargettag, authtargettag
1414
1414
1415
Returns a list of biblionumbers of records that were modified.
1416
1415
=cut
1417
=cut
1416
1418
1417
sub merge {
1419
sub merge {
1418
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1420
    my ($mergefrom, $MARCfrom, $mergeto, $MARCto) = @_;
1419
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1421
    my @editedbiblios;
1420
    my $dbh=C4::Context->dbh;
1422
    my $dbh = C4::Context->dbh;
1421
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1423
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1422
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1424
    my $authtypecodeto = GetAuthTypeCode($mergeto);
1425
1426
    $MARCfrom ||= GetAuthority($mergefrom);
1427
    $MARCto ||= GetAuthority($mergeto);
1428
1423
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1429
#     warn "mergefrom : $authtypecodefrom $mergefrom mergeto : $authtypecodeto $mergeto ";
1424
    # return if authority does not exist
1430
    # return if authority does not exist
1425
    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
1431
    return "error MARCFROM not a marcrecord ".Data::Dumper::Dumper($MARCfrom) if scalar($MARCfrom->fields()) == 0;
Lines 1430-1441 sub merge { Link Here
1430
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1436
    my ($auth_tag_to_report_from) = $sth->fetchrow;
1431
    $sth->execute($authtypecodeto);
1437
    $sth->execute($authtypecodeto);
1432
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1438
    my ($auth_tag_to_report_to) = $sth->fetchrow;
1433
    
1439
1434
    my @record_to;
1440
    my @record_to;
1435
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1441
    @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $MARCto->field($auth_tag_to_report_to);
1436
    my @record_from;
1442
    my @record_from;
1437
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1443
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1438
    
1444
1439
    my @reccache;
1445
    my @reccache;
1440
    # search all biblio tags using this authority.
1446
    # search all biblio tags using this authority.
1441
    #Getting marcbiblios impacted by the change.
1447
    #Getting marcbiblios impacted by the change.
Lines 1472-1513 sub merge { Link Here
1472
    while (my ($tagfield) = $sth->fetchrow) {
1478
    while (my ($tagfield) = $sth->fetchrow) {
1473
        push @tags_using_authtype,$tagfield ;
1479
        push @tags_using_authtype,$tagfield ;
1474
    }
1480
    }
1475
    my $tag_to=0;  
1481
    my $tag_to=0;
1476
    if ($authtypecodeto ne $authtypecodefrom){  
1482
    if ($authtypecodeto ne $authtypecodefrom){
1477
        # If many tags, take the first
1483
        # If many tags, take the first
1478
        $sth->execute($authtypecodeto);    
1484
        $sth->execute($authtypecodeto);
1479
        $tag_to=$sth->fetchrow;
1485
        $tag_to=$sth->fetchrow;
1480
        #warn $tag_to;    
1486
    }
1481
    }  
1482
    # BulkEdit marc records
1487
    # BulkEdit marc records
1483
    # May be used as a template for a bulkedit field  
1488
    # May be used as a template for a bulkedit field
1484
    foreach my $marcrecord(@reccache){
1489
    foreach my $marcrecord(@reccache){
1485
        my $update;           
1490
        my $update;
1486
        foreach my $tagfield (@tags_using_authtype){
1491
        foreach my $tagfield (@tags_using_authtype){
1487
#             warn "tagfield : $tagfield ";
1488
            foreach my $field ($marcrecord->field($tagfield)){
1492
            foreach my $field ($marcrecord->field($tagfield)){
1489
                # biblio is linked to authority with $9 subfield containing authid
1493
                # biblio is linked to authority with $9 subfield containing authid
1490
                my $auth_number=$field->subfield("9");
1494
                my $auth_number=$field->subfield("9");
1491
                my $tag=$field->tag();          
1495
                my $tag=$field->tag();
1492
                if ($auth_number==$mergefrom) {
1496
                if ($auth_number==$mergefrom) {
1493
                my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1497
                    my $field_to = MARC::Field->new(($tag_to?$tag_to:$tag),
1494
		my $exclude='9';
1498
                        $field->indicator(1),$field->indicator(2),"9"=>$mergeto);
1495
                foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
1499
                    my $exclude='9';
1496
                    $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1500
                    foreach my $subfield (grep {$_->[0] ne '9'} @record_to) {
1497
		    $exclude.= $subfield->[0];
1501
                        $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1498
                }
1502
                        $exclude.= $subfield->[0];
1499
		$exclude='['.$exclude.']';
1503
                    }
1500
#		add subfields in $field not included in @record_to
1504
                    $exclude='['.$exclude.']';
1501
		my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1505
                    #add subfields in $field not included in @record_to
1502
                foreach my $subfield (@restore) {
1506
                    my @restore= grep {$_->[0]!~/$exclude/} $field->subfields();
1503
                   $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1507
                    foreach my $subfield (@restore) {
1504
		}
1508
                       $field_to->add_subfields($subfield->[0] =>$subfield->[1]);
1505
                $marcrecord->delete_field($field);
1509
                    }
1506
                $marcrecord->insert_grouped_field($field_to);            
1510
                    $marcrecord->delete_field($field);
1507
                $update=1;
1511
                    $marcrecord->insert_grouped_field($field_to);
1512
                    $update=1;
1508
                }
1513
                }
1509
            }#for each tag
1514
            }#for each tag
1510
        }#foreach tagfield
1515
        }#foreach tagfield
1516
1511
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1517
        my ($bibliotag,$bibliosubf) = GetMarcFromKohaField("biblio.biblionumber","") ;
1512
        my $biblionumber;
1518
        my $biblionumber;
1513
        if ($bibliotag<10){
1519
        if ($bibliotag<10){
Lines 1522-1581 sub merge { Link Here
1522
        }
1528
        }
1523
        if ($update==1){
1529
        if ($update==1){
1524
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1530
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1525
            $counteditedbiblio++;
1531
            push @editedbiblios, $biblionumber;
1526
            warn $counteditedbiblio if (($counteditedbiblio % 10) and $ENV{DEBUG});
1532
        }
1527
        }    
1528
    }#foreach $marc
1533
    }#foreach $marc
1529
    return $counteditedbiblio;  
1534
1530
  # now, find every other authority linked with this authority
1535
    DelAuthority($mergefrom) if ($mergefrom != $mergeto);
1531
  # now, find every other authority linked with this authority
1536
1532
#   my $oConnection=C4::Context->Zconn("authorityserver");
1537
    return @editedbiblios;
1533
#   my $query;
1538
}
1534
# # att 9210               Auth-Internal-authtype
1535
# # att 9220               Auth-Internal-LN
1536
# # ccl.properties to add for authorities
1537
#   $query= "= ".$mergefrom;
1538
#   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1539
#   my $count=$oResult->size() if  ($oResult);
1540
#   my @reccache;
1541
#   my $z=0;
1542
#   while ( $z<$count ) {
1543
#   my $rec;
1544
#           $rec=$oResult->record($z);
1545
#       my $marcdata = $rec->raw();
1546
#   push @reccache, $marcdata;
1547
#   $z++;
1548
#   }
1549
#   $oResult->destroy();
1550
#   foreach my $marc(@reccache){
1551
#     my $update;
1552
#     my $marcrecord;
1553
#     $marcrecord = MARC::File::USMARC::decode($marc);
1554
#     foreach my $tagfield (@tags_using_authtype){
1555
#       $tagfield=substr($tagfield,0,3);
1556
#       my @tags = $marcrecord->field($tagfield);
1557
#       foreach my $tag (@tags){
1558
#         my $tagsubs=$tag->subfield("9");
1559
#     #warn "$tagfield:$tagsubs:$mergefrom";
1560
#         if ($tagsubs== $mergefrom) {
1561
#           $tag->update("9" =>$mergeto);
1562
#           foreach my $subfield (@record_to) {
1563
#     #        warn "$subfield,$subfield->[0],$subfield->[1]";
1564
#             $tag->update($subfield->[0] =>$subfield->[1]);
1565
#           }#for $subfield
1566
#         }
1567
#         $marcrecord->delete_field($tag);
1568
#         $marcrecord->add_fields($tag);
1569
#         $update=1;
1570
#       }#for each tag
1571
#     }#foreach tagfield
1572
#     my $authoritynumber = TransformMarcToKoha($dbh,$marcrecord,"") ;
1573
#     if ($update==1){
1574
#       &ModAuthority($marcrecord,$authoritynumber,GetAuthTypeCode($authoritynumber)) ;
1575
#     }
1576
# 
1577
#   }#foreach $marc
1578
}#sub
1579
1539
1580
=head2 get_auth_type_location
1540
=head2 get_auth_type_location
1581
1541
1582
- 

Return to bug 11700