12 MARC::Charset->assume_unicode(1);
13 MARC::Charset->ignore_errors(1);
15 binmode(STDIN, ':utf8');
16 binmode(STDOUT, ':utf8');
18 my ($delim, @fields) = (' \| ');
20 'delimiter=s' => \$delim,
21 'field=s' => \@fields,
27 $partmap{$_} = $partcount;
33 my @values = split $delim;
36 for my $part (keys %partmap) {
37 ($partlist{tcn_value} = $values[ $partmap{tcn_value}]) =~ s/^\s*//o if ($part eq 'tcn_value');
38 ($partlist{tcn_source} = $values[ $partmap{tcn_source}]) =~ s/^\s*//o if ($part eq 'tcn_source');
39 ($partlist{id} = $values[ $partmap{id}]) =~ s/^\s*//o if ($part eq 'id');
40 $partlist{marc} = $values[ $partmap{marc}] if ($part eq 'marc');
42 $partlist{tcn_value} =~ s/\s*$//o if ($part eq 'tcn_value');
43 $partlist{tcn_source} =~ s/\s*$//o if ($part eq 'tcn_source');
44 $partlist{id} =~ s/\s*$//o if ($part eq 'id');
47 next unless ($partlist{marc});
50 my $r = MARC::Record->new_from_xml($partlist{marc});
53 $sfmap{a} = $partlist{tcn_value} if ($partlist{tcn_value});
54 $sfmap{b} = $partlist{tcn_source} if ($partlist{tcn_source});
55 $sfmap{c} = $partlist{id} if ($partlist{id});
57 my $f = MARC::Field->new(901 => ' ' => ' ' => %sfmap);
58 $r->delete_field($_) for ($r->field('901'));
59 $r->append_fields( $f );
61 print $r->as_xml_record;
63 warn "failed on record $., $partlist{marc}\n";