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