#!/usr/athena/bin/perl require "getopts.pl"; &Getopts('hvf:'); if ($opt_h) { print " h Print this help information\n"; print " v Be extra verbose\n"; print " f File, use this file for input\n"; exit; } #### CONSTANTS #### $leadersize = 24; $tagsize = 3; $indicatorsize = 2; $eor = "\035"; # end of record marc $eot = "\036"; # end of tag (field) mark $sfd = "\037"; # subfield delimiter %transaction = ( '01', 'PRODUCE . . . . . . .', '02', 'UPDATE. . . . . . . .', '03', 'CANCEL. . . . . . . .', '11', 'REPLACE . . . . . . .', '50', 'ALL PRODUCE . . . . .', '90', 'OFFLINE RETRIEVE. . .', '92', 'OFFLINE UPDATE. . . .', '93', 'OFFLINE CANCEL UPDATE', '94', 'MICROCON UPDATE . . .', '78', 'Exported CD or ME . .', '65', 'Exported via PRISM. .', ); #### PARAMETERS #### #### SUBROUTINES #### sub getline { $thisline = defined($lookahead) ? $lookahead : ; line: while ($lookahead = ) { if ($lookahead =~ /^[ \t]/) { $lookahead =~ s/^[ \t]+/ /; $thisline =~ s/\n//g; $thisline .= $lookahead; $thisline =~ s/\s$//; } else { last line; } } # end of the line $thisline; } # end getline sub writemarc { defined($leader) || return; $data = ""; $directory = ""; $total = 0; foreach $line (@tag) { ($entry, $x, $indicators, $content) = unpack("a3 a1 a2 a*", $line); $content =~ s/\s*($sfd.)\s*/$1/g; $content = $indicators . $content . $eot; $length = length($content); $entry .= sprintf("%04d%05d",$length,$total); $directory .= $entry; $total += $length; $data .= $content; $opt_v && print "tag: $entry $content\n"; } # end of tags undef @tag; # so that we don't get extra data the next time around $data .= $eor; $total++; $directory .= $eot; $length = length($directory) + 24; $total += $length; ($x, $reclen, $lead1, $baseaddr, $lead2, $tcode, $lead3) = unpack("a4 a5 a7 a5 a5 a1 a1", $leader); TCODE: { if ($tcode == "P") { ($tcode = "\001"); last TCODE; } if ($tcode == "U") { ($tcode = "\002"); last TCODE; } if ($tcode == "C") { ($tcode = "\003"); last TCODE; } if ($tcode == "R") { ($tcode = "\021"); last TCODE; } } $leader = sprintf("%05d%s%05d%s%s%s", $total, $lead1, $length, $lead2, $tcode, $lead3 ); $opt_v && print "\n"; print "$leader$directory$data"; $opt_v && print "\n"; } # end writemarc #### MAIN PROGRAM #### if ($opt_f) { open(IN, "< $opt_f"); } else { open(IN, "-"); } #open(OUT, "> $output"); while ($_ = &getline()) { s/\n//g; CASE: { if (/^LDR /) { &writemarc(); $seq = 0; $leader = $_; last CASE; } if (/^\d\d\d /) { s/\|/$sfd/g; s/$sfd$sfd/\|/g; $tag[$seq++] = $_; last CASE; } $opt_v && print "ignoring: $_\n"; } } &writemarc();