|
Lines 90-96
sub marc2ris {
Link Here
|
| 90 |
|
90 |
|
| 91 |
my $marcflavour = C4::Context->preference("marcflavour"); |
91 |
my $marcflavour = C4::Context->preference("marcflavour"); |
| 92 |
my $intype = lc($marcflavour); |
92 |
my $intype = lc($marcflavour); |
| 93 |
my $marcprint = 1; # Debug |
93 |
my $marcprint = 0; # Debug flag; |
| 94 |
|
94 |
|
| 95 |
# Let's redirect stdout |
95 |
# Let's redirect stdout |
| 96 |
open my $oldout, ">&STDOUT"; |
96 |
open my $oldout, ">&STDOUT"; |
|
Lines 105-115
sub marc2ris {
Link Here
|
| 105 |
my $leader = $record->leader(); |
105 |
my $leader = $record->leader(); |
| 106 |
if ($intype eq "marc21") { |
106 |
if ($intype eq "marc21") { |
| 107 |
if ($leader =~ /^.{9}a/) { |
107 |
if ($leader =~ /^.{9}a/) { |
| 108 |
print "<marc>---\n<marc>UTF-8 data\n" if $marcprint; |
108 |
print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint; |
| 109 |
$utf = 1; |
109 |
$utf = 1; |
| 110 |
} |
110 |
} |
| 111 |
else { |
111 |
else { |
| 112 |
print "<marc>---\n<marc>MARC-8 data\n" if $marcprint; |
112 |
print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint; |
| 113 |
} |
113 |
} |
| 114 |
} |
114 |
} |
| 115 |
## else: other MARC formats do not specify the character encoding |
115 |
## else: other MARC formats do not specify the character encoding |
|
Lines 135-141
sub marc2ris {
Link Here
|
| 135 |
foreach my $field (@author_fields) { |
135 |
foreach my $field (@author_fields) { |
| 136 |
if (length($field)) { |
136 |
if (length($field)) { |
| 137 |
my $author = &get_author($field); |
137 |
my $author = &get_author($field); |
| 138 |
print "AU - ",&charconv($author),"\n"; |
138 |
print "AU - ",&charconv($author),"\r\n"; |
| 139 |
} |
139 |
} |
| 140 |
} |
140 |
} |
| 141 |
|
141 |
|
|
Lines 161-167
sub marc2ris {
Link Here
|
| 161 |
foreach my $field (@editor_fields) { |
161 |
foreach my $field (@editor_fields) { |
| 162 |
if (length($field)) { |
162 |
if (length($field)) { |
| 163 |
my $editor = &get_editor($field); |
163 |
my $editor = &get_editor($field); |
| 164 |
print "ED - ",&charconv($editor),"\n"; |
164 |
print "ED - ",&charconv($editor),"\r\n"; |
| 165 |
} |
165 |
} |
| 166 |
} |
166 |
} |
| 167 |
|
167 |
|
|
Lines 178-184
sub marc2ris {
Link Here
|
| 178 |
&print_stitle($record->field('225')); |
178 |
&print_stitle($record->field('225')); |
| 179 |
} |
179 |
} |
| 180 |
else { ## marc21, ukmarc |
180 |
else { ## marc21, ukmarc |
| 181 |
&print_stitle($record->field('210')); |
181 |
&print_stitle($record->field('490')); |
| 182 |
} |
182 |
} |
| 183 |
|
183 |
|
| 184 |
## ISBN/ISSN |
184 |
## ISBN/ISSN |
|
Lines 234-240
sub marc2ris {
Link Here
|
| 234 |
## entry is the number of occurrences, but we're not really interested |
234 |
## entry is the number of occurrences, but we're not really interested |
| 235 |
## in that and rather print the key |
235 |
## in that and rather print the key |
| 236 |
while (my ($key, $value) = each %kwpool) { |
236 |
while (my ($key, $value) = each %kwpool) { |
| 237 |
print "KW - ", &charconv($key), "\n"; |
237 |
print "KW - ", &charconv($key), "\r\n"; |
| 238 |
} |
238 |
} |
| 239 |
|
239 |
|
| 240 |
## 5XX have various candidates for notes and abstracts. We pool |
240 |
## 5XX have various candidates for notes and abstracts. We pool |
|
Lines 261-267
sub marc2ris {
Link Here
|
| 261 |
my $allnotes = join "; ", @notepool; |
261 |
my $allnotes = join "; ", @notepool; |
| 262 |
|
262 |
|
| 263 |
if (length($allnotes) > 0) { |
263 |
if (length($allnotes) > 0) { |
| 264 |
print "N1 - ", &charconv($allnotes), "\n"; |
264 |
print "N1 - ", &charconv($allnotes), "\r\n"; |
| 265 |
} |
265 |
} |
| 266 |
|
266 |
|
| 267 |
## 320/520 have the abstract |
267 |
## 320/520 have the abstract |
|
Lines 276-282
sub marc2ris {
Link Here
|
| 276 |
} |
276 |
} |
| 277 |
|
277 |
|
| 278 |
## end RIS dataset |
278 |
## end RIS dataset |
| 279 |
print "ER - \n"; |
279 |
print "ER - \r\n"; |
| 280 |
|
280 |
|
| 281 |
# Let's re-redirect stdout |
281 |
# Let's re-redirect stdout |
| 282 |
close STDOUT; |
282 |
close STDOUT; |
|
Lines 294-299
sub marc2ris {
Link Here
|
| 294 |
## Returns: the value at leader position 06 |
294 |
## Returns: the value at leader position 06 |
| 295 |
##******************************************************************** |
295 |
##******************************************************************** |
| 296 |
sub print_typetag { |
296 |
sub print_typetag { |
|
|
297 |
my ($leader)= @_; |
| 297 |
## the keys of typehash are the allowed values at position 06 |
298 |
## the keys of typehash are the allowed values at position 06 |
| 298 |
## of the leader of a MARC record, the values are the RIS types |
299 |
## of the leader of a MARC record, the values are the RIS types |
| 299 |
## that might appropriately represent these types. |
300 |
## that might appropriately represent these types. |
|
Lines 331-361
sub print_typetag {
Link Here
|
| 331 |
); |
332 |
); |
| 332 |
|
333 |
|
| 333 |
## The type of a MARC record is found at position 06 of the leader |
334 |
## The type of a MARC record is found at position 06 of the leader |
| 334 |
my $typeofrecord = substr("@_", 6, 1); |
335 |
my $typeofrecord = substr($leader, 6, 1); |
| 335 |
|
336 |
|
| 336 |
## ToDo: for books, field 008 positions 24-27 might have a few more |
337 |
## ToDo: for books, field 008 positions 24-27 might have a few more |
| 337 |
## hints |
338 |
## hints |
| 338 |
|
339 |
|
| 339 |
my $typehash; |
340 |
my %typehash; |
| 340 |
|
341 |
|
| 341 |
## the ukmarc here is just a guess |
342 |
## the ukmarc here is just a guess |
| 342 |
if ($intype eq "marc21" || $intype eq "ukmarc") { |
343 |
if ($intype eq "marc21" || $intype eq "ukmarc") { |
| 343 |
$typehash = $ustypehash; |
344 |
%typehash = %ustypehash; |
| 344 |
} |
345 |
} |
| 345 |
elsif ($intype eq "unimarc") { |
346 |
elsif ($intype eq "unimarc") { |
| 346 |
$typehash = $unitypehash; |
347 |
%typehash = %unitypehash; |
| 347 |
} |
348 |
} |
| 348 |
else { |
349 |
else { |
| 349 |
## assume MARC21 as default |
350 |
## assume MARC21 as default |
| 350 |
$typehash = $ustypehash; |
351 |
%typehash = %ustypehash; |
| 351 |
} |
352 |
} |
| 352 |
|
353 |
|
| 353 |
if (!exists $typehash{$typeofrecord}) { |
354 |
if (!exists $typehash{$typeofrecord}) { |
| 354 |
print "\nTY - BOOK\n"; ## most reasonable default |
355 |
print "TY - BOOK\r\n"; ## most reasonable default |
| 355 |
warn ("no type found - assume BOOK"); |
356 |
warn ("no type found - assume BOOK") if $marcprint; |
| 356 |
} |
357 |
} |
| 357 |
else { |
358 |
else { |
| 358 |
print "\nTY - $typehash{$typeofrecord}\n"; |
359 |
print "TY - $typehash{$typeofrecord}\r\n"; |
| 359 |
} |
360 |
} |
| 360 |
|
361 |
|
| 361 |
## use $typeofrecord as the return value, just in case |
362 |
## use $typeofrecord as the return value, just in case |
|
Lines 378-384
sub normalize_author {
Link Here
|
| 378 |
|
379 |
|
| 379 |
if ($nametype == 0) { |
380 |
if ($nametype == 0) { |
| 380 |
# ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]] |
381 |
# ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]] |
| 381 |
warn("name >>$rawauthora<< in direct order - leave as is"); |
382 |
warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint; |
| 382 |
return $rawauthora; |
383 |
return $rawauthora; |
| 383 |
} |
384 |
} |
| 384 |
elsif ($nametype == 1) { |
385 |
elsif ($nametype == 1) { |
|
Lines 427-437
sub get_author {
Link Here
|
| 427 |
$indicator = 1; |
428 |
$indicator = 1; |
| 428 |
} |
429 |
} |
| 429 |
|
430 |
|
| 430 |
print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\n" if $marcprint; |
431 |
print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint; |
| 431 |
print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\n" if $marcprint; |
432 |
print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint; |
| 432 |
print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\n" if $marcprint; |
433 |
print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint; |
| 433 |
print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\n" if $marcprint; |
434 |
print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint; |
| 434 |
print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\n" if $marcprint; |
435 |
print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint; |
| 435 |
if ($intype eq "ukmarc") { |
436 |
if ($intype eq "ukmarc") { |
| 436 |
my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h'); |
437 |
my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h'); |
| 437 |
normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator")); |
438 |
normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator")); |
|
Lines 449-461
sub get_author {
Link Here
|
| 449 |
sub get_editor { |
450 |
sub get_editor { |
| 450 |
my ($editorfield) = @_; |
451 |
my ($editorfield) = @_; |
| 451 |
|
452 |
|
| 452 |
if ($editorfield == undef) { |
453 |
if (!$editorfield) { |
| 453 |
return undef; |
454 |
return; |
| 454 |
} |
455 |
} |
| 455 |
else { |
456 |
else { |
| 456 |
print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\n" if $marcprint; |
457 |
print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint; |
| 457 |
print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\n" if $marcprint; |
458 |
print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint; |
| 458 |
print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\n" if $marcprint; |
459 |
print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint; |
| 459 |
return $editorfield->subfield('a'); |
460 |
return $editorfield->subfield('a'); |
| 460 |
} |
461 |
} |
| 461 |
} |
462 |
} |
|
Lines 467-481
sub get_editor {
Link Here
|
| 467 |
##******************************************************************** |
468 |
##******************************************************************** |
| 468 |
sub print_title { |
469 |
sub print_title { |
| 469 |
my ($titlefield) = @_; |
470 |
my ($titlefield) = @_; |
| 470 |
if ($titlefield == undef) { |
471 |
if (!$titlefield) { |
| 471 |
print "<marc>empty title field (245)\n" if $marcprint; |
472 |
print "<marc>empty title field (245)\r\n" if $marcprint; |
| 472 |
warn("empty title field (245)"); |
473 |
warn("empty title field (245)") if $marcprint; |
| 473 |
@_; |
|
|
| 474 |
} |
474 |
} |
| 475 |
else { |
475 |
else { |
| 476 |
print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint; |
476 |
print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; |
| 477 |
print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\n" if $marcprint; |
477 |
print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint; |
| 478 |
print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\n" if $marcprint; |
478 |
print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint; |
| 479 |
|
479 |
|
| 480 |
## The title is usually written in a very odd notation. The title |
480 |
## The title is usually written in a very odd notation. The title |
| 481 |
## proper ($a) often ends with a space followed by a separator like |
481 |
## proper ($a) often ends with a space followed by a separator like |
|
Lines 498-504
sub print_title {
Link Here
|
| 498 |
if (length($clean_subtitle) > 0 && $intype ne "unimarc") { |
498 |
if (length($clean_subtitle) > 0 && $intype ne "unimarc") { |
| 499 |
print ": ",&charconv($clean_subtitle); |
499 |
print ": ",&charconv($clean_subtitle); |
| 500 |
} |
500 |
} |
| 501 |
print "\n"; |
501 |
print "\r\n"; |
| 502 |
} |
502 |
} |
| 503 |
|
503 |
|
| 504 |
## The statement of responsibility is just this: horrors. There is |
504 |
## The statement of responsibility is just this: horrors. There is |
|
Lines 506-512
sub print_title {
Link Here
|
| 506 |
## be written and designated. The field is free-form and resistant |
506 |
## be written and designated. The field is free-form and resistant |
| 507 |
## to all parsing efforts, so this information is lost on me |
507 |
## to all parsing efforts, so this information is lost on me |
| 508 |
} |
508 |
} |
| 509 |
} |
509 |
} |
| 510 |
|
510 |
|
| 511 |
##******************************************************************** |
511 |
##******************************************************************** |
| 512 |
## print_stitle(): prints info from series title field |
512 |
## print_stitle(): prints info from series title field |
|
Lines 516-544
sub print_title {
Link Here
|
| 516 |
sub print_stitle { |
516 |
sub print_stitle { |
| 517 |
my ($titlefield) = @_; |
517 |
my ($titlefield) = @_; |
| 518 |
|
518 |
|
| 519 |
if ($titlefield == undef) { |
519 |
if (!$titlefield) { |
| 520 |
print "<marc>empty series title field\n" if $marcprint; |
520 |
print "<marc>empty series title field\r\n" if $marcprint; |
| 521 |
warn("empty series title field"); |
|
|
| 522 |
@_; |
| 523 |
} |
521 |
} |
| 524 |
else { |
522 |
else { |
| 525 |
print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\n" if $marcprint; |
523 |
print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint; |
| 526 |
my $clean_title = $titlefield->subfield('a'); |
524 |
my $clean_title = $titlefield->subfield('a'); |
| 527 |
|
525 |
|
| 528 |
$clean_title =~ s% *[/:;.]$%%; |
526 |
$clean_title =~ s% *[/:;.]$%%; |
| 529 |
|
527 |
|
| 530 |
if (length($clean_title) > 0) { |
528 |
if (length($clean_title) > 0) { |
| 531 |
print "T2 - ", &charconv($clean_title); |
529 |
print "T2 - ", &charconv($clean_title),"\r\n"; |
| 532 |
} |
530 |
} |
| 533 |
|
531 |
|
| 534 |
if ($intype eq "unimarc") { |
532 |
if ($intype eq "unimarc") { |
| 535 |
print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\n" if $marcprint; |
533 |
print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint; |
| 536 |
if (length($titlefield->subfield('v')) > 0) { |
534 |
if (length($titlefield->subfield('v')) > 0) { |
| 537 |
print "VL - ", &charconv($titlefield->subfield('v')); |
535 |
print "VL - ", &charconv($titlefield->subfield('v')),"\r\n"; |
| 538 |
} |
536 |
} |
| 539 |
} |
537 |
} |
| 540 |
} |
538 |
} |
| 541 |
} |
539 |
} |
| 542 |
|
540 |
|
| 543 |
##******************************************************************** |
541 |
##******************************************************************** |
| 544 |
## print_isbn(): gets info from MARC field 020 |
542 |
## print_isbn(): gets info from MARC field 020 |
|
Lines 547-564
sub print_stitle {
Link Here
|
| 547 |
sub print_isbn { |
545 |
sub print_isbn { |
| 548 |
my($isbnfield) = @_; |
546 |
my($isbnfield) = @_; |
| 549 |
|
547 |
|
| 550 |
if ($isbnfield == undef ||length ($isbnfield->subfield('a')) == 0) { |
548 |
if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) { |
| 551 |
print "<marc>no isbn found (020\$a)\n" if $marcprint; |
549 |
print "<marc>no isbn found (020\$a)\r\n" if $marcprint; |
| 552 |
warn("no isbn found"); |
550 |
warn("no isbn found") if $marcprint; |
| 553 |
} |
551 |
} |
| 554 |
else { |
552 |
else { |
| 555 |
if (length ($isbnfield->subfield('a')) < 10) { |
553 |
if (length ($isbnfield->subfield('a')) < 10) { |
| 556 |
print "<marc>truncated isbn (020\$a)\n" if $marcprint; |
554 |
print "<marc>truncated isbn (020\$a)\r\n" if $marcprint; |
| 557 |
warn("truncated isbn"); |
555 |
warn("truncated isbn") if $marcprint; |
| 558 |
} |
556 |
} |
| 559 |
|
557 |
|
| 560 |
my $isbn = substr($isbnfield->subfield('a'), 0, 10); |
558 |
my $isbn = substr($isbnfield->subfield('a'), 0, 10); |
| 561 |
print "SN - ", &charconv($isbn), "\n"; |
559 |
print "SN - ", &charconv($isbn), "\r\n"; |
| 562 |
} |
560 |
} |
| 563 |
} |
561 |
} |
| 564 |
|
562 |
|
|
Lines 569-586
sub print_isbn {
Link Here
|
| 569 |
sub print_issn { |
567 |
sub print_issn { |
| 570 |
my($issnfield) = @_; |
568 |
my($issnfield) = @_; |
| 571 |
|
569 |
|
| 572 |
if ($issnfield == undef ||length ($issnfield->subfield('a')) == 0) { |
570 |
if (!$issnfield || length ($issnfield->subfield('a')) == 0) { |
| 573 |
print "<marc>no issn found (022\$a)\n" if $marcprint; |
571 |
print "<marc>no issn found (022\$a)\r\n" if $marcprint; |
| 574 |
warn("no issn found"); |
572 |
warn("no issn found") if $marcprint; |
| 575 |
} |
573 |
} |
| 576 |
else { |
574 |
else { |
| 577 |
if (length ($issnfield->subfield('a')) < 9) { |
575 |
if (length ($issnfield->subfield('a')) < 9) { |
| 578 |
print "<marc>truncated issn (022\$a)\n" if $marcprint; |
576 |
print "<marc>truncated issn (022\$a)\r\n" if $marcprint; |
| 579 |
warn("truncated issn"); |
577 |
warn("truncated issn") if $marcprint; |
| 580 |
} |
578 |
} |
| 581 |
|
579 |
|
| 582 |
my $issn = substr($issnfield->subfield('a'), 0, 9); |
580 |
my $issn = substr($issnfield->subfield('a'), 0, 9); |
| 583 |
print "SN - ", &charconv($issn), "\n"; |
581 |
print "SN - ", &charconv($issn), "\r\n"; |
| 584 |
} |
582 |
} |
| 585 |
} |
583 |
} |
| 586 |
|
584 |
|
|
Lines 591-602
sub print_issn {
Link Here
|
| 591 |
sub print_loc_callno { |
589 |
sub print_loc_callno { |
| 592 |
my($callnofield) = @_; |
590 |
my($callnofield) = @_; |
| 593 |
|
591 |
|
| 594 |
if ($callnofield == undef || length ($callnofield->subfield('a')) == 0) { |
592 |
if (!$callnofield || length ($callnofield->subfield('a')) == 0) { |
| 595 |
print "<marc>no LOC call number found (050\$a)\n" if $marcprint; |
593 |
print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint; |
| 596 |
warn("no LOC call number found"); |
594 |
warn("no LOC call number found") if $marcprint; |
| 597 |
} |
595 |
} |
| 598 |
else { |
596 |
else { |
| 599 |
print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\n"; |
597 |
print "AV - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\r\n"; |
| 600 |
} |
598 |
} |
| 601 |
} |
599 |
} |
| 602 |
|
600 |
|
|
Lines 607-618
sub print_loc_callno {
Link Here
|
| 607 |
sub print_dewey { |
605 |
sub print_dewey { |
| 608 |
my($deweyfield) = @_; |
606 |
my($deweyfield) = @_; |
| 609 |
|
607 |
|
| 610 |
if ($deweyfield == undef || length ($deweyfield->subfield('a')) == 0) { |
608 |
if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) { |
| 611 |
print "<marc>no Dewey number found (082\$a)\n" if $marcprint; |
609 |
print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint; |
| 612 |
warn("no Dewey number found"); |
610 |
warn("no Dewey number found") if $marcprint; |
| 613 |
} |
611 |
} |
| 614 |
else { |
612 |
else { |
| 615 |
print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\n"; |
613 |
print "U1 - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\r\n"; |
| 616 |
} |
614 |
} |
| 617 |
} |
615 |
} |
| 618 |
|
616 |
|
|
Lines 623-631
sub print_dewey {
Link Here
|
| 623 |
sub print_pubinfo { |
621 |
sub print_pubinfo { |
| 624 |
my($pubinfofield) = @_; |
622 |
my($pubinfofield) = @_; |
| 625 |
|
623 |
|
| 626 |
if ($pubinfofield == undef) { |
624 |
if (!$pubinfofield) { |
| 627 |
print "<marc>no publication information found (260)\n" if $marcprint; |
625 |
print "<marc>no publication information found (260)\r\n" if $marcprint; |
| 628 |
warn("no publication information found"); |
626 |
warn("no publication information found") if $marcprint; |
| 629 |
} |
627 |
} |
| 630 |
else { |
628 |
else { |
| 631 |
## the following information is available in MARC21: |
629 |
## the following information is available in MARC21: |
|
Lines 686-692
sub print_pubinfo {
Link Here
|
| 686 |
## a four-digit year and leave the rest as |
684 |
## a four-digit year and leave the rest as |
| 687 |
## "other info" |
685 |
## "other info" |
| 688 |
$protoyear = @$tuple[1]; |
686 |
$protoyear = @$tuple[1]; |
| 689 |
print "<marc>Year (260\$c): $protoyear\n" if $marcprint; |
687 |
print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint; |
| 690 |
|
688 |
|
| 691 |
## strip any separator chars at the end |
689 |
## strip any separator chars at the end |
| 692 |
$protoyear =~ s% *[\.;:/]*$%%; |
690 |
$protoyear =~ s% *[\.;:/]*$%%; |
|
Lines 708-723
sub print_pubinfo {
Link Here
|
| 708 |
} |
706 |
} |
| 709 |
else { |
707 |
else { |
| 710 |
## have no year info |
708 |
## have no year info |
| 711 |
print "<marc>no four-digit year found, use 0000\n" if $marcprint; |
709 |
print "<marc>no four-digit year found, use 0000\r\n" if $marcprint; |
| 712 |
$protoyear = "0000///$protoyear"; |
710 |
$protoyear = "0000///$protoyear"; |
| 713 |
warn("no four-digit year found, use 0000"); |
711 |
warn("no four-digit year found, use 0000") if $marcprint; |
| 714 |
} |
712 |
} |
| 715 |
|
713 |
|
| 716 |
if ($pycounter == 0 && length($protoyear)) { |
714 |
if ($pycounter == 0 && length($protoyear)) { |
| 717 |
print "PY - $protoyear\n"; |
715 |
print "PY - $protoyear\r\n"; |
| 718 |
} |
716 |
} |
| 719 |
elsif ($pycounter == 1 && length($_)) { |
717 |
elsif ($pycounter == 1 && length($_)) { |
| 720 |
print "Y2 - $protoyear\n"; |
718 |
print "Y2 - $protoyear\r\n"; |
| 721 |
} |
719 |
} |
| 722 |
## else: discard |
720 |
## else: discard |
| 723 |
} |
721 |
} |
|
Lines 726-735
sub print_pubinfo {
Link Here
|
| 726 |
|
724 |
|
| 727 |
## now dump the collected CY and PB lists |
725 |
## now dump the collected CY and PB lists |
| 728 |
if (@cities > 0) { |
726 |
if (@cities > 0) { |
| 729 |
print "CY - ", &charconv(join(", ", @cities)), "\n"; |
727 |
print "CY - ", &charconv(join(", ", @cities)), "\r\n"; |
| 730 |
} |
728 |
} |
| 731 |
if (@publishers > 0) { |
729 |
if (@publishers > 0) { |
| 732 |
print "PB - ", &charconv(join(", ", @publishers)), "\n"; |
730 |
print "PB - ", &charconv(join(", ", @publishers)), "\r\n"; |
| 733 |
} |
731 |
} |
| 734 |
} |
732 |
} |
| 735 |
} |
733 |
} |
|
Lines 751-757
sub get_keywords {
Link Here
|
| 751 |
if ($fieldname eq "600") { |
749 |
if ($fieldname eq "600") { |
| 752 |
my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); |
750 |
my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1')); |
| 753 |
${$href}{$val} += 1; |
751 |
${$href}{$val} += 1; |
| 754 |
print "<marc>Field $kwfield subfield a:", $kwfield->subfield('a'), "\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\n" if $marcprint; |
752 |
print "<marc>Field $kwfield subfield a:", $kwfield->subfield('a'), "\r\n<marc>Field $kwfield subfield b:", $kwfield->subfield('b'), "\r\n<marc>Field $kwfield subfield c:", $kwfield->subfield('c'), "\r\n" if $marcprint; |
| 755 |
} |
753 |
} |
| 756 |
else { |
754 |
else { |
| 757 |
## retrieve all available subfields |
755 |
## retrieve all available subfields |
|
Lines 768-774
sub get_keywords {
Link Here
|
| 768 |
if (length(@$kwtuple[1]) > 0) { |
766 |
if (length(@$kwtuple[1]) > 0) { |
| 769 |
## add to hash |
767 |
## add to hash |
| 770 |
${$href}{@$kwtuple[1]} += 1; |
768 |
${$href}{@$kwtuple[1]} += 1; |
| 771 |
print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\n" if $marcprint; |
769 |
print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint; |
| 772 |
} |
770 |
} |
| 773 |
## we can leave the subfields loop here |
771 |
## we can leave the subfields loop here |
| 774 |
last; |
772 |
last; |
|
Lines 880-886
sub pool_subx {
Link Here
|
| 880 |
## [0] contains subfield code |
878 |
## [0] contains subfield code |
| 881 |
if (@$notetuple[0] eq $subfield) { |
879 |
if (@$notetuple[0] eq $subfield) { |
| 882 |
## [1] contains value, remove trailing separators |
880 |
## [1] contains value, remove trailing separators |
| 883 |
print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\n" if $marcprint; |
881 |
print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint; |
| 884 |
@$notetuple[1] =~ s% *[,;.:/]*$%%; |
882 |
@$notetuple[1] =~ s% *[,;.:/]*$%%; |
| 885 |
if (length(@$notetuple[1]) > 0) { |
883 |
if (length(@$notetuple[1]) > 0) { |
| 886 |
## add to list |
884 |
## add to list |
|
Lines 914-920
sub print_abstract {
Link Here
|
| 914 |
if (length ($abfield->subfield($field)) > 0) { |
912 |
if (length ($abfield->subfield($field)) > 0) { |
| 915 |
my $ab = $abfield->subfield($field); |
913 |
my $ab = $abfield->subfield($field); |
| 916 |
|
914 |
|
| 917 |
print "<marc>field 520 subfield $field: $ab\n" if $marcprint; |
915 |
print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint; |
| 918 |
|
916 |
|
| 919 |
## strip trailing separators |
917 |
## strip trailing separators |
| 920 |
$ab =~ s% *[;,:./]*$%%; |
918 |
$ab =~ s% *[;,:./]*$%%; |
|
Lines 928-934
sub print_abstract {
Link Here
|
| 928 |
my $allabs = join "; ", @abstrings; |
926 |
my $allabs = join "; ", @abstrings; |
| 929 |
|
927 |
|
| 930 |
if (length($allabs) > 0) { |
928 |
if (length($allabs) > 0) { |
| 931 |
print "N2 - ", &charconv($allabs), "\n"; |
929 |
print "N2 - ", &charconv($allabs), "\r\n"; |
| 932 |
} |
930 |
} |
| 933 |
|
931 |
|
| 934 |
} |
932 |
} |
| 935 |
- |
|
|