#!perl package MARC::File::MARCMaker; =head1 NAME MARC::File::MARCMaker -- Work with MARCMaker/MARCBreaker records. =cut use strict; use integer; use vars qw( $VERSION $ERROR ); $VERSION = 0.05; use MARC::File; use vars qw( @ISA ); @ISA = qw( MARC::File ); use MARC::Record qw( LEADER_LEN ); use constant SUBFIELD_INDICATOR => "\x24"; #dollar sign use constant END_OF_FIELD => "\n\x3D"; #line break, equals sign =head1 SYNOPSIS use MARC::File::MARCMaker; my $file = MARC::File::MARCMaker->in( $filename ); while ( my $marc = $file->next() ) { # Do something } $file->close(); undef $file; #################################################### use MARC::File::MARCMaker; ## reading with MARC::Batch my $batch = MARC::Batch->new( 'MARCMaker', $filename ); my $record = $batch->next(); ## or reading with MARC::File::MARCMaker explicitly my $file = MARC::File::MARCMaker->in( $filename ); my $record = $file->next(); ## output a single MARC::Record object in MARCMaker format (formatted plain text) #print $record->as_marcmaker(); #goal syntax print MARC::File::MARCMaker->encode($record); #current syntax =head1 DESCRIPTION The MARC-File-MARCMaker distribution is an extension to the MARC-Record distribution for working with MARC21 data using the format used by the Library of Congress MARCMaker and MARCBreaker programs. More information may be obtained here: L You must have MARC::Record installed to use MARC::File::MARCMaker. In fact once you install the MARC-File-MARCMaker distribution you will most likely not use it directly, but will have an additional file format available to you when you use MARC::Batch. This module is based on code from the original MARC.pm module, as well as the MARC::Record distribution's MARC::File::USMARC and MARC::File::MicroLIF modules. =head2 DEVIATIONS FROM LC'S DOCUMENTATION LC's MARCMaker/MARCBreaker programs require files to have DOS line endings. This module should be capable of reading any type of line ending. It converts existing endings to "\n", the endings of the platform. Initial version may or may not work well with line breaks in the middle of a field. MARCMaker version of the LDR (record size bytes) will not necessarily be dependable, and should not be relied upon. =head1 EXPORT None. =head1 TODO Do limit tests in filling the buffer and getting chunks. Seems to work for first fill, but may fail on larger reads/multiple reads to fill the buffer. Test special characters (those requiring escapes). Initial version may not fully support non-English characters. All MARC-8 may work, Unicode support is untested and unassured. Implement better character encoding and decoding, including Unicode support. Work on character set internal subs for both input and output. Currently, the original subs from MARC.pm are being used essentially as-is. Error checking for line breaks vs. new fields? Probably not possible, since line breaks are allowed within fields, so checking for missing equals sign is not really possible. Account for multiple occurences of =LDR in a single record, usually caused by lack of blank line between records, so records get mushed together. Also check for multiple =001s. Determine why the constant SUBFIELD_INDICATOR can't be used in the split into subfields. Work on encode(). Allow as_marcmaker() to be called with either MARC::Field or MARC::Record objects, returning the appropriate result. Desired behavior is as_usmarc() methods in MARC::Record and MARC::Field Decode should mostly be working. Test for correctness. Remove unnecessary code and documentation, remnants of the initial development of the module. Move internal subs to end of module? =head1 VERSION HISTORY Version 0.05: First CPAN release, Oct. 30, 2005. Version 0.04: Updated Oct. 22, 2005. Released Oct. 23, 2005. -Initial commit to CVS on SourceForge -Misc. cleanup. Version 0.03: Updated Aug. 2, 2005. Released Aug. 14, 2005. -Revised decode() to fix problem with dollar sign conversion from mnemonics to characters. Version 0.02: Updated July 12-13, 2005. Released July 16, 2005. -Preliminary version of encode() for fields and records Version 0.01: Initial version, Nov. 21, 2004-Mar. 7, 2005. Released Mar. 7, 2005. -Basic version, translates .mrk format file into MARC::Record objects. =for internal ############################################################ This section is copied from MARC::File::MicroLIF. ############################################################ The buffer must be large enough to handle any valid record because we don't check for cases like a CR/LF pair or an end-of-record/CR/LF trio being only partially in the buffer. The max valid record is the max MARC record size (99999) plus one or two characters per tag (CR, LF, or CR/LF). It's hard to say what the max number of tags is, so here we use 6000. (6000 tags can be squeezed into a MARC record only if every tag has only one subfield containing a maximum of one character, or if data from multiple tags overlaps in the MARC record body. We're pretty safe.) =cut use constant BUFFER_MIN => (99999 + 6000 * 2); =head1 METHODS =cut ################################## ### START OF MARCMAKER METHODS ### ################################## =head2 _next (merged from MicroLIF and USMARC) Called by MARC::File::next(). =cut sub _next { #done for MARCMaker? my $self = shift; #_get_chunk will separate records from each other and should convert # line endings to those of the platform. my $makerrec = $self->_get_chunk(); # for ease, make sure the newlines match this platform $makerrec =~ s/[\x0d\x0a]+/\n/g if defined $makerrec; return $makerrec; } #_next =head2 decode( $string [, \&filter_func ] ) (description based on MARC::File::USMARC::decode POD information) Constructor for handling data from a MARCMaker file. This function takes care of all the tag directory parsing & mangling. Any warnings or coercions can be checked in the C function. The C<$filter_func> is an optional reference to a user-supplied function that determines on a tag-by-tag basis if you want the tag passed to it to be put into the MARC record. The function is passed the tag number and the raw tag data, and must return a boolean. The return of a true value tells MARC::File::MARCMaker::decode that the tag should get put into the resulting MARC record. For example, if you only want title and subject tags in your MARC record, try this: sub filter { my ($tagno,$tagdata) = @_; return ($tagno == 245) || ($tagno >= 600 && $tagno <= 699); } my $marc = MARC::File::MARCMaker->decode( $string, \&filter ); Why would you want to do such a thing? The big reason is that creating fields is processor-intensive, and if your program is doing read-only data analysis and needs to be as fast as possible, you can save time by not creating fields that you'll be ignoring anyway. Another possible use is if you're only interested in printing certain tags from the record, then you can filter them when you read from disc and not have to delete unwanted tags yourself. =cut sub decode { #MARCMaker my $text; my $location = ''; ## decode can be called in a variety of ways ## $object->decode( $string ) ## MARC::File::MARCMaker->decode( $string ) ## MARC::File::MARCMaker::decode( $string ) ## this bit of code covers all three my $self = shift; if ( ref($self) =~ /^MARC::File/ ) { $location = 'in record '.$self->{recnum}; $text = shift; } else { $location = 'in record 1'; $text = $self=~/MARC::File/ ? shift : $self; } my $filter_func = shift; # for ease, make the newlines match this platform # this has probably already been taken care of at least once, but just in case $text =~ s/[\x0d\x0a]+/\n/g if defined $text; my $marc = MARC::Record->new(); #report improperly passed $text (undefined $text) return $marc->_warn( "Unable to retrieve a record string $location" ) unless defined $text; ############################# #### Charset work needed #### ############################# #use default charset until that function is revised my $charset = usmarc_default(); ############################# ############################# #Split each record on the "\n=" into the @lines array my @lines=split END_OF_FIELD, $text; my $leader = shift @lines; unless ($leader =~ /^=LDR /) { $marc->_warn( "First line must begin with =LDR" ); } $leader=~s/^=LDR //; #Remove "=LDR " $leader=~s/[\n\r]//g; #remove line endings $leader=~s/\\/ /g; # substitute " " for \ #report error if result is not 24 bytes long unless (length($leader) == LEADER_LEN) { $marc->_warn( "Leader must be exactly 24 bytes long" ); } #add leader to the record $marc->leader( substr( $leader, 0, LEADER_LEN ) ); LINE: foreach my $line (@lines) { #Remove newlines from $line ; and also substitute " " for \ $line=~s/[\n\r]//g; $line=~s/\\/ /g; #get the tag name my $tagno = substr($line,0,3); # Check tag validity ( $tagno =~ /^[0-9A-Za-z]{3}$/ ) or $marc->_warn( "Invalid tag in $location: \"$tagno\"" ); if ( ($tagno =~ /^\d+$/ ) && ( $tagno < 10 ) ) { #translate characters for tag data #revise line below as needed for _maker2char my $tagdata = _maker2char ( substr( $line, 5 ), $charset ); #filter_func implementation needs work if ( $filter_func ) { next LINE unless $filter_func->( $tagno, $tagdata ); } #add field to record $marc->append_fields( MARC::Field->new( $tagno, $tagdata ) ); } #if $tagno < 10 else { #translate characters for subfield data #get indicators my $ind1 = substr( $line, 5, 1 ); my $ind2 = substr( $line, 6, 1 ); my $tagdata = substr( $line, 7 ); #report error if first character of tagdata is not a subfield indicator ($) $marc->_warn( "First character of subfield data must be a subfield indicator (dollar sign), $tagdata, $location for tag $tagno" ) unless ($tagdata =~ /^\$/ ); if ( $filter_func ) { next LINE unless $filter_func->( $tagno, $tagdata ); } #why doesn't SUBFIELD_INDICATOR work in the split? my @subfields_mnemonic = split( /\x24/, $tagdata ); #convert characters from mnemonics to characters my @subfields = map {_maker2char($_, $charset)} @subfields_mnemonic; #is there a better way to deal with the empty first item? my $empty = shift @subfields; $marc->_warn( "Subfield data appears before first subfield? $location in $tagno" ) if $empty; # Split the subfield data into subfield name and data pairs my @subfield_data; for ( @subfields ) { if ( length > 0 ) { push( @subfield_data, substr($_,0,1),substr($_,1) ); } else { $marc->_warn( "Entirely empty subfield found in tag $tagno" ); } } #for @subfields if ( !@subfield_data ) { $marc->_warn( "no subfield data found $location for tag $tagno" ); next; } my $field = MARC::Field->new($tagno, $ind1, $ind2, @subfield_data ); if ( $field->warnings() ) { $marc->_warn( $field->warnings() ); } $marc->append_fields( $field ); } } # looping through all the fields return $marc; } #decode MARCMaker =head2 update_leader() #from USMARC This may be unnecessary code. Delete this section if that is the case. If any changes get made to the MARC record, the first 5 bytes of the leader (the length) will be invalid. This function updates the leader with the correct length of the record as it would be if written out to a file. sub update_leader() { #from USMARC my $self = shift; my (undef,undef,$reclen,$baseaddress) = $self->_build_tag_directory(); $self->_set_leader_lengths( $reclen, $baseaddress ); } #updated_leader() from USMARC =head2 encode() #based on MARC::File::USMARC Returns a string of characters suitable for writing out to a MARCMaker file, including the leader, directory and all the fields. Uses as_marcmaker() below to build each field. =cut sub encode { #MARCMaker, based on USMARC's encode() my $marc = shift; $marc = shift if (ref($marc)||$marc) =~ /^MARC::File/; my $field_string = ''; #convert each field (after the leader) to MARCMaker format foreach my $field ($marc->fields()) { $field_string .= $field->MARC::File::MARCMaker::as_marcmaker(); } #foreach field in record # Glomp it all together return join("", "=LDR ", $marc->leader, "\n", $field_string, "\n"); } #encode from USMARC =head2 as_marcmaker() Based on MARC::Field::as_usmarc(). Turns a MARC::Field into a MARCMaker formatted field string. =head2 TODO (as_marcmaker()) -Change field encoding portion of as_marcmaker() to internal _as_marcmaker() -Implement as_marcmaker() as wrapper for MARC::Record object and MARC::Field object encoding into MARCMaker format. =cut sub as_marcmaker() { my $self = shift; # $self = shift if (ref($self)||$self) =~ /^MARC::File/; die "Wanted a MARC::Field but got a ", ref($self) unless ref($self) eq "MARC::Field"; my $charset = ustext_default(); # Tags < 010 are pretty easy if ( $self->is_control_field ) { #convert characters to MARCMaker codes my $field_data = (_char2maker($self->data(), $charset)); #swap blank spaces for backslash ( \ ) $field_data =~ s/ /\\/g; #return formatted field return sprintf "=%s %s\n", $self->tag(), $field_data; } #if control field elsif ($self->tag() eq '000') {print "Leader?\n"} #leader? else { my @subs; my @subdata = @{$self->{_subfields}}; while ( @subdata ) { #convert characters to MARCMaker codes as each subfield goes by push( @subs, join( "", SUBFIELD_INDICATOR, shift @subdata, (_char2maker(shift @subdata, $charset))) ); } # while my $ind1 = $self->indicator(1); my $ind2 = $self->indicator(2); #swap blank for backslash ( \ ) $ind1 =~ s/ /\\/g; $ind2 =~ s/ /\\/g; return join ("", "=", $self->tag(), " ", $ind1, $ind2, @subs, "\n", ); } } #as_usmarc() #MARC::Field #################################### ###### END USMARC subs ############# #################################### ######################################### ### begin internal subs from MicroLIF ### ######################################### ################################# # fill the buffer if we need to # ################################# sub _fill_buffer { #done for MARCMaker? my $self = shift; my $ok = 1; if ( !$self->{exhaustedfh} && length( $self->{inputbuf} ) < BUFFER_MIN ) { # append the next chunk of bytes to the buffer my $read = read $self->{fh}, $self->{inputbuf}, BUFFER_MIN, length($self->{inputbuf}); #convert line endings within the input buffer if ($self->{inputbuf} =~ /\x0d\x0a/s) { $self->{inputbuf} =~ s/\x0d\x0a/\n/sg; } #if DOS endings elsif ($self->{inputbuf} =~ /\x0a/) { $self->{inputbuf} =~ s/\x0a/\n/sg; } #elsif Unix endings elsif ($self->{inputbuf} =~ /\x0d/) { $self->{inputbuf} =~ s/\x0d/\n/sg; } #elsif Macintosh endings #remove extra blank lines between records $self->{inputbuf} =~ s/\n\s*\n+/\n\n/g; if ( !defined $read ) { # error! $ok = undef; $MARC::File::ERROR = "error reading from file " . $self->{filename}; } elsif ( $read < 1 ) { $self->{exhaustedfh} = 1; } } return $ok; } =for internal =head2 _get_chunk( ) #for MARCMaker Gets the next chunk of data (which should be a single complete record). All extra \r and \n are stripped and line endings are converted to those of the platform (\n). =cut sub _get_chunk { #done for MARCMaker? my $self = shift; my $chunk = undef; #read from the file and fill the input buffer if ( $self->_fill_buffer() && length($self->{inputbuf}) > 0 ) { #retrieve the next record ($chunk) = split /\n\n/, $self->{inputbuf}, 0; #remove the chunk and record separator from the input buffer $self->{inputbuf} = substr( $self->{inputbuf}, length($chunk)+length("\n\n") ); if ( !$chunk ) { $chunk = $self->{inputbuf}; $self->{inputbuf} = ''; $self->{exhaustedfh} = 1; } #if not chunk } #if buffer can be filled and has characters return $chunk; } #_get_chunk() =head2 _unget_chunk ( ) #done for MARCMaker? $chunk is put at the beginning of the buffer followed by two line endings ("\n\n") as a record separator. I don't know that this sub is necessary. =cut sub _unget_chunk { my $self = shift; my $chunk = shift; $self->{inputbuf} = $chunk . $self->{inputbuf}; return; } ####################################### ### End internal subs from MicroLIF ### ####################################### ####################################### ### Character handling from MARC.pm ### ####################################### =head2 _char2maker Pass in string of characters from a MARC record and a character map ($charset, or usmarc_default() by default). Returns string of characters encoded in MARCMaker format. (e.g. replaces '$' with {dollar}) =cut sub _char2maker { #deal with charmap default my @marc_string = split (//, shift); my $charmap = shift; #|| $charset; #add default value my $maker_string = join ('', map {${$charmap}{$_} } @marc_string); #replace html-style entities (´) with code in curly braces ({acute}) while ($maker_string =~ s/(&)([^ ]{1,7}?)(;)/{$2}/o) {} return $maker_string; } #_char2maker ###################### =head2 Default charset usmarc_default() -- Originally from MARC.pm. Offers default mnemonics for character encoding and decoding. Used by _maker2char. This perhaps should be an internal _usmarc_default(). =cut 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; } #usmarc_default ################################################### =head2 ustext_default ustext_default -- Originally from MARC.pm. Offers default mnemonics for character encoding and decoding. Used by _char2maker. This perhaps should be an internal _ustext_default(). =cut 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; } #ustext_default #################################################################### =head2 _maker2char default _maker2char() -- Translates MARCMaker encoded character into MARC-8 character. =cut 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; } ################################ ### END OF MARCMAKER METHODS ### ################################ 1; =head1 RELATED MODULES L L =head1 SEE ALSO L L for more information about the DOS-based MARCMaker and MARCBreaker programs. The methods in this MARCMaker module are based upon MARC::File::USMARC.pm and MARC::File::MicroLIF.pm. Those are distributed with MARC::Record. The underlying code is based on the MARCMaker-related methods in MARC.pm. =head1 LICENSE This code may be distributed under the same terms as Perl itself. Please note that this module is not a product of or supported by the employers of the various contributors to the code. =head1 AUTHOR Bryan Baldus eijabb@cpan.org Copyright (c) 2004-2005. =cut