Lines 88-93
use MARC::File::USMARC;
Link Here
|
88 |
use MARC::File::XML; |
88 |
use MARC::File::XML; |
89 |
use POSIX qw(strftime); |
89 |
use POSIX qw(strftime); |
90 |
use Module::Load::Conditional qw(can_load); |
90 |
use Module::Load::Conditional qw(can_load); |
|
|
91 |
use URI; |
92 |
use URI::Escape; # GetCOinSBiblio |
91 |
|
93 |
|
92 |
use C4::Koha; |
94 |
use C4::Koha; |
93 |
use C4::Log; # logaction |
95 |
use C4::Log; # logaction |
Lines 1244-1288
sub GetCOinSBiblio {
Link Here
|
1244 |
carp 'GetCOinSBiblio called with undefined record'; |
1246 |
carp 'GetCOinSBiblio called with undefined record'; |
1245 |
return; |
1247 |
return; |
1246 |
} |
1248 |
} |
|
|
1249 |
|
1247 |
my $pos7 = substr $record->leader(), 7, 1; |
1250 |
my $pos7 = substr $record->leader(), 7, 1; |
1248 |
my $pos6 = substr $record->leader(), 6, 1; |
1251 |
my $pos6 = substr $record->leader(), 6, 1; |
1249 |
my $mtx; |
1252 |
my $mtx; |
1250 |
my $genre; |
1253 |
my $genre; |
1251 |
my ( $aulast, $aufirst ) = ( '', '' ); |
1254 |
my ( $aulast, $aufirst ) = ( '', '' ); |
1252 |
my $oauthors = ''; |
1255 |
my @authors; |
1253 |
my $title = ''; |
1256 |
my $title; |
1254 |
my $subtitle = ''; |
1257 |
my $hosttitle; |
1255 |
my $pubyear = ''; |
1258 |
my $pubyear = ''; |
1256 |
my $isbn = ''; |
1259 |
my $isbn = ''; |
1257 |
my $issn = ''; |
1260 |
my $issn = ''; |
1258 |
my $publisher = ''; |
1261 |
my $publisher = ''; |
1259 |
my $pages = ''; |
1262 |
my $pages = ''; |
1260 |
my $titletype = 'b'; |
1263 |
my $titletype = ''; |
1261 |
|
1264 |
|
1262 |
# For the purposes of generating COinS metadata, LDR/06-07 can be |
1265 |
# For the purposes of generating COinS metadata, LDR/06-07 can be |
1263 |
# considered the same for UNIMARC and MARC21 |
1266 |
# considered the same for UNIMARC and MARC21 |
1264 |
my $fmts6; |
1267 |
my $fmts6 = { |
1265 |
my $fmts7; |
1268 |
'a' => 'book', |
1266 |
%$fmts6 = ( |
1269 |
'b' => 'manuscript', |
1267 |
'a' => 'book', |
1270 |
'c' => 'book', |
1268 |
'b' => 'manuscript', |
1271 |
'd' => 'manuscript', |
1269 |
'c' => 'book', |
1272 |
'e' => 'map', |
1270 |
'd' => 'manuscript', |
1273 |
'f' => 'map', |
1271 |
'e' => 'map', |
1274 |
'g' => 'film', |
1272 |
'f' => 'map', |
1275 |
'i' => 'audioRecording', |
1273 |
'g' => 'film', |
1276 |
'j' => 'audioRecording', |
1274 |
'i' => 'audioRecording', |
1277 |
'k' => 'artwork', |
1275 |
'j' => 'audioRecording', |
1278 |
'l' => 'document', |
1276 |
'k' => 'artwork', |
1279 |
'm' => 'computerProgram', |
1277 |
'l' => 'document', |
1280 |
'o' => 'document', |
1278 |
'm' => 'computerProgram', |
1281 |
'r' => 'document', |
1279 |
'o' => 'document', |
1282 |
}; |
1280 |
'r' => 'document', |
1283 |
my $fmts7 = { |
1281 |
); |
1284 |
'a' => 'journalArticle', |
1282 |
%$fmts7 = ( |
1285 |
's' => 'journal', |
1283 |
'a' => 'journalArticle', |
1286 |
}; |
1284 |
's' => 'journal', |
|
|
1285 |
); |
1286 |
|
1287 |
|
1287 |
$genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book'; |
1288 |
$genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book'; |
1288 |
|
1289 |
|
Lines 1293-1298
sub GetCOinSBiblio {
Link Here
|
1293 |
##### We must transform mtx to a valable mtx and document type #### |
1294 |
##### We must transform mtx to a valable mtx and document type #### |
1294 |
if ( $genre eq 'book' ) { |
1295 |
if ( $genre eq 'book' ) { |
1295 |
$mtx = 'book'; |
1296 |
$mtx = 'book'; |
|
|
1297 |
$titletype = 'b'; |
1296 |
} elsif ( $genre eq 'journal' ) { |
1298 |
} elsif ( $genre eq 'journal' ) { |
1297 |
$mtx = 'journal'; |
1299 |
$mtx = 'journal'; |
1298 |
$titletype = 'j'; |
1300 |
$titletype = 'j'; |
Lines 1304-1329
sub GetCOinSBiblio {
Link Here
|
1304 |
$mtx = 'dc'; |
1306 |
$mtx = 'dc'; |
1305 |
} |
1307 |
} |
1306 |
|
1308 |
|
1307 |
$genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre"; |
|
|
1308 |
|
1309 |
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { |
1309 |
if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { |
1310 |
|
1310 |
|
1311 |
# Setting datas |
1311 |
# Setting datas |
1312 |
$aulast = $record->subfield( '700', 'a' ) || ''; |
1312 |
$aulast = $record->subfield( '700', 'a' ) || ''; |
1313 |
$aufirst = $record->subfield( '700', 'b' ) || ''; |
1313 |
$aufirst = $record->subfield( '700', 'b' ) || ''; |
1314 |
$oauthors = "&rft.au=$aufirst $aulast"; |
1314 |
push @authors, "$aufirst $aulast" if ($aufirst or $aulast); |
1315 |
|
1315 |
|
1316 |
# others authors |
1316 |
# others authors |
1317 |
if ( $record->field('200') ) { |
1317 |
if ( $record->field('200') ) { |
1318 |
for my $au ( $record->field('200')->subfield('g') ) { |
1318 |
for my $au ( $record->field('200')->subfield('g') ) { |
1319 |
$oauthors .= "&rft.au=$au"; |
1319 |
push @authors, $au; |
1320 |
} |
1320 |
} |
1321 |
} |
1321 |
} |
1322 |
$title = |
1322 |
|
1323 |
( $mtx eq 'dc' ) |
1323 |
$title = $record->subfield( '200', 'a' ); |
1324 |
? "&rft.title=" . $record->subfield( '200', 'a' ) |
1324 |
my $subfield_210d = $record->subfield('210', 'd'); |
1325 |
: "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' ); |
1325 |
if ($subfield_210d and $subfield_210d =~ /(\d{4})/) { |
1326 |
$pubyear = $record->subfield( '210', 'd' ) || ''; |
1326 |
$pubyear = $1; |
|
|
1327 |
} |
1327 |
$publisher = $record->subfield( '210', 'c' ) || ''; |
1328 |
$publisher = $record->subfield( '210', 'c' ) || ''; |
1328 |
$isbn = $record->subfield( '010', 'a' ) || ''; |
1329 |
$isbn = $record->subfield( '010', 'a' ) || ''; |
1329 |
$issn = $record->subfield( '011', 'a' ) || ''; |
1330 |
$issn = $record->subfield( '011', 'a' ) || ''; |
Lines 1333-1366
sub GetCOinSBiblio {
Link Here
|
1333 |
|
1334 |
|
1334 |
# Setting datas |
1335 |
# Setting datas |
1335 |
if ( $record->field('100') ) { |
1336 |
if ( $record->field('100') ) { |
1336 |
$oauthors .= "&rft.au=" . $record->subfield( '100', 'a' ); |
1337 |
push @authors, $record->subfield( '100', 'a' ); |
1337 |
} |
1338 |
} |
1338 |
|
1339 |
|
1339 |
# others authors |
1340 |
# others authors |
1340 |
if ( $record->field('700') ) { |
1341 |
if ( $record->field('700') ) { |
1341 |
for my $au ( $record->field('700')->subfield('a') ) { |
1342 |
for my $au ( $record->field('700')->subfield('a') ) { |
1342 |
$oauthors .= "&rft.au=$au"; |
1343 |
push @authors, $au; |
1343 |
} |
1344 |
} |
1344 |
} |
1345 |
} |
1345 |
$title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' ); |
1346 |
$title = $record->subfield( '245', 'a' ) . $record->subfield( '245', 'b' ); |
1346 |
$subtitle = $record->subfield( '245', 'b' ) || ''; |
|
|
1347 |
$title .= $subtitle; |
1348 |
if ($titletype eq 'a') { |
1347 |
if ($titletype eq 'a') { |
1349 |
$pubyear = $record->field('008') || ''; |
1348 |
$pubyear = $record->field('008') || ''; |
1350 |
$pubyear = substr($pubyear->data(), 7, 4) if $pubyear; |
1349 |
$pubyear = substr($pubyear->data(), 7, 4) if $pubyear; |
1351 |
$isbn = $record->subfield( '773', 'z' ) || ''; |
1350 |
$isbn = $record->subfield( '773', 'z' ) || ''; |
1352 |
$issn = $record->subfield( '773', 'x' ) || ''; |
1351 |
$issn = $record->subfield( '773', 'x' ) || ''; |
1353 |
if ($mtx eq 'journal') { |
1352 |
$hosttitle = $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{}; |
1354 |
$title .= "&rft.title=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} ); |
1353 |
my @rels = $record->subfield( '773', 'g' ); |
1355 |
} else { |
1354 |
$pages = join(', ', @rels); |
1356 |
$title .= "&rft.btitle=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} ); |
|
|
1357 |
} |
1358 |
foreach my $rel ($record->subfield( '773', 'g' )) { |
1359 |
if ($pages) { |
1360 |
$pages .= ', '; |
1361 |
} |
1362 |
$pages .= $rel; |
1363 |
} |
1364 |
} else { |
1355 |
} else { |
1365 |
$pubyear = $record->subfield( '260', 'c' ) || ''; |
1356 |
$pubyear = $record->subfield( '260', 'c' ) || ''; |
1366 |
$publisher = $record->subfield( '260', 'b' ) || ''; |
1357 |
$publisher = $record->subfield( '260', 'b' ) || ''; |
Lines 1369-1384
sub GetCOinSBiblio {
Link Here
|
1369 |
} |
1360 |
} |
1370 |
|
1361 |
|
1371 |
} |
1362 |
} |
1372 |
my $coins_value = |
|
|
1373 |
"ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear&rft.pages=$pages"; |
1374 |
$coins_value =~ s/(\ |&[^a])/\+/g; |
1375 |
$coins_value =~ s/\"/\"\;/g; |
1376 |
|
1363 |
|
1377 |
#<!-- TMPL_VAR NAME="ocoins_format" -->&rft.au=<!-- TMPL_VAR NAME="author" -->&rft.btitle=<!-- TMPL_VAR NAME="title" -->&rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&rft.pages=<!-- TMPL_VAR NAME="pages" -->&rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&rft.aucorp=&rft.place=<!-- TMPL_VAR NAME="place" -->&rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&rft.edition=<!-- TMPL_VAR NAME="edition" -->&rft.series=<!-- TMPL_VAR NAME="series" -->&rft.genre=" |
1364 |
my @params = ( |
|
|
1365 |
[ 'ctx_ver', 'Z39.88-2004' ], |
1366 |
[ 'rft_val_fmt', "info:ofi/fmt:kev:mtx:$mtx" ], |
1367 |
[ ($mtx eq 'dc' ? 'rft.type' : 'rft.genre'), $genre ], |
1368 |
[ "rft.${titletype}title", $title ], |
1369 |
); |
1370 |
|
1371 |
# rft.title is authorized only once, so by checking $titletype |
1372 |
# we ensure that rft.title is not already in the list. |
1373 |
if ($hosttitle and $titletype) { |
1374 |
push @params, [ 'rft.title', $hosttitle ]; |
1375 |
} |
1376 |
|
1377 |
push @params, ( |
1378 |
[ 'rft.isbn', $isbn ], |
1379 |
[ 'rft.issn', $issn ], |
1380 |
); |
1381 |
|
1382 |
# If it's a subscription, these informations have no meaning. |
1383 |
if ($genre ne 'journal') { |
1384 |
push @params, ( |
1385 |
[ 'rft.aulast', $aulast ], |
1386 |
[ 'rft.aufirst', $aufirst ], |
1387 |
(map { [ 'rft.au', $_ ] } @authors), |
1388 |
[ 'rft.pub', $publisher ], |
1389 |
[ 'rft.date', $pubyear ], |
1390 |
[ 'rft.pages', $pages ], |
1391 |
); |
1392 |
} |
1393 |
|
1394 |
my $coins_value = join( '&', |
1395 |
map { $$_[1] ? $$_[0] . '=' . uri_escape_utf8( $$_[1] ) : () } @params ); |
1378 |
|
1396 |
|
1379 |
return $coins_value; |
1397 |
return $coins_value; |
1380 |
} |
1398 |
} |
1381 |
|
1399 |
|
|
|
1400 |
sub GetOpenURLResolverURL { |
1401 |
my ($record) = @_; |
1402 |
|
1403 |
my $coins = GetCOinSBiblio($record); |
1404 |
my $OpenURLResolverURL = C4::Context->preference('OpenURLResolverURL'); |
1405 |
|
1406 |
if ($OpenURLResolverURL) { |
1407 |
my $uri = URI->new($OpenURLResolverURL); |
1408 |
|
1409 |
if (not defined $uri->query) { |
1410 |
$OpenURLResolverURL .= '?'; |
1411 |
} else { |
1412 |
$OpenURLResolverURL .= '&'; |
1413 |
} |
1414 |
$OpenURLResolverURL .= $coins; |
1415 |
} |
1416 |
|
1417 |
return $OpenURLResolverURL; |
1418 |
} |
1419 |
|
1382 |
|
1420 |
|
1383 |
=head2 GetMarcPrice |
1421 |
=head2 GetMarcPrice |
1384 |
|
1422 |
|