renumber_marc

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use MARC::Batch;
   6 use Getopt::Long;
   7 #use MARC::Record;
   8 #use MARC::File::XML ( BinaryEncoding => 'utf-8' );
   9 #use MARC::Field;
  10
  11 my $count = 0;
  12 my $conf  = {}; # configuration hashref
  13 initialize($conf);
  14
  15 binmode(STDOUT, ':utf8');
  16 binmode(STDIN, ':utf8');
  17
  18 foreach my $input ( @ARGV ) {
  19     print STDERR "Processing $input, starting record id at ",
  20       $conf->{'renumber-from'},"\n";
  21
  22     my $batch = MARC::Batch->new('XML', $input);
  23     while ( my $record = $batch->next ) {
  24         $count++;
  25         my @warnings = $batch->warnings;
  26         print STDERR "WARNINGS: Record $count : ",
  27           join(":",@warnings), " : continuing...\n"
  28             if ( @warnings );
  29
  30         while ($record->field($conf->{tag}))
  31           { $record->delete_field( $record->field($conf->{tag}) ) }
  32         my $new_id = $conf->{'renumber-from'} + $count - 1;
  33         my $new_id_field = MARC::Field->new( $conf->{tag},
  34                                              ' ',
  35                                              ' ',
  36                                              $conf->{subfield} => $new_id );
  37         $record->append_fields($new_id_field);
  38         print $record->as_xml;
  39     }
  40     print STDERR "Processed $count records.  Last record id at ",
  41       ($conf->{'renumber-from'} + $count - 1), "\n";
  42 }
  43
  44
  45 =head2 initialize
  46
  47 Performs boring script initialization. Handles argument parsing,
  48 mostly.
  49
  50 =cut
  51
  52 sub initialize {
  53     my ($c) = @_;
  54     my @missing = ();
  55
  56     # set mode on existing filehandles
  57     binmode(STDIN, ':utf8');
  58
  59     my $rc = GetOptions( $c,
  60                          'output|o=s',
  61                          'renumber-from|rf=i',
  62                          'subfield|s=s',
  63                          'tag|t=s',
  64                          'help|h',
  65                        );
  66     show_help() unless $rc;
  67
  68     my @keys = keys %{$c};
  69     show_help() unless (@ARGV and @keys);
  70     for my $key ('renumber-from', 'tag', 'subfield', 'output')
  71       { push @missing, $key unless $c->{$key} }
  72     if (@missing) {
  73         print "Required option: ", join(', ', @missing), " missing!\n";
  74         show_help();
  75     }
  76
  77     show_help() if ($c->{help});
  78 }
  79
  80
  81 =head2 show_help
  82
  83 Display usage message when things go wrong
  84
  85 =cut
  86
  87 sub show_help {
  88 print <<HELP;
  89 Usage is: $0 [REQUIRED ARGS] <filelist>
  90 Req'd Arguments
  91   --renumber-from=N        -rf First id# of new sequence
  92   --tag=N                  -t  Which tag to use
  93   --subfield=X             -s  Which subfield to use
  94   --output=<file>          -o  Output filename
  95
  96 Any number of input files may be specified; one output file will result.
  97 HELP
  98 exit 1;
  99 }