--- /dev/null
+#!/usr/bin/perl
+use warnings;
+use strict;
+use autodie;
+use MARC::Record;
+use Encode;
+use Data::Dump qw(dump);
+
+open(my $m21, '<', 'agram-3.m21');
+open(my $out, '>:encoding(utf-8)', 'agram-3.marc');
+
+my $last_id;
+my @fields;
+my $marc;
+
+sub new_marc {
+ $marc = new MARC::Record;
+ $marc->encoding('utf-8');
+ return $marc;
+}
+
+$marc = new_marc();
+
+while (<$m21>) {
+ chomp;
+ my ( $id, $rest ) = split(/\s/, $_, 2);
+ my ( $fffii, $sf ) = split(/\s+L\s+/,$rest,2);
+
+ warn "## ",dump( $id, $fffii, $sf );
+
+ $last_id = $id if ! defined $last_id;
+ if ( $id != $last_id ) {
+ print $out $marc->as_usmarc;
+ print "XXX $id\n";
+ print $marc->as_formatted();
+ print "\n";
+ $marc = new_marc();
+ $last_id = $id;
+ }
+
+ if ( $fffii eq 'LDR' ) {
+ $sf =~ s/\^/ /g;
+ $marc->leader( $sf );
+ } elsif ( $fffii =~ m/^00/ ) {
+ my $field = MARC::Field->new( $fffii, $sf );
+ $marc->append_fields( $field );
+ } else {
+ my $f = $1 if $fffii =~ s/^(...)//;
+ my $i1 = $1 if $fffii =~ s/^(.)//;
+ my $i2 = $1 if $fffii =~ s/^(.)//;
+ $i1 ||= ' ';
+ $i2 ||= ' ';
+
+ warn "# $id $fffii -> ", dump($f,$i1,$i2), " [$sf]\n";
+
+ my @f = ( $f, $i1, $i2 );
+
+ while ( $sf =~ s/^\$\$(\w)([^\$]+)// ) {
+ push @f, $1, decode('iso-8859-1', $2);
+ }
+ warn "### ",dump( @f );
+ my $field = MARC::Field->new( @f );
+ $marc->append_fields( $field );
+ }
+}
+
+