Attachment #5231 for bug #6769

View | Details | Raw Unified | Return to bug 6769
Collapse All | Expand All





    my $marcflavour = C4::Context->preference("marcflavour");
    my $intype = lc($marcflavour);
    my $marcprint = 0; # Debug flag; disabled 240811 marcelr

    # Let's redirect stdout
    open my $oldout, ">&STDOUT";

	my $leader = $record->leader();
	if ($intype eq "marc21") {
	    if ($leader =~ /^.{9}a/) {
		print "<marc>---\r\n<marc>UTF-8 data\r\n" if $marcprint;
		$utf = 1;
	    }
	    else {
		print "<marc>---\r\n<marc>MARC-8 data\r\n" if $marcprint;
	    }
	}
	## else: other MARC formats do not specify the character encoding

	foreach my $field (@author_fields) {
	    if (length($field)) {
		my $author = &get_author($field);
		print "AU  - ",&charconv($author),"\r\n";
	    }
	}


	foreach my $field (@editor_fields) {
	    if (length($field)) {
		my $editor = &get_editor($field);
		print "ED  - ",&charconv($editor),"\r\n";
	    }
	}


	    &print_stitle($record->field('225'));
	}
	else { ## marc21, ukmarc
	    &print_stitle($record->field('490'));
	}

	## ISBN/ISSN

	## entry is the number of occurrences, but we're not really interested
	## in that and rather print the key
	while (my ($key, $value) = each %kwpool) {
	    print "KW  - ", &charconv($key), "\r\n";
	}

	## 5XX have various candidates for notes and abstracts. We pool

	my $allnotes = join "; ", @notepool;

	if (length($allnotes) > 0) {
	    print "N1  - ", &charconv($allnotes), "\r\n";
	}

	## 320/520 have the abstract

	}

	## end RIS dataset
	print "ER  - \r\n";

    # Let's re-redirect stdout
    close STDOUT;

## Returns: the value at leader position 06 
##********************************************************************
sub print_typetag {
  my ($leader)= @_;
    ## the keys of typehash are the allowed values at position 06
    ## of the leader of a MARC record, the values are the RIS types
    ## that might appropriately represent these types.

		);
    
    ## The type of a MARC record is found at position 06 of the leader
    my $typeofrecord = substr($leader, 6, 1);

    ## ToDo: for books, field 008 positions 24-27 might have a few more
    ## hints

    my %typehash;
    
    ## the ukmarc here is just a guess
    if ($intype eq "marc21" || $intype eq "ukmarc") {
	%typehash = %ustypehash;
    }
    elsif ($intype eq "unimarc") {
	%typehash = %unitypehash;
    }
    else {
	## assume MARC21 as default
	%typehash = %ustypehash;
    }

    if (!exists $typehash{$typeofrecord}) {
	print "TY  - BOOK\r\n"; ## most reasonable default
	warn ("no type found - assume BOOK") if $marcprint;
    }
    else {
	print "TY  - $typehash{$typeofrecord}\r\n";
    }

    ## use $typeofrecord as the return value, just in case


    if ($nametype == 0) {
	# ToDo: convert every input to Last[,(F.|First)[ (M.|Middle)[,Suffix]]]
	warn("name >>$rawauthora<< in direct order - leave as is") if $marcprint;
	return $rawauthora;
    }
    elsif ($nametype == 1) {

	$indicator = 1;
    }

    print "<marc>:Author(Ind$indicator): ", $authorfield->indicator("$indicator"),"\r\n" if $marcprint;
    print "<marc>:Author(\$a): ", $authorfield->subfield('a'),"\r\n" if $marcprint;
    print "<marc>:Author(\$b): ", $authorfield->subfield('b'),"\r\n" if $marcprint;
    print "<marc>:Author(\$c): ", $authorfield->subfield('c'),"\r\n" if $marcprint;
    print "<marc>:Author(\$h): ", $authorfield->subfield('h'),"\r\n" if $marcprint;
    if ($intype eq "ukmarc") {
	my $authorname = $authorfield->subfield('a') . "," . $authorfield->subfield('h');
	normalize_author($authorname, $authorfield->subfield('b'), $authorfield->subfield('c'), $authorfield->indicator("$indicator"));

sub get_editor {
    my ($editorfield) = @_;

    if (!$editorfield) {
	return;
    }
    else {
	print "<marc>Editor(\$a): ", $editorfield->subfield('a'),"\r\n" if $marcprint;
	print "<marc>Editor(\$b): ", $editorfield->subfield('b'),"\r\n" if $marcprint;
	print "<marc>editor(\$c): ", $editorfield->subfield('c'),"\r\n" if $marcprint;
	return $editorfield->subfield('a');
    }
}

##********************************************************************
sub print_title {
    my ($titlefield) = @_;
    if (!$titlefield) {
	print "<marc>empty title field (245)\r\n" if $marcprint;
	warn("empty title field (245)") if $marcprint;
	@_;
    }
    else {
	print "<marc>Title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
	print "<marc>Title(\$b): ",$titlefield->subfield('b'),"\r\n" if $marcprint;
	print "<marc>Title(\$c): ",$titlefield->subfield('c'),"\r\n" if $marcprint;
    
	## The title is usually written in a very odd notation. The title
	## proper ($a) often ends with a space followed by a separator like

	    if (length($clean_subtitle) > 0 && $intype ne "unimarc") {
		print ": ",&charconv($clean_subtitle);
	    }
	    print "\r\n";
	}

	## The statement of responsibility is just this: horrors. There is

	## be written and designated. The field is free-form and resistant
	## to all parsing efforts, so this information is lost on me
    }
}

##********************************************************************
## print_stitle(): prints info from series title field

