--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use MARC::Record;
+use MARC::Charset;
+use MARC::File::XML;
+use Error qw/:try/;
+
+MARC::Charset->assume_unicode(1);
+MARC::Charset->ignore_errors(1);
+
+binmode(STDIN, ':utf8');
+binmode(STDOUT, ':utf8');
+
+my ($delim, @fields) = (' \| ');
+GetOptions(
+ 'delimiter=s' => \$delim,
+ 'field=s' => \@fields,
+);
+
+my %partmap;
+my $partcount = 0;
+for (@fields) {
+ $partmap{$_} = $partcount;
+ $partcount++;
+}
+
+while (<>) {
+ chomp;
+ my @values = split $delim;
+
+ my %partlist;
+ for my $part (keys %partmap) {
+ ($partlist{tcn_value} = $values[ $partmap{tcn_value}]) =~ s/^\s*//o if ($part eq 'tcn_value');
+ ($partlist{tcn_source} = $values[ $partmap{tcn_source}]) =~ s/^\s*//o if ($part eq 'tcn_source');
+ ($partlist{id} = $values[ $partmap{id}]) =~ s/^\s*//o if ($part eq 'id');
+ $partlist{marc} = $values[ $partmap{marc}] if ($part eq 'marc');
+
+ $partlist{tcn_value} =~ s/\s*$//o if ($part eq 'tcn_value');
+ $partlist{tcn_source} =~ s/\s*$//o if ($part eq 'tcn_source');
+ $partlist{id} =~ s/\s*$//o if ($part eq 'id');
+ }
+
+ next unless ($partlist{marc});
+
+ try {
+ my $r = MARC::Record->new_from_xml($partlist{marc});
+
+ my %sfmap;
+ $sfmap{a} = $partlist{tcn_value} if ($partlist{tcn_value});
+ $sfmap{b} = $partlist{tcn_source} if ($partlist{tcn_source});
+ $sfmap{c} = $partlist{id} if ($partlist{id});
+
+ my $f = MARC::Field->new(901 => ' ' => ' ' => %sfmap);
+ $r->delete_field($_) for ($r->field('901'));
+ $r->append_fields( $f );
+
+ print $r->as_xml_record;
+ } otherwise {
+ warn "failed on record $., $partlist{marc}\n";
+ };
+}
+
+
fields => \@cols,
};
+ #XXX it burnnnsssessss
+ $fieldcache{$hint}{table} =~ s/\.full_rec/.real_full_rec/o if ($hint eq 'mfr');
+
my $fields = join(',', @{ $fieldcache{$hint}{fields} });
$main_out->print( "DELETE FROM $fieldcache{$hint}{table};\n" ) if (grep {$_ eq $hint } @wipe);
$main_out->print( "COPY $fieldcache{$hint}{table} ($fields) FROM '$pwd/$output.$hint.sql';\n" );