initialize($conf);
# read in trash tags file if it exists
-populate_trash() if (-e '.trashtags');
+populate_trash() if ($conf->{trash});
my @record = (); # current record storage
my %recmeta = (); # metadata about current record
my $input = shift || 'incoming.marc.xml';
-open MARC, '<', $input;
-open my $NUMARC, '>', $conf->{output};
+open MARC, '<:utf8', $input;
+open my $NUMARC, '>:utf8', $conf->{output};
print $NUMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
print $NUMARC '<collection xmlns="http://www.loc.gov/MARC21/slim">',"\n";
-open my $EXMARC, '>', $conf->{exception};
+open my $EXMARC, '>:utf8', $conf->{exception};
print $EXMARC '<?xml version="1.0" encoding="UTF-8"?>',"\n";
print $EXMARC '<collection xmlns="http://www.loc.gov/MARC21/slim">',"\n";
open MARC2, '<', $input;
$recmeta{ind2} = $3;
}
+ # automatable subfield maladies
+ $line =~ s/code=" ">c/code="c">/;
+ $line =~ s/code=" ">\$/code="c"$>/;
+
# and stow line back in record
$record[-1] = $line;
}
# subfields can't be non-alphanumeric
- if ($line =~ /<subfield code="(.+?)"/) {
+ if ($line =~ /<subfield code="(.*?)"/) {
my $match = $1;
- if ($match =~ /\P{IsAlnum}/) {
- edit("Junk in subfield code", $line);
+ if ($match =~ /\P{IsAlnum}/ or $match eq '') {
+ edit("Junk in subfield code/Null subfield code", $line);
next;
}
}
print $FH '<!-- ', $recmeta{explanation}, " -->\n"
if(defined $recmeta{explanation});
- # LOOP OVER %trash TO EXCISE UNWANTED TAGS1
- if (keys %trash) {
+ # excise unwanted tags
+ if (keys %trash or $conf->{autoscrub}) {
my @trimmed = ();
my $istrash = 0;
for my $line (@record) {
}
# add 903(?) with new record id
+ my $renumber = '';
if ($conf->{'renumber-from'}) {
- print $FH '<datafield tag="', $conf->{'renumber-tag'}, '"><subfield code="a">',
- $conf->{'renumber-from'}, '</subfield></datafield>';
- print $FH "\n" unless $conf->{oneperline};
+ $renumber = join('', '<datafield tag="', $conf->{'renumber-tag'},
+ '" ind1=" " ind2=" ">',
+ '<subfield code="', $conf->{'renumber-subfield'}, '">',
+ $conf->{'renumber-from'}, '</subfield></datafield>');
+ $renumber .= "\n" if $conf->{nocollapse};
+ push @record, $renumber;
$conf->{'renumber-from'}++;
}
print $FH @record;
- print $FH '</record>\n';
+ print $FH "</record>\n";
}
sub update_linecontext {
# specifying a tag twice is an error, to help prevent typos
sub populate_trash {
- print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT...\n";
- open TRASH, '<', '.trashtags';
+ print $OUT ">>> TRASHTAGS FILE FOUND. LOADING TAGS TO BE STRIPPED FROM OUTPUT\n";
+ open TRASH, '<', $conf->{trash}
+ or die "Can't open trash tags file!\n";
while (<TRASH>) {
my $lastwasrange = 0;
my %lastrange = ( high => 0, low => 0);
'renumber-from|rf=i',
'original-tag|ot=i',
'renumber-tag|rt=i',
+ 'renumber-subfield|rt=i',
+ 'trash|t=s',
'help|h',
);
show_help() unless $rc;
$c->{output} = 'incoming.cleaned.marc.xml' unless defined $c->{output};
$c->{exception} = 'incoming.exception.marc.xml' unless defined $c->{exception};
$c->{'renumber-tag'} = 903 unless defined $c->{'renumber-tag'};
+ $c->{'renumber-subfield'} = 'a' unless defined $c->{'renumber-subfield'};
my @keys = keys %{$c};
show_help() unless (@ARGV and @keys);