|
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 |
|