sub print_stitle {
    my ($titlefield) = @_;

    if (!$titlefield) {
	print "<marc>empty series title field\r\n" if $marcprint;
	warn("empty series title field");
	@_;
    }
    else {
	print "<marc>Series title(\$a): ",$titlefield->subfield('a'),"\r\n" if $marcprint;
	my $clean_title = $titlefield->subfield('a');

	$clean_title =~ s% *[/:;.]$%%;

	if (length($clean_title) > 0) {
	    print "T2  - ", &charconv($clean_title),"\r\n";
	}

	if ($intype eq "unimarc") {
	    print "<marc>Series vol(\$v): ",$titlefield->subfield('v'),"\r\n" if $marcprint;
	    if (length($titlefield->subfield('v')) > 0) {
		print "VL  - ", &charconv($titlefield->subfield('v')),"\r\n";
	    }
	}
    }
}

##********************************************************************
## print_isbn(): gets info from MARC field 020

sub print_isbn {
    my($isbnfield) = @_;

    if (!$isbnfield || length ($isbnfield->subfield('a')) == 0) {
	print "<marc>no isbn found (020\$a)\r\n" if $marcprint;
	warn("no isbn found") if $marcprint;
    }
    else {
	if (length ($isbnfield->subfield('a')) < 10) {
	    print "<marc>truncated isbn (020\$a)\r\n" if $marcprint;
	    warn("truncated isbn") if $marcprint;
	}

	my $isbn = substr($isbnfield->subfield('a'), 0, 10);
	print "SN  - ", &charconv($isbn), "\r\n";
    }
}


sub print_issn {
    my($issnfield) = @_;

    if (!$issnfield || length ($issnfield->subfield('a')) == 0) {
	print "<marc>no issn found (022\$a)\r\n" if $marcprint;
	warn("no issn found") if $marcprint;
    }
    else {
	if (length ($issnfield->subfield('a')) < 9) {
	    print "<marc>truncated issn (022\$a)\r\n" if $marcprint;
	    warn("truncated issn") if $marcprint;
	}

	my $issn = substr($issnfield->subfield('a'), 0, 9);
	print "SN  - ", &charconv($issn), "\r\n";
    }
}


sub print_loc_callno {
    my($callnofield) = @_;

    if (!$callnofield || length ($callnofield->subfield('a')) == 0) {
	print "<marc>no LOC call number found (050\$a)\r\n" if $marcprint;
	warn("no LOC call number found") if $marcprint;
    }
    else {
	print "AV  - ", &charconv($callnofield->subfield('a')), " ", &charconv($callnofield->subfield('b')), "\r\n";
    }
}


sub print_dewey {
    my($deweyfield) = @_;

    if (!$deweyfield || length ($deweyfield->subfield('a')) == 0) {
	print "<marc>no Dewey number found (082\$a)\r\n" if $marcprint;
	warn("no Dewey number found") if $marcprint;
    }
    else {
	print "U1  - ", &charconv($deweyfield->subfield('a')), " ", &charconv($deweyfield->subfield('2')), "\r\n";
    }
}


sub print_pubinfo {
    my($pubinfofield) = @_;

    if (!$pubinfofield) {
	print "<marc>no publication information found (260)\r\n" if $marcprint;
	warn("no publication information found") if $marcprint;
    }
    else {
	## the following information is available in MARC21:

		## a four-digit year and leave the rest as
		## "other info"
		$protoyear = @$tuple[1];
		print "<marc>Year (260\$c): $protoyear\r\n" if $marcprint;

		## strip any separator chars at the end
		$protoyear =~ s% *[\.;:/]*$%%;

		}
		else {
		    ## have no year info
		    print "<marc>no four-digit year found, use 0000\r\n" if $marcprint;
		    $protoyear = "0000///$protoyear";
		    warn("no four-digit year found, use 0000") if $marcprint;
		}

		if ($pycounter == 0 && length($protoyear)) {
		    print "PY  - $protoyear\r\n";
		}
		elsif ($pycounter == 1 && length($_)) {
		    print "Y2  - $protoyear\r\n";
		}
		## else: discard
	    }


	## now dump the collected CY and PB lists
	if (@cities > 0) {
	    print "CY  - ", &charconv(join(", ", @cities)), "\r\n";
	}
	if (@publishers > 0) {
	    print "PB  - ", &charconv(join(", ", @publishers)), "\r\n";
	}
    }
}

	    if ($fieldname eq "600") {
		my $val = normalize_author($kwfield->subfield('a'), $kwfield->subfield('b'), $kwfield->subfield('c'), $kwfield->indicator('1'));
		${$href}{$val} += 1;
		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;
	    }
	    else {
		## retrieve all available subfields

			    if (length(@$kwtuple[1]) > 0) {
				## add to hash
				${$href}{@$kwtuple[1]} += 1;
				print "<marc>Field $fieldname subfield $subfield:", @$kwtuple[1], "\r\n" if $marcprint;
			    }
			    ## we can leave the subfields loop here
			    last;

		    ## [0] contains subfield code
		    if (@$notetuple[0] eq $subfield) {
			## [1] contains value, remove trailing separators
			print "<marc>field $fieldname subfield $subfield: ", @$notetuple[1], "\r\n" if $marcprint;
			@$notetuple[1] =~ s% *[,;.:/]*$%%;
			if (length(@$notetuple[1]) > 0) {
			    ## add to list

	    if (length ($abfield->subfield($field)) > 0) {
		my $ab = $abfield->subfield($field);

		print "<marc>field 520 subfield $field: $ab\r\n" if $marcprint;

		## strip trailing separators
		$ab =~ s% *[;,:./]*$%%;

    my $allabs = join "; ", @abstrings;

    if (length($allabs) > 0) {
	print "N2  - ", &charconv($allabs), "\r\n";
    }

}
- 

Return to bug 6769