#!/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";
	};
}