MARC
view release on metacpan or search on metacpan
foreach my $word (@words) {
if (length($outline2) + length($word) < 66) {
$outline2 .= " $word";
}
else {
push @output2, $outline2;
$outline2 = " $word";
}
}
push @output2, $outline2;
}
}
my $breaker = join ($newline, @output2);
return $breaker;
}
sub _char2maker {
my @marc_string = split (//, shift);
my $charmap = shift;
my $maker_string = join ('', map { ${$charmap}{$_} } @marc_string);
while ($maker_string =~ s/(&)([^ ]{1,7}?)(;)/{$2}/o) {}
return $maker_string;
}
sub ustext_default {
my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
my %outchar = map {chr($_), sprintf ("{%2.2X}",int $_)} @hexchar;
my @ascchar = map {chr($_)} (0x20..0x23,0x25..0x7a,0x7c,0x7e);
foreach my $asc (@ascchar) { $outchar{$asc} = $asc; }
$outchar{chr(0x1b)} = '{esc}'; # escape
$outchar{chr(0x24)} = '{dollar}'; # dollar sign
$outchar{chr(0x5c)} = '{bsol}'; # back slash (reverse solidus)
$outchar{chr(0x7b)} = '{lcub}'; # opening curly brace
$outchar{chr(0x7d)} = '{rcub}'; # closing curly brace
$outchar{chr(0x8d)} = '{joiner}'; # zero width joiner
$outchar{chr(0x8e)} = '{nonjoin}'; # zero width non-joiner
$outchar{chr(0xa1)} = '{Lstrok}'; # latin capital letter l with stroke
$outchar{chr(0xa2)} = '{Ostrok}'; # latin capital letter o with stroke
$outchar{chr(0xa3)} = '{Dstrok}'; # latin capital letter d with stroke
$outchar{chr(0xa4)} = '{THORN}'; # latin capital letter thorn (icelandic)
$outchar{chr(0xa5)} = '{AElig}'; # latin capital letter AE
$outchar{chr(0xa6)} = '{OElig}'; # latin capital letter OE
$outchar{chr(0xa7)} = '{softsign}'; # modifier letter soft sign
$outchar{chr(0xa8)} = '{middot}'; # middle dot
$outchar{chr(0xa9)} = '{flat}'; # musical flat sign
$outchar{chr(0xaa)} = '{reg}'; # registered sign
$outchar{chr(0xab)} = '{plusmn}'; # plus-minus sign
$outchar{chr(0xac)} = '{Ohorn}'; # latin capital letter o with horn
$outchar{chr(0xad)} = '{Uhorn}'; # latin capital letter u with horn
$outchar{chr(0xae)} = '{mlrhring}'; # modifier letter right half ring (alif)
$outchar{chr(0xb0)} = '{mllhring}'; # modifier letter left half ring (ayn)
$outchar{chr(0xb1)} = '{lstrok}'; # latin small letter l with stroke
$outchar{chr(0xb2)} = '{ostrok}'; # latin small letter o with stroke
$outchar{chr(0xb3)} = '{dstrok}'; # latin small letter d with stroke
$outchar{chr(0xb4)} = '{thorn}'; # latin small letter thorn (icelandic)
$outchar{chr(0xb5)} = '{aelig}'; # latin small letter ae
$outchar{chr(0xb6)} = '{oelig}'; # latin small letter oe
$outchar{chr(0xb7)} = '{hardsign}'; # modifier letter hard sign
$outchar{chr(0xb8)} = '{inodot}'; # latin small letter dotless i
$outchar{chr(0xb9)} = '{pound}'; # pound sign
$outchar{chr(0xba)} = '{eth}'; # latin small letter eth
$outchar{chr(0xbc)} = '{ohorn}'; # latin small letter o with horn
$outchar{chr(0xbd)} = '{uhorn}'; # latin small letter u with horn
$outchar{chr(0xc0)} = '{deg}'; # degree sign
$outchar{chr(0xc1)} = '{scriptl}'; # latin small letter script l
$outchar{chr(0xc2)} = '{phono}'; # sound recording copyright
$outchar{chr(0xc3)} = '{copy}'; # copyright sign
$outchar{chr(0xc4)} = '{sharp}'; # sharp
$outchar{chr(0xc5)} = '{iquest}'; # inverted question mark
$outchar{chr(0xc6)} = '{iexcl}'; # inverted exclamation mark
$outchar{chr(0xe0)} = '{hooka}'; # combining hook above
$outchar{chr(0xe1)} = '{grave}'; # combining grave
$outchar{chr(0xe2)} = '{acute}'; # combining acute
$outchar{chr(0xe3)} = '{circ}'; # combining circumflex
$outchar{chr(0xe4)} = '{tilde}'; # combining tilde
$outchar{chr(0xe5)} = '{macr}'; # combining macron
$outchar{chr(0xe6)} = '{breve}'; # combining breve
$outchar{chr(0xe7)} = '{dot}'; # combining dot above
$outchar{chr(0xe8)} = '{uml}'; # combining diaeresis (umlaut)
$outchar{chr(0xe9)} = '{caron}'; # combining hacek
$outchar{chr(0xea)} = '{ring}'; # combining ring above
$outchar{chr(0xeb)} = '{llig}'; # combining ligature left half
$outchar{chr(0xec)} = '{rlig}'; # combining ligature right half
$outchar{chr(0xed)} = '{rcommaa}'; # combining comma above right
$outchar{chr(0xee)} = '{dblac}'; # combining double acute
$outchar{chr(0xef)} = '{candra}'; # combining candrabindu
$outchar{chr(0xf0)} = '{cedil}'; # combining cedilla
$outchar{chr(0xf1)} = '{ogon}'; # combining ogonek
$outchar{chr(0xf2)} = '{dotb}'; # combining dot below
$outchar{chr(0xf3)} = '{dbldotb}'; # combining double dot below
$outchar{chr(0xf4)} = '{ringb}'; # combining ring below
$outchar{chr(0xf5)} = '{dblunder}'; # combining double underscore
$outchar{chr(0xf6)} = '{under}'; # combining underscore
$outchar{chr(0xf7)} = '{commab}'; # combining comma below
$outchar{chr(0xf8)} = '{rcedil}'; # combining right cedilla
$outchar{chr(0xf9)} = '{breveb}'; # combining breve below
$outchar{chr(0xfa)} = '{ldbltil}'; # combining double tilde left half
$outchar{chr(0xfb)} = '{rdbltil}'; # combining double tilde right half
$outchar{chr(0xfe)} = '{commaa}'; # combining comma above
if ($MARC::DEBUG) {
foreach my $num (sort keys %outchar) {
printf "%x = %s\n", ord($num), $outchar{$num};
}
}
return \%outchar;
}
####################################################################
# _marc2html takes a MARC object as its input and converts it into #
# HTML. It is possible to specify which field you want to output #
# as well as field labels to be used instead of the MARC codes. #
# The HTML is returned as a string #
####################################################################
sub _marc2html { # rec
my $marcrec = shift;
my $args = shift;
my $newline = $args->{'lineterm'} || "\n";
my $output = "";
} #end parsing subfields
} #end tag>10
print "DEBUG: tag = $tag\n" if $MARC::DEBUG;
push @{$rec->{'array'}},\@field;
$rec -> add_map(\@field);
} #end reading this line
return ($rec,1);
} #end reading this record
sub _maker2char { # rec
my $marc_string = shift;
my $charmap = shift;
while ($marc_string =~ /{(\w{1,8}?)}/o) {
if (exists ${$charmap}{$1}) {
$marc_string = join ('', $`, ${$charmap}{$1}, $');
}
else {
$marc_string = join ('', $`, '&', $1, ';', $');
}
}
# closing curly brace - part 2, permits {lcub}text{rcub} in input
$marc_string =~ s/\}/\x7d/go;
return $marc_string;
}
sub usmarc_default { # rec
my @hexchar = (0x00..0x1a,0x1c,0x7f..0x8c,0x8f..0xa0,0xaf,0xbb,
0xbe,0xbf,0xc7..0xdf,0xfc,0xfd,0xff);
my %inchar = map {sprintf ("%2.2X",int $_), chr($_)} @hexchar;
$inchar{esc} = chr(0x1b); # escape
$inchar{dollar} = chr(0x24); # dollar sign
$inchar{curren} = chr(0x24); # dollar sign - alternate
$inchar{24} = chr(0x24); # dollar sign - alternate
$inchar{bsol} = chr(0x5c); # back slash (reverse solidus)
$inchar{lcub} = chr(0x7b); # opening curly brace
$inchar{rcub} = "}"; # closing curly brace - part 1
$inchar{joiner} = chr(0x8d); # zero width joiner
$inchar{nonjoin} = chr(0x8e); # zero width non-joiner
$inchar{Lstrok} = chr(0xa1); # latin capital letter l with stroke
$inchar{Ostrok} = chr(0xa2); # latin capital letter o with stroke
$inchar{Dstrok} = chr(0xa3); # latin capital letter d with stroke
$inchar{THORN} = chr(0xa4); # latin capital letter thorn (icelandic)
$inchar{AElig} = chr(0xa5); # latin capital letter AE
$inchar{OElig} = chr(0xa6); # latin capital letter OE
$inchar{softsign} = chr(0xa7); # modifier letter soft sign
$inchar{middot} = chr(0xa8); # middle dot
$inchar{flat} = chr(0xa9); # musical flat sign
$inchar{reg} = chr(0xaa); # registered sign
$inchar{plusmn} = chr(0xab); # plus-minus sign
$inchar{Ohorn} = chr(0xac); # latin capital letter o with horn
$inchar{Uhorn} = chr(0xad); # latin capital letter u with horn
$inchar{mlrhring} = chr(0xae); # modifier letter right half ring (alif)
$inchar{mllhring} = chr(0xb0); # modifier letter left half ring (ayn)
$inchar{lstrok} = chr(0xb1); # latin small letter l with stroke
$inchar{ostrok} = chr(0xb2); # latin small letter o with stroke
$inchar{dstrok} = chr(0xb3); # latin small letter d with stroke
$inchar{thorn} = chr(0xb4); # latin small letter thorn (icelandic)
$inchar{aelig} = chr(0xb5); # latin small letter ae
$inchar{oelig} = chr(0xb6); # latin small letter oe
$inchar{hardsign} = chr(0xb7); # modifier letter hard sign
$inchar{inodot} = chr(0xb8); # latin small letter dotless i
$inchar{pound} = chr(0xb9); # pound sign
$inchar{eth} = chr(0xba); # latin small letter eth
$inchar{ohorn} = chr(0xbc); # latin small letter o with horn
$inchar{uhorn} = chr(0xbd); # latin small letter u with horn
$inchar{deg} = chr(0xc0); # degree sign
$inchar{scriptl} = chr(0xc1); # latin small letter script l
$inchar{phono} = chr(0xc2); # sound recording copyright
$inchar{copy} = chr(0xc3); # copyright sign
$inchar{sharp} = chr(0xc4); # sharp
$inchar{iquest} = chr(0xc5); # inverted question mark
$inchar{iexcl} = chr(0xc6); # inverted exclamation mark
$inchar{hooka} = chr(0xe0); # combining hook above
$inchar{grave} = chr(0xe1); # combining grave
$inchar{acute} = chr(0xe2); # combining acute
$inchar{circ} = chr(0xe3); # combining circumflex
$inchar{tilde} = chr(0xe4); # combining tilde
$inchar{macr} = chr(0xe5); # combining macron
$inchar{breve} = chr(0xe6); # combining breve
$inchar{dot} = chr(0xe7); # combining dot above
$inchar{diaer} = chr(0xe8); # combining diaeresis
$inchar{uml} = chr(0xe8); # combining umlaut
$inchar{caron} = chr(0xe9); # combining hacek
$inchar{ring} = chr(0xea); # combining ring above
$inchar{llig} = chr(0xeb); # combining ligature left half
$inchar{rlig} = chr(0xec); # combining ligature right half
$inchar{rcommaa} = chr(0xed); # combining comma above right
$inchar{dblac} = chr(0xee); # combining double acute
$inchar{candra} = chr(0xef); # combining candrabindu
$inchar{cedil} = chr(0xf0); # combining cedilla
$inchar{ogon} = chr(0xf1); # combining ogonek
$inchar{dotb} = chr(0xf2); # combining dot below
$inchar{dbldotb} = chr(0xf3); # combining double dot below
$inchar{ringb} = chr(0xf4); # combining ring below
$inchar{dblunder} = chr(0xf5); # combining double underscore
$inchar{under} = chr(0xf6); # combining underscore
$inchar{commab} = chr(0xf7); # combining comma below
$inchar{rcedil} = chr(0xf8); # combining right cedilla
$inchar{breveb} = chr(0xf9); # combining breve below
$inchar{ldbltil} = chr(0xfa); # combining double tilde left half
$inchar{rdbltil} = chr(0xfb); # combining double tilde right half
$inchar{commaa} = chr(0xfe); # combining comma above
if ($MARC::DEBUG) {
foreach my $str (sort keys %inchar) {
printf "%s = %x\n", $str, ord($inchar{$str});
}
}
return \%inchar;
}
####################################################################
# updatefirst() takes a template, a request to rebuild the index, and
# an array from $marc->[recnum]{array}. It replaces/creates the field
# data for a first match, using the template, and leaves the rest
# alone. If the template has a subfield element, (this includes
# indicators) it ignores all other information in the array and only
# updates/creates based on the subfield information in the array. If
# the template has no subfield information then indicators are left
# untouched unless a new field needs to be created, in which case they
( run in 0.565 second using v1.01-cache-2.11-cpan-71847e10f99 )