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