<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/l/local/bin/perl

#
#
# added better character support (borrowed from MARC.pm), 20000815, jpw

$count = "0";

# Set input file from command line or from default

if ( $#ARGV &gt;= 0 )
   { $inputfile = $ARGV[0]; }
else
   { $inputfile = "records.marc"; }

open (NOTIS, $inputfile) or die "ERROR: Unable to open input file --";

# grab all the notis ids/ root paths extents and titles from the moa lists

while (&lt;NOTIS&gt;) {
        chop;
        
	local ($notis, $root, $pageextent, $moatitle)= split (/\|\|\|/, $_);
        
	$EXTENT{$notis} =$pageextent;
	$MOATITLE{$notis} = $moatitle;
	

}

#been running this on each separate file
$/ = "\035";
$field = "\036";
$subfield = "\037";

$index = 0;


while (&lt;&gt;) {

    chomp;

    my(%record);

    $record{'leader'} = substr($_, 0, 24);
    $record{'logical_record_length'} = substr($record{'leader'}, 0, 5);
    $record{'record_status'} = substr($record{'leader'}, 5, 1);
    $record{'type_of_record'} = substr($record{'leader'}, 6, 1);
    $record{'bibliographic_level'} = substr($record{'leader'}, 7, 1);
    $record{'type_of_control'} = substr($record{'leader'}, 8, 1);
    $record{'undefined'} = substr($record{'leader'}, 9, 1);
    $record{'indicator_count'} = substr($record{'leader'}, 10, 1);
    $record{'subfield_code_count'} = substr($record{'leader'}, 11, 1);
    $record{'base_address_of_data'} = substr($record{'leader'}, 12, 5);
    $record{'encoding_level'} = substr($record{'leader'}, 17, 1);
    $record{'descriptive_cataloging_form'} = substr($record{'leader'}, 18, 1);
    $record{'linked_record_requirement'} = substr($record{'leader'}, 19, 1);
    $record{'entry_map'} = substr($record{'leader'}, 20, 4);
    ## entry_map is more complicated by the standard, but apparently
    ## only ever holds default values so far...

    $record{'all_data'} = substr($_, $record{'base_address_of_data'});

    substr($_, 0, 24) = '';

    while ($_ =~ s,^(\d{12}),,) {
	my($entry) = $1;
	my($tag) = substr($entry, 0, 3);

        #this accomodates that fact that sometimes there are multiples of a single field

	foreach $oldtag (sort(keys (%record))) {
	    if ($tag eq $oldtag) {
		$tag="$tag" . "a";

	    }
	}
	my($field_length) = substr($entry, 3, 4);
	my($fl) = $field_length;
	$fl =~ s,^0+,,;
	my($starting_character_position) = substr($entry, 7, 5);
	my($scp) = $starting_character_position;
	$scp =~ s,^0+,,;
	$record{"$tag"}{"field_length"} = $field_length;
	$record{"$tag"}{"starting_character_position"} = 
	    $starting_character_position;
	$record{"$tag"}{"data"} = substr($record{'all_data'}, $scp, $fl);
	$record{"$tag"}{"data"} =~ s,$field,,;
# jpw       if (! ($tag =~ m,(260),) )
# jpw          { $record{"$tag"}{"data"} =~ s,$subfield([b-z]), ; ,g; }
        $record{"$tag"}{"data"} =~ s,$subfield(\w),|lesssubtag|M.\u$1|moresubtag|,g;
    }

    foreach $field (sort(keys (%record))) {


 	if ($field =~ m,(^\d{3}$|^\d{3}\w+$),) {

	    $inform = "$record{$field}{'data'}";
	    $inform =~ s,\&amp;,\&amp;amp;,g;
	    $inform =~ s,&lt;,\&amp;lt\;,g;
	    $inform =~ s,&gt;,\&amp;gt\;,g;
	    $inform =~ s,\|lesssubtag\|,&lt;,g;
	    $inform =~ s,\|moresubtag\|,&gt;,g;
	    $inform =~ s,&lt;(M.\w)&gt;([^&lt;]*),&lt;$1&gt;$2&lt;/$1&gt;,g;
	    $inform =~ s,&lt;(M.\w)&gt;([^&lt;]*)$,&lt;$1&gt;$2&lt;/$1&gt;,g;
	    $inform =~ s,^\s+,,g;
	    $inform =~ s,^\d+\s?&lt;,&lt;,g;
	    $inform =~ s,^\d+\?\s?&lt;,&lt;,g;
	    $inform =~ s,^\?+\s?&lt;,&lt;,g;
            
# jpw            if (!($field =~ m,(260),)) {
# jpw               $inform =~ s,&lt;M.A&gt;,,g;
# jpw               $inform =~ s,&lt;/M.A&gt;,,g;
# jpw            }
            $inform =~ s,&lt;M.[0-9]&gt;[^&lt;]*&lt;/M.[0-9]&gt;,,g;
	    
	$inform =~ s,\x1b,\&amp;esc;,g;	# escape
	$inform =~ s,\x24,\&amp;dollar;,g;	# dollar sign
	$inform =~ s,\x5c,\&amp;bsol;,g;	# back slash (reverse solidus)
	$inform =~ s,\x7b,\&amp;lcub;,g;	# opening curly brace
	$inform =~ s,\x7d,\&amp;rcub;,g;	# closing curly brace
	$inform =~ s,\x8d,\&amp;joiner;,g;	# zero width joiner
	$inform =~ s,\x8e,\&amp;nonjoin;,g;	# zero width non-joiner
	$inform =~ s,\xa1,\&amp;Lstrok;,g;	# latin capital letter l with stroke
	$inform =~ s,\xa2,\&amp;Ostrok;,g;	# latin capital letter o with stroke
	$inform =~ s,\xa3,\&amp;Dstrok;,g;	# latin capital letter d with stroke
	$inform =~ s,\xa4,\&amp;THORN;,g;	# latin capital letter thorn (icelandic)
	$inform =~ s,\xa5,\&amp;AElig;,g;	# latin capital letter AE
	$inform =~ s,\xa6,\&amp;OElig;,g;	# latin capital letter OE
	$inform =~ s,\xa7,\&amp;softsign;,g;	# modifier letter soft sign
	$inform =~ s,\xa8,\&amp;middot;,g;	# middle dot
	$inform =~ s,\xa9,\&amp;flat;,g;	# musical flat sign
	$inform =~ s,\xaa,\&amp;reg;,g;	# registered sign
	$inform =~ s,\xab,\&amp;plusmn;,g;	# plus-minus sign
	$inform =~ s,\xac,\&amp;Ohorn;,g;	# latin capital letter o with horn
	$inform =~ s,\xad,\&amp;Uhorn;,g;	# latin capital letter u with horn
	$inform =~ s,\xae,\&amp;mlrhring;,g;	# modifier letter right half ring (alif)
	$inform =~ s,\xb0,\&amp;mllhring;,g;	# modifier letter left half ring (ayn)
	$inform =~ s,\xb1,\&amp;lstrok;,g;	# latin small letter l with stroke
	$inform =~ s,\xb2,\&amp;ostrok;,g;	# latin small letter o with stroke
	$inform =~ s,\xb3,\&amp;dstrok;,g;	# latin small letter d with stroke
	$inform =~ s,\xb4,\&amp;thorn;,g;	# latin small letter thorn (icelandic)
	$inform =~ s,\xb5,\&amp;aelig;,g;	# latin small letter ae
	$inform =~ s,\xb6,\&amp;oelig;,g;	# latin small letter oe
	$inform =~ s,\xb7,\&amp;hardsign;,g;	# modifier letter hard sign
	$inform =~ s,\xb8,\&amp;inodot;,g;	# latin small letter dotless i
	$inform =~ s,\xb9,\&amp;pound;,g;	# pound sign
	$inform =~ s,\xba,\&amp;eth;,g;	# latin small letter eth
	$inform =~ s,\xbc,\&amp;ohorn;,g;	# latin small letter o with horn
	$inform =~ s,\xbd,\&amp;uhorn;,g;	# latin small letter u with horn
	$inform =~ s,\xc0,\&amp;deg;,g;	# degree sign
	$inform =~ s,\xc1,\&amp;scriptl;,g;	# latin small letter script l
	$inform =~ s,\xc2,\&amp;phono;,g;	# sound recording copyright
	$inform =~ s,\xc3,\&amp;copy;,g;	# copyright sign
	$inform =~ s,\xc4,\&amp;sharp;,g;	# sharp
	$inform =~ s,\xc5,\&amp;iquest;,g;	# inverted question mark
	$inform =~ s,\xc6,\&amp;iexcl;,g;	# inverted exclamation mark
	$inform =~ s,\xe0(.),\&amp;$1hooka;,g;	# combining hook above
	$inform =~ s,\xe1(.),\&amp;$1grave;,g;	# combining grave
	$inform =~ s,\xe2(.),\&amp;$1acute;,g;	# combining acute
	$inform =~ s,\xe3(.),\&amp;$1circ;,g;	# combining circumflex
	$inform =~ s,\xe4(.),\&amp;$1tilde;,g;	# combining tilde
	$inform =~ s,\xe5(.),\&amp;$1macr;,g;	# combining macron
	$inform =~ s,\xe6(.),\&amp;$1breve;,g;	# combining breve
	$inform =~ s,\xe7(.),\&amp;$1dot;,g;	# combining dot above
	$inform =~ s,\xe8(.),\&amp;$1uml;,g;	# combining diaeresis (umlaut)
	$inform =~ s,\xe9(.),\&amp;$1caron;,g;	# combining hacek
	$inform =~ s,\xea(.),\&amp;$1ring;,g;	# combining ring above
	$inform =~ s,\xeb(.),\&amp;$1llig;,g;	# combining ligature left half
	$inform =~ s,\xec(.),\&amp;$1rlig;,g;	# combining ligature right half
	$inform =~ s,\xed(.),\&amp;$1rcommaa;,g;	# combining comma above right
	$inform =~ s,\xee(.),\&amp;$1dblac;,g;	# combining double acute
	$inform =~ s,\xef(.),\&amp;$1candra;,g;	# combining candrabindu
	$inform =~ s,\xf0(.),\&amp;$1cedil;,g;	# combining cedilla
	$inform =~ s,\xf1(.),\&amp;$1ogon;,g;	# combining ogonek
	$inform =~ s,\xf2(.),\&amp;$1dotb;,g;	# combining dot below
	$inform =~ s,\xf3(.),\&amp;$1dbldotb;,g;	# combining double dot below
	$inform =~ s,\xf4(.),\&amp;$1ringb;,g;	# combining ring below
	$inform =~ s,\xf5(.),\&amp;$1dblunder;,g;	# combining double underscore
	$inform =~ s,\xf6(.),\&amp;$1under;,g;	# combining underscore
	$inform =~ s,\xf7(.),\&amp;$1commab;,g;	# combining comma below
	$inform =~ s,\xf8(.),\&amp;$1rcedil;,g;	# combining right cedilla
	$inform =~ s,\xf9(.),\&amp;$1breveb;,g;	# combining breve below
	$inform =~ s,\xfa(.),\&amp;$1ldbltil;,g;	# combining double tilde left half
	$inform =~ s,\xfb(.),\&amp;$1rdbltil;,g;	# combining double tilde right half
	$inform =~ s,\xfe(.),\&amp;$1commaa;,g;	# combining comma above
# JPW's additions
	$inform =~ s,\xd4,&lt;sub&gt;4&lt;/sub&gt;,g;	# subscript 4
	$inform =~ s,\xd2,&lt;sub&gt;2&lt;/sub&gt;,g;	# subscript 2
	$inform =~ s,\xb0,\&amp;lsquo\;,g;	# left single quote
	$inform =~ s,\xae,\&amp;rsquo\;,g;	# right single quote
	$inform =~ s,\xca,+,g;	# from Liz's work
	    if ($field =~ m,245,) {
		push @titles, $inform;
	    }

# uncomment this and the pressing out of SGML if a Media Union title
            elsif ($field =~ m,035,) {
               push @dlpsID, $inform;
            }
            elsif ($field =~ m,099,) {
               push @mu_callnum, $inform;
            }

	    elsif ($field =~ m,(111|210|211|212|214|222|240|242|243|246|247),) {
		push @othernotes, $inform;

	    }
	    elsif  ($field =~ m,(100|110|130),) {
		push @author, $inform;
   	    }	
	    elsif ($field =~ m,(250|254|255|256|257|261|262|263|265),) {
		$inform ="$field--$inform";
		push @imprint, $inform;

	    }
            elsif ($field =~ m,(260),) {
		push @pubstmt, $inform;
	    }            
	    elsif ($field =~ m,(300|305|306|310|315|321|340|350|351|355|357|362),) {
		 push @extent, $inform;
            }
	    elsif ($field =~ m,(400|410|411|440|490),){
		push @series, $inform;
	    }
	    elsif ($field =~ m,^5,) {
		push @notes, $inform;

	    }
	    elsif ($field =~ m,(^6|830|810),) {
		push @subjects, $inform;

	    }
	    elsif ($field =~ m,^7,) {
		push @addentries, $inform;

	    }			# 
	    elsif ($field =~ m,^9,) {
		if (not $field =~ m,998,) {
		    push @XXentries, $inform;

	    }
        }
     }  
    }
	
	$notisid = $record{'001'}{'data'};
	$notisid =~ s,^UL,,;
	$notisid =~ s,\s,,g;
	if (-e "sgmlout/$notisid.bib") {
	    print "$notisid duplicate\n";
	}

	$digextent = $EXTENT{$notisid};
	$comtitle = $MOATITLE{$notisid};
	$count ++;
        
        &amp;CreateTei;
}

    print $count;

    
sub CreateTei {
    $sgmfile = "sgmlout/$notisid.bib";
    my $now = `date +"%Y-%m-%d"`; chop $now;

    open (SGMDOC, "&gt;$sgmfile") or die "ERROR: Unable to open output file --";
    print SGMDOC (qq{&lt;A ID="$notisid" DT="$now"&gt;});

    print SGMDOC (qq{&lt;B&gt;});
    print SGMDOC (qq{&lt;K&gt;});
    if (@titles) {
	foreach $item (@titles) {
            $item =~ s,&lt;M.A&gt;,,g;
            $item =~ s,&lt;/M.A&gt;,,g;
            $item =~ s,&lt;M.B&gt;, ,g;
            $item =~ s,&lt;/M.B&gt;,,g;
            $item =~ s,&lt;M.C&gt;, / ,g;
            $item =~ s,&lt;/M.C&gt;,,g;
	    $item =~ s,&lt;M..&gt;, ,g;
	    $item =~ s,&lt;/M..&gt;,,g;
            print SGMDOC $item;
	}
	print SGMDOC (qq{&lt;/K&gt;});
    }	



    if (@author) {
	foreach $item (@author) {
	    print SGMDOC (qq{&lt;L&gt;});
            $item =~ s,&lt;M.A&gt;,,g;
            $item =~ s,&lt;/M.A&gt;,,g;
            $item =~ s,&lt;M.Q&gt;, ,g;
            $item =~ s,&lt;/M.Q&gt;,,g;
            $item =~ s,&lt;M..&gt;, ,g;
            $item =~ s,&lt;/M..&gt;,,g;
            print SGMDOC $item;
	    print SGMDOC (qq{&lt;/L&gt;});
	}
    }


    print SGMDOC (qq{&lt;/B&gt;});

    if (@extent) {
	foreach $item (@extent) {
            $item =~ s,&lt;M.A&gt;,,g;
            $item =~ s,&lt;M..&gt;, ; ,g;
            $item =~ s,&lt;/M..&gt;,,g;
	    $item = '&lt;D&gt;' . $item . '&lt;/D&gt;';
            print SGMDOC $item;
	}
    }

# not sure what we're losing here, but possibly edition statements. check with Jackie
# jpw, 20 Dec. 1999
#      if (@imprint) {
#          $typeitem = $item;
#          $typeitem =~ s,^([\d]{3})--.*,$1,;
#          $item =~ s,^[\d]{3}--(.*)$,$1,;
#          print SGMDOC (qq{&lt;AG&gt;});
#          print SGMDOC ($item);
#          print SGMDOC (qq{&lt;/AG&gt;});
#      }

    print SGMDOC (qq{&lt;E&gt;});
    
    if (@pubstmt) {
       foreach $item (@pubstmt) {
           $item =~ s,&lt;M.A&gt;,&lt;U&gt;,g;
           $item =~ s,&lt;/M.A&gt;,&lt;/U&gt;,g;
           $item =~ s,&lt;M.B&gt;,&lt;T&gt;,g;
           $item =~ s,&lt;/M.B&gt;,&lt;/T&gt;,g;
           $item =~ s,&lt;M.C&gt;,&lt;YR&gt;,g;
           $item =~ s,&lt;/M.C&gt;,&lt;/YR&gt;,g;
           $item =~ s,&lt;M.D&gt;,&lt;U&gt;,g;
	   $item =~ s,&lt;/M.D&gt;,&lt;/U&gt;,g;
	   $item =~ s,&lt;M.E&gt;,&lt;U&gt;,g;
	   $item =~ s,&lt;/M.E&gt;,&lt;/U&gt;,g;
	   $item =~ s,&lt;M.F&gt;,&lt;T&gt;,g;
	   $item =~ s,&lt;/M.F&gt;,&lt;/T&gt;,g;
	   $item =~ s,&lt;M.G&gt;,&lt;YR&gt;,g;
	   $item =~ s,&lt;/M.G&gt;,&lt;/YR&gt;,g;
           print SGMDOC $item;
       }    
    }
    
    if (@dlpsID) {
	print SGMDOC (qq{&lt;W A="DLPSID"&gt;});
	foreach $item (@dlpsID) {
	    $item =~ s,\(OCoLC\)[^\(]*,,g;
	    $item =~ s,&lt;M.A&gt;,,g;
	    $item =~ s,&lt;/M.A&gt;,,g;
	    $item =~ s,\(DAAP\)ch,,g;
	    $item =~ s,\(AMPO\)chd,,g;
	    $item =~ s,\(EVD\)chd,,g;
	    $item =~ s, *,,g;
	    print SGMDOC $item;
	}
	print SGMDOC (qq{&lt;/W&gt;});
    }
#    print SGMDOC (qq{&lt;W A="NOTIS"&gt;$notisid&lt;/W&gt;});
#    print SGMDOC (qq{&lt;W A="CALLNO"&gt;@mu_callnum&lt;/W&gt;});


    print SGMDOC (qq{&lt;X&gt;Publicly accessible text for non-commercial applications.&lt;/X&gt;});
    print SGMDOC (qq{&lt;/E&gt;});

 if (@series) {
	print SGMDOC (qq{&lt;F&gt;});
    print SGMDOC (qq{&lt;K&gt;});
    if (@titles) {
	foreach $item (@titles) {
            $item =~ s,&lt;M.A&gt;,,g;
            $item =~ s,&lt;/M.A&gt;,,g;
            $item =~ s,&lt;M.B&gt;, ,g;
            $item =~ s,&lt;/M.B&gt;,,g;
            $item =~ s,&lt;M.C&gt;, / ,g;
            $item =~ s,&lt;/M.C&gt;,,g;
	    $item =~ s,&lt;M..&gt;, ,g;
	    $item =~ s,&lt;/M..&gt;,,g;
            print SGMDOC $item;
	}
	print SGMDOC (qq{&lt;/K&gt;});
	print SGMDOC (qq{&lt;/F&gt;});
    }
} 
    
 
#  These multiples of NOTESSTMTs (the G's) should be made single
  	if (@notes) {
	    foreach $item (@notes) {
		$item =~ s,&lt;/?M.A&gt;,,g;
		$item =~ s,&lt;M..&gt;, ,g;
		$item =~ s,&lt;/M..&gt;,,g;
		$item = '&lt;G&gt;&lt;AA&gt;' . $item . '&lt;/AA&gt;&lt;/G&gt;';
		print SGMDOC $item;
	    }
      }
  	if (@othernotes) {
	    foreach $item (@othernotes) {
		$item =~ s,&lt;/?M.A&gt;,,g;
		$item =~ s,&lt;M..&gt;, ,g;
		$item =~ s,&lt;/M..&gt;,,g;
		$item = '&lt;G&gt;&lt;AA&gt;' . $item . '&lt;/AA&gt;&lt;/G&gt;';
		print SGMDOC $item;
	    }
      }
  	if (@XXentries) {
	    foreach $item (@XXentries) {
		$item =~ s,&lt;/?M.A&gt;,,g;
		$item =~ s,&lt;M..&gt;, ,g;
		$item =~ s,&lt;/M..&gt;,,g;
		$item = '&lt;G&gt;&lt;AA&gt;' . $item . '&lt;/AA&gt;&lt;/G&gt;';
		print SGMDOC $item;
	    }
      }

  	if (@addentries) {
	    foreach $item (@addentries) {
		$item =~ s,&lt;/?M.A&gt;,,g;
		$item =~ s,&lt;M..&gt;, ,g;
		$item =~ s,&lt;/M..&gt;,,g;
		$item = '&lt;G&gt;&lt;AA&gt;' . $item . '&lt;/AA&gt;&lt;/G&gt;';
		print SGMDOC $item;
	    }
      }	

    
	if (@subjects){
	    print SGMDOC (qq{&lt;I2&gt;&lt;SG&gt;});
            foreach $item (@subjects) {
		$item =~ s,&lt;/?M.A&gt;,,g;
                $item =~ s,&lt;M..&gt;,--,g;
		$item =~ s,&lt;/M..&gt;,,g;
		$item = '&lt;SU&gt;' . $item . '&lt;/SU&gt;';
                print SGMDOC $item;
	    }
	    print SGMDOC (qq{&lt;/SG&gt;&lt;/I2&gt;});
	}	
	print SGMDOC (qq{&lt;J&gt;&lt;URL&gt;http://ets.umdl.umich.edu/bin/FOO/FOO-idx?type=header\&amp;id=BAR&lt;/URL&gt;&lt;/J&gt;}); # MOA1 and MOA4
#	print SGMDOC (qq{&lt;J&gt;&lt;URL&gt;http://www.hti.umich.edu/cgi/t/text/text-idx?c=moa\&amp;idno=$notisid&lt;/URL&gt;&lt;/J&gt;}); # MOA1 and MOA4
#	print SGMDOC (qq{&lt;J&gt;&lt;URL&gt;http://moa.umdl.umich.edu/moa4/availability.html&lt;/URL&gt;&lt;/J&gt;}); # MOA4
#	print SGMDOC (qq{&lt;J&gt;&lt;URL&gt;http://www.hti.umich.edu/cgi/u/umr/pageviewer?id=$notisid&lt;/URL&gt;&lt;/J&gt;}); # UMR
#	print SGMDOC (qq{&lt;J&gt;&lt;COLLS&gt;&lt;COLL&gt;moa&lt;/COLL&gt;&lt;/COLLS&gt;}); # for MOA, need to alter to draw from colldb
				

    print SGMDOC (qq{&lt;/A&gt;\n});
    
    close SGMDOC;
    @subjects = ();
    @titles = ();
    @mu_callnum = ();
    @imprint = ();
    @pubstmt = ();
    @author = ();
    @addentries =();
    @XXentries =();
    @othernotes = ();
    @extent = ();
    @series = ();
    @notes = ();
    $notisid ='';
}


#some error checking to make sure that we haven't mixed up materials

open (PROCESS, "&gt;&gt;processing");
$testtitle = $titles[0];
$testtitle =~ s,&lt;\w&gt;,,g;
$testtitle =~ s,&lt;/\w&gt;,,g;
$testtitle =~ s,\n,,g;
$testtitle =~ s,^(\S+\s\S+\s\S+\s).*,$1,g;


$comtitle =~ s,^(\S+\s\S+\s\S+\s).*,$1,g;


if ($comtitle =~ m,$testtile,) {
}
else {
    print PROCESS (qq{MARC: $testtitle/ MOA: $comtitle - $notisid\n\n});
}

close PROCESS;







</pre></body></html>