Open-ILS/src/extras/import/marc_add_ids

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use MARC::Record;
   8 use MARC::Charset;
   9 use MARC::File::XML;
  10 use Error qw/:try/;
  11
  12 MARC::Charset->assume_unicode(1);
  13 MARC::Charset->ignore_errors(1);
  14
  15 binmode(STDIN, ':utf8');
  16 binmode(STDOUT, ':utf8');
  17
  18 my ($delim, @fields) = (' \| ');
  19 GetOptions(
  20         'delimiter=s'   => \$delim,
  21         'field=s'       => \@fields,
  22 );
  23
  24 my %partmap;
  25 my $partcount = 0;
  26 for (@fields) {
  27         $partmap{$_} = $partcount;
  28         $partcount++;
  29 }
  30
  31 while (<>) {
  32         chomp;
  33         my @values = split $delim;
  34
  35         my %partlist;
  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');
  41
  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');
  45         }
  46
  47         next unless ($partlist{marc});
  48
  49         try {
  50                 my $r = MARC::Record->new_from_xml($partlist{marc});
  51
  52                 my %sfmap;
  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});
  56
  57                 my $f = MARC::Field->new(901 => ' ' => ' ' => %sfmap);
  58                 $r->delete_field($_) for ($r->field('901'));
  59                 $r->append_fields( $f );
  60
  61                 print $r->as_xml_record;
  62         } otherwise {
  63                 warn "failed on record $., $partlist{marc}\n";
  64         };
  65 }
  66
  67