miker-filter_incumbents.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Getopt::Long;
   6 use Time::HiRes qw/time/;
   7 use MARC::Record;
   8 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
   9
  10 # configuration hashref
  11 my $conf  = ();
  12 #initialize($conf);
  13
  14 my $idfile = shift;
  15 my $marcfile = shift;
  16 my $import = shift;
  17 my $shelve = shift;
  18
  19 my %id;
  20
  21 open F, "<$idfile";
  22 while (<F>) {
  23         chomp;
  24         $id{$_} = 1;
  25 }
  26
  27 close F;
  28
  29 my $M; my $I; my $S;
  30 open $M, '<:utf8', $marcfile;
  31 open $I, '>:utf8', $import;
  32 open $S, '>:utf8', $shelve;
  33
  34 my $starttime = time;
  35 my $count = 0;
  36 my $icount = 0;
  37 my $scount = 0;
  38 while (<$M>) {
  39     /tag="901" ind1=" " ind2=" ">.*?<subfield code="c">(\d+)</;
  40     if ( $id{$1} ) {
  41         print $I $_;
  42         $icount++;
  43     } else {
  44         print $S $_;
  45         $scount++;
  46     }
  47     $count++;
  48
  49     unless ($count && $count % 100) {
  50         print STDERR "\r$count\t(shelved: $scount, import: $icount)\t". $count / (time - $starttime);
  51     }
  52 }
  53
  54 =head2 initialize
  55
  56 Performs boring script initialization. Handles argument parsing,
  57 mostly.
  58
  59 =cut
  60
  61 sub initialize {
  62     my ($c) = @_;
  63     my @missing = ();
  64
  65     # set mode on existing filehandles
  66     binmode(STDIN, ':utf8');
  67
  68     my $rc = GetOptions( $c,
  69                          'incoming',
  70                          'incumbent',
  71                          'incoming-tag|incot=i',
  72                          'incoming-subfield|incos=s',
  73                          'incumbent-tag|incut=i',
  74                          'incumbent-subfield|incus=s',
  75                          'output|o=s',
  76                          'help|h',
  77                        );
  78     show_help() unless $rc;
  79     show_help() if ($c->{help});
  80
  81     $c->{'incoming-tag'}         = 903;
  82     $c->{'incoming-subfield'}    = 'a';
  83     $c->{'incoming-matchfile'}   = '';
  84     $c->{'incoming-nomatchfile'} = '';
  85     $c->{'incumbent-tag'}         = 901;
  86     $c->{'incumbent-subfield'}    = 'a';
  87     $c->{'incumbent-matchfile'}   = '';
  88     $c->{'incumbent-nomatchfile'} = '';
  89     my @keys = keys %{$c};
  90     show_help() unless (@ARGV and @keys);
  91     for my $key ('renumber-from', 'tag', 'subfield', 'output')
  92       { push @missing, $key unless $c->{$key} }
  93     if (@missing) {
  94         print "Required option: ", join(', ', @missing), " missing!\n";
  95         show_help();
  96     }
  97
  98 }
  99
 100
 101 =head2 show_help
 102
 103 Display usage message when things go wrong
 104
 105 =cut
 106
 107 sub show_help {
 108 print <<HELP;
 109 Usage is: $0 [REQUIRED ARGS]
 110 Req'd Arguments
 111   --renumber-from=N        -rf First id# of new sequence
 112   --tag=N                  -t  Which tag to use
 113   --subfield=X             -s  Which subfield to use
 114   --output=<file>          -o  Output filename
 115
 116 Any number of input files may be specified; one output file will result.
 117 HELP
 118 exit 1;
 119 }