Lines 29-34
use MARC::File::USMARC;
Link Here
|
29 |
use MARC::File::XML; |
29 |
use MARC::File::XML; |
30 |
use POSIX qw(strftime); |
30 |
use POSIX qw(strftime); |
31 |
use Module::Load::Conditional qw(can_load); |
31 |
use Module::Load::Conditional qw(can_load); |
|
|
32 |
use JSON qw(encode_json decode_json); |
32 |
|
33 |
|
33 |
use C4::Koha; |
34 |
use C4::Koha; |
34 |
use C4::Dates qw/format_date/; |
35 |
use C4::Dates qw/format_date/; |
Lines 78-83
BEGIN {
Link Here
|
78 |
&GetMarcISSN |
79 |
&GetMarcISSN |
79 |
&GetMarcSubjects |
80 |
&GetMarcSubjects |
80 |
&GetMarcBiblio |
81 |
&GetMarcBiblio |
|
|
82 |
&GetMarcBiblioHistory |
81 |
&GetMarcAuthors |
83 |
&GetMarcAuthors |
82 |
&GetMarcSeries |
84 |
&GetMarcSeries |
83 |
&GetMarcHosts |
85 |
&GetMarcHosts |
Lines 139-144
BEGIN {
Link Here
|
139 |
&TransformHtmlToXml |
141 |
&TransformHtmlToXml |
140 |
prepare_host_field |
142 |
prepare_host_field |
141 |
); |
143 |
); |
|
|
144 |
|
145 |
# History functions |
146 |
push @EXPORT, qw( |
147 |
&HistoryUpdate |
148 |
&HistoryParse |
149 |
&HistoryMapUsers |
150 |
&HistoryBorrowerDetails |
151 |
&HistoryRecordNew |
152 |
); |
142 |
} |
153 |
} |
143 |
|
154 |
|
144 |
=head1 NAME |
155 |
=head1 NAME |
Lines 266-273
sub AddBiblio {
Link Here
|
266 |
# update MARC subfield that stores biblioitems.cn_sort |
277 |
# update MARC subfield that stores biblioitems.cn_sort |
267 |
_koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode ); |
278 |
_koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode ); |
268 |
|
279 |
|
269 |
# now add the record |
280 |
# now add the record (history parameter is undef: no history yet]) |
270 |
ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save; |
281 |
ModBiblioMarc( $record, undef, $biblionumber, $frameworkcode ) unless $defer_marc_save; |
271 |
|
282 |
|
272 |
# update OAI-PMH sets |
283 |
# update OAI-PMH sets |
273 |
if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) { |
284 |
if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) { |
Lines 332-340
sub ModBiblio {
Link Here
|
332 |
# update biblionumber and biblioitemnumber in MARC |
343 |
# update biblionumber and biblioitemnumber in MARC |
333 |
# FIXME - this is assuming a 1 to 1 relationship between |
344 |
# FIXME - this is assuming a 1 to 1 relationship between |
334 |
# biblios and biblioitems |
345 |
# biblios and biblioitems |
335 |
my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?"); |
346 |
my $sth = $dbh->prepare("select biblioitemnumber,history from biblioitems where biblionumber=?"); |
336 |
$sth->execute($biblionumber); |
347 |
$sth->execute($biblionumber); |
337 |
my ($biblioitemnumber) = $sth->fetchrow; |
348 |
my ($biblioitemnumber, $history) = $sth->fetchrow; |
338 |
$sth->finish(); |
349 |
$sth->finish(); |
339 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
350 |
_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); |
340 |
|
351 |
|
Lines 345-351
sub ModBiblio {
Link Here
|
345 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
356 |
_koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); |
346 |
|
357 |
|
347 |
# update the MARC record (that now contains biblio and items) with the new record data |
358 |
# update the MARC record (that now contains biblio and items) with the new record data |
348 |
&ModBiblioMarc( $record, $biblionumber, $frameworkcode ); |
359 |
&ModBiblioMarc( $record, $history, $biblionumber, $frameworkcode ); |
349 |
|
360 |
|
350 |
# modify the other koha tables |
361 |
# modify the other koha tables |
351 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
362 |
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); |
Lines 1291-1296
sub GetMarcBiblio {
Link Here
|
1291 |
} |
1302 |
} |
1292 |
} |
1303 |
} |
1293 |
|
1304 |
|
|
|
1305 |
=head2 GetMarcBiblioHistory |
1306 |
|
1307 |
my ($record, $history) = GetMarcBiblio($biblionumber, [$embeditems]); |
1308 |
|
1309 |
Returns MARC::Record representing bib identified by |
1310 |
C<$biblionumber>. If no bib exists, returns undef. |
1311 |
C<$embeditems>. If set to true, items data are included. |
1312 |
The MARC record contains biblio data, and items data if $embeditems is set to true. |
1313 |
|
1314 |
=cut |
1315 |
|
1316 |
sub GetMarcBiblioHistory { |
1317 |
my $biblionumber = shift; |
1318 |
my $embeditems = shift || 0; |
1319 |
|
1320 |
if (not defined $biblionumber) { |
1321 |
carp 'GetMarcBiblio called with undefined biblionumber'; |
1322 |
return; |
1323 |
} |
1324 |
|
1325 |
my $dbh = C4::Context->dbh; |
1326 |
my $sth = $dbh->prepare("SELECT marcxml,history FROM biblioitems WHERE biblionumber=? "); |
1327 |
$sth->execute($biblionumber); |
1328 |
my $row = $sth->fetchrow_hashref; |
1329 |
my $marcxml = StripNonXmlChars( $row->{'marcxml'} ); |
1330 |
MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') ); |
1331 |
my $record = MARC::Record->new(); |
1332 |
my ($history, $borrowers) = HistoryParse( $row->{'history'} ); |
1333 |
$borrowers = HistoryBorrowerDetails( $borrowers ); |
1334 |
$history = HistoryMapUsers( $history, $borrowers ); |
1335 |
|
1336 |
if ($marcxml) { |
1337 |
$record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) }; |
1338 |
|
1339 |
if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; } |
1340 |
return unless $record; |
1341 |
|
1342 |
C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber); |
1343 |
C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems); |
1344 |
return ($record, $history); |
1345 |
} else { |
1346 |
return; |
1347 |
} |
1348 |
} |
1349 |
# Input format (JSON): [ { datetime, borrowernumber, marcxml } ] |
1350 |
# Output format: { tag } { subfield } [ { borrowernumber, data, datetime } ] |
1351 |
sub HistoryParse |
1352 |
{ |
1353 |
my $json = shift; |
1354 |
|
1355 |
if (!defined $json) { |
1356 |
carp('HistoryParse: Missing JSON parameter'); |
1357 |
return undef; |
1358 |
} |
1359 |
|
1360 |
my $input = decode_json($json); |
1361 |
|
1362 |
# Reindex the dataset; order all values by datetime under each tag name. |
1363 |
my $borrowers = { }; |
1364 |
my $output = { }; |
1365 |
for my $item (@{$input}) { |
1366 |
|
1367 |
my $datetime = $item->{datetime}; |
1368 |
$borrowers->{ $item->{borrowernumber }} = undef; |
1369 |
my $record = MARC::File::XML::decode($item->{marcxml}); |
1370 |
|
1371 |
for my $field ($record->fields()) { |
1372 |
my $tag = $field->tag(); |
1373 |
$output->{$tag} = {} unless defined $output->{$tag}; |
1374 |
|
1375 |
for my $subfield ($field->subfields()) { |
1376 |
|
1377 |
# Build hash ref structure. |
1378 |
my $subfield_tag = @{$subfield}[0]; |
1379 |
$output->{$tag}->{$subfield_tag} = [] |
1380 |
unless defined $output->{$tag}->{$subfield_tag}; |
1381 |
|
1382 |
push( @{ $output->{$tag}->{$subfield_tag} }, HistoryParsedRecordNew( |
1383 |
@{ $subfield }[1], $item->{borrowernumber}, $datetime)); |
1384 |
} |
1385 |
} |
1386 |
} |
1387 |
return ( $output, $borrowers ); |
1388 |
} |
1389 |
|
1390 |
# Take a hashref with borrowernumbers as keys, returns new hash with the |
1391 |
# borrowernumber as key to hash containing firstname, surname and title. |
1392 |
sub HistoryBorrowerDetails |
1393 |
{ |
1394 |
my $borrowernumbers = shift; |
1395 |
|
1396 |
my $dbh = C4::Context->dbh; |
1397 |
my $output = { }; |
1398 |
my @numbers = keys %{$borrowernumbers}; |
1399 |
if (@numbers > 0) { |
1400 |
# We now need to look up the numeric user id's and map to name and title strings. |
1401 |
my $sth = $dbh->prepare(qq{SELECT |
1402 |
borrowernumber, title, firstname, surname |
1403 |
FROM borrowers |
1404 |
WHERE borrowernumber IN} |
1405 |
. '(' . join(',', ('?') x @numbers) . ')'); |
1406 |
$sth->execute(@numbers) |
1407 |
or die ('BorrowerDetails: Unable to execute SELECT statement'); |
1408 |
while (my $row = $sth->fetchrow_hashref()) { |
1409 |
$output->{ $row->{borrowernumber} } = { }; |
1410 |
$output->{ $row->{borrowernumber} }->{title} = $row->{title}; |
1411 |
$output->{ $row->{borrowernumber} }->{firstname} = $row->{firstname}; |
1412 |
$output->{ $row->{borrowernumber} }->{surname} = $row->{surname}; |
1413 |
} |
1414 |
$sth->finish(); |
1415 |
} |
1416 |
|
1417 |
return $output; |
1418 |
} |
1419 |
|
1420 |
sub HistoryMapUsers |
1421 |
{ |
1422 |
my ($history, $borrowers) = @_; |
1423 |
|
1424 |
my $mappedhistory = { }; |
1425 |
for my $tag (keys %{ $history }) { |
1426 |
$mappedhistory->{ $tag } = { }; |
1427 |
for my $field (keys %{ $history->{ $tag } }) { |
1428 |
$mappedhistory->{ $tag }->{ $field } = [ ]; |
1429 |
for my $entry (@{ $history->{ $tag }->{ $field } }) { |
1430 |
# C4::Dates does not allow me to print time, only dates. |
1431 |
#my $newtime = C4::Dates->new( $history->{ $tag }->{ $field }->{ $time }->{timestamp}, 'iso' )->output('syspref'); |
1432 |
|
1433 |
my $newitem = { }; |
1434 |
my $user = $borrowers->{ $entry->{borrowernumber} }; |
1435 |
|
1436 |
# Maybe change this to work on original instead of copy? |
1437 |
$newitem->{title} = $user->{title}; |
1438 |
$newitem->{firstname} = $user->{firstname}; |
1439 |
$newitem->{surname} = $user->{surname}; |
1440 |
$newitem->{borrowernumber} = $entry->{borrowernumber}; |
1441 |
$newitem->{data} = $entry->{data}; |
1442 |
$newitem->{datetime} = $entry->{datetime}; |
1443 |
|
1444 |
push ( @{ $mappedhistory->{ $tag }->{ $field } } , $newitem); |
1445 |
} |
1446 |
} |
1447 |
} |
1448 |
|
1449 |
return $mappedhistory; |
1450 |
} |
1451 |
|
1452 |
sub HistoryParsedRecordNew |
1453 |
{ |
1454 |
my ($value, $borrowernumber, $datetime) = @_; |
1455 |
my $newrecord = { |
1456 |
data => $value, |
1457 |
borrowernumber => $borrowernumber, |
1458 |
datetime => $datetime, |
1459 |
}; |
1460 |
|
1461 |
return $newrecord; |
1462 |
} |
1463 |
|
1294 |
=head2 GetXmlBiblio |
1464 |
=head2 GetXmlBiblio |
1295 |
|
1465 |
|
1296 |
my $marcxml = GetXmlBiblio($biblionumber); |
1466 |
my $marcxml = GetXmlBiblio($biblionumber); |
Lines 3361-3367
Function exported, but should NOT be used, unless you really know what you're do
Link Here
|
3361 |
sub ModBiblioMarc { |
3531 |
sub ModBiblioMarc { |
3362 |
# pass the MARC::Record to this function, and it will create the records in |
3532 |
# pass the MARC::Record to this function, and it will create the records in |
3363 |
# the marc field |
3533 |
# the marc field |
3364 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
3534 |
my ( $record, $history, $biblionumber, $frameworkcode ) = @_; |
3365 |
if ( !$record ) { |
3535 |
if ( !$record ) { |
3366 |
carp 'ModBiblioMarc passed an undefined record'; |
3536 |
carp 'ModBiblioMarc passed an undefined record'; |
3367 |
return; |
3537 |
return; |
Lines 3407-3414
sub ModBiblioMarc {
Link Here
|
3407 |
$f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005; |
3577 |
$f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005; |
3408 |
} |
3578 |
} |
3409 |
|
3579 |
|
3410 |
$sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?"); |
3580 |
# Decode JSON history, create new record, update and re-encode to JSON. |
3411 |
$sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber ); |
3581 |
my $historylength = 10; |
|
|
3582 |
eval { |
3583 |
$history = decode_json($history); |
3584 |
1; |
3585 |
} or do { |
3586 |
$history = undef; |
3587 |
}; |
3588 |
my $newrecord = HistoryRecordNew($record); |
3589 |
my $newhistory = HistoryUpdate($newrecord, $historylength, $history); |
3590 |
$newhistory = encode_json($newhistory); |
3591 |
|
3592 |
$sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=?,history=? WHERE biblionumber=?"); |
3593 |
$sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $newhistory, $biblionumber ); |
3412 |
$sth->finish; |
3594 |
$sth->finish; |
3413 |
ModZebra( $biblionumber, "specialUpdate", "biblioserver" ); |
3595 |
ModZebra( $biblionumber, "specialUpdate", "biblioserver" ); |
3414 |
return $biblionumber; |
3596 |
return $biblionumber; |
Lines 3765-3770
sub RemoveAllNsb {
Link Here
|
3765 |
return $record; |
3947 |
return $record; |
3766 |
} |
3948 |
} |
3767 |
|
3949 |
|
|
|
3950 |
sub HistoryRecordNew |
3951 |
{ |
3952 |
my ( $record ) = @_; |
3953 |
|
3954 |
my $encoding = C4::Context->preference("marcflavour"); |
3955 |
my $hash_record = { |
3956 |
borrowernumber => C4::Context->userenv()->{number}, |
3957 |
datetime => POSIX::strftime('%Y-%m-%d %T', localtime(time)), |
3958 |
marcxml => $record->as_xml_record($encoding), |
3959 |
}; |
3960 |
|
3961 |
return $hash_record; |
3962 |
}; |
3963 |
|
3964 |
sub HistoryUpdate |
3965 |
{ |
3966 |
my ( $record, $limit, $collection ) = @_; |
3967 |
|
3968 |
if ( !$record ) { |
3969 |
carp('HistoryUpdate: Called with undefined record'); |
3970 |
return; |
3971 |
} |
3972 |
|
3973 |
if ( ref($record) ne 'HASH' ) { |
3974 |
carp('HistoryUpdate: Record parameter is not a hashref'); |
3975 |
return; |
3976 |
} |
3977 |
|
3978 |
$limit = 10 unless defined $limit; |
3979 |
|
3980 |
# We need something to append history to, even if there is none. |
3981 |
$collection = [] unless defined $collection; |
3982 |
|
3983 |
# Truncate history to $histsize - 1, need space for new entry. |
3984 |
splice(@{$collection}, $limit - 1); |
3985 |
push(@{$collection}, $record); |
3986 |
|
3987 |
# Sort the resulting array, newest entries first. |
3988 |
# Removed; used to be integer timestamps. Is now MySQL date strings. |
3989 |
#@{$collection} = sort { $a->{timestamp} < $b->{timestamp} } @{$collection}; |
3990 |
@{$collection} = sort { $a->{datetime} lt $b->{datetime} } @{$collection}; |
3991 |
|
3992 |
return $collection; |
3993 |
} |
3994 |
|
3768 |
1; |
3995 |
1; |
3769 |
|
3996 |
|
3770 |
|
3997 |
|