fingerprinter

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use open ':utf8';
   5
   6 use Getopt::Long;
   7 use MARC::Batch;
   8 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
   9 use MARC::Field;
  10 use Unicode::Normalize;
  11
  12 my $conf  = {}; # configuration hashref
  13 my $marc  = {}; # MARC record hashref
  14 my $count = 0;
  15 initialyze($conf);
  16
  17 for my $file (@ARGV) {
  18
  19     print STDERR "Processing $file\n";
  20
  21     open my $M, '<:utf8', $file;
  22
  23     my $batch = MARC::Batch->new('XML',$M);
  24     $batch->strict_off();
  25     $batch->warnings_off();
  26
  27     while ( my $record = $batch->next ) {
  28         $count++;
  29
  30         my $id = $record->field($conf->{tag});
  31         unless ($id) {
  32             print STDERR "ERROR: This record is missing a", $conf->{tag},
  33               "field.\n", $record->as_formatted(), "\n=====\n";
  34             next;
  35         }
  36         $id = $id->as_string($conf->{subfield});
  37
  38         my $leader = $record->leader();
  39         my $record_type = substr($leader,6,1);
  40         my $bib_lvl = substr($leader,7,1);
  41
  42         my $my_008 = $record->field('008');
  43         $my_008 = $my_008->as_string() if ($my_008);
  44         my $date1 = substr($my_008,7,4) if ($my_008);
  45         my $date2 = substr($my_008,11,4) if ($my_008);
  46
  47         my $item_form;
  48         if ( $record_type =~ /[gkroef]/ ) { # MAP, VIS
  49             $item_form = substr($my_008,29,1) if ($my_008);
  50         } else {
  51             $item_form = substr($my_008,23,1) if ($my_008);
  52         }
  53
  54         my $title = $record->field('245');
  55         $title = $title->subfield('a') if $title;
  56
  57         my @isbns = ();
  58         my @isbns_020;
  59         if ($record->field('020')) { @isbns_020 = $record->field('020'); }
  60         foreach my $f ( @isbns_020 ) {
  61             if ($f->subfield('a')) {
  62                 if ( $f->subfield('a')=~/(\S+)/ ) {
  63                     push @isbns, $1;
  64                 }
  65             }
  66         }
  67         my @isbns_024;
  68         if ($record->field('024')) { @isbns_024 = $record->field('024'); }
  69         foreach my $f ( @isbns_024 ) {
  70             if ($f->subfield('a')) {
  71                 if ( $f->subfield('a')=~/(\S+)/ ) {
  72                     push @isbns, $1;
  73                 }
  74             }
  75         }
  76
  77         my $issn = $record->field('022');
  78         $issn = $issn->subfield('a') if $issn;
  79
  80         my $lccn = $record->field('010');
  81         $lccn = $lccn->subfield('a') if $lccn;
  82
  83         my $author;
  84         if ($record->field('100'))
  85           { $author = $record->field('100')->subfield('a'); }
  86         unless ( $author ) {
  87             $author = $record->field('110')->subfield('a')
  88               if ($record->field('110'));
  89             $author = $record->field('111')->subfield('a')
  90               if ($record->field('111'));
  91         }
  92
  93         my $desc = $record->field('300');
  94         $desc = $desc->subfield('a') if $desc;
  95
  96         my $pages;
  97         $pages = $1 if (defined $desc and $desc =~ /(\d+)/);
  98
  99         my $my_260 = $record->field('260');
 100         my $publisher = $my_260->subfield('b') if $my_260;
 101         my $pubyear = $my_260->subfield('c') if $my_260;
 102         if ( $pubyear ) {
 103             if ( $pubyear =~ /(\d\d\d\d)/ )
 104               { $pubyear = $1; }
 105             else
 106               { $pubyear = ''; }
 107         }
 108
 109         my $edition = $record->field('250');
 110         $edition = $edition->subfield('a') if $edition;
 111
 112         # NORMALIZE
 113         $record_type = 'a' if ($record_type eq ' ');
 114         if ($title) {
 115             $title = NFD($title); $title =~ s/[\x{80}-\x{ffff}]//go;
 116             $title = lc($title);
 117             $title =~ s/\W+$//go;
 118         }
 119         if ($author) {
 120             $author = NFD($author); $author =~ s/[\x{80}-\x{ffff}]//go;
 121             $author = lc($author);
 122             $author =~ s/\W+$//go;
 123             if ($author =~ /^(\w+)/) {
 124                 $author = $1;
 125             }
 126         }
 127         if ($publisher) {
 128             $publisher = NFD($publisher); $publisher =~ s/[\x{80}-\x{ffff}]//go;
 129             $publisher = lc($publisher);
 130             $publisher =~ s/\W+$//go;
 131             if ($publisher =~ /^(\w+)/) {
 132                 $publisher = $1;
 133             }
 134         }
 135
 136         # SPIT OUT FINGERPRINTS FROM THE "LOIS ALGORITHM"
 137         # If we're not getting good matches, we may want to change this.
 138         # The same thing goes for some other fields.
 139         if ($item_form && ($date1 =~ /\d\d\d\d/)
 140             && $record_type && $bib_lvl && $title) {
 141             if ($conf->{runtype} eq "primary") {
 142                 print STDOUT
 143                   join("\t",$id,$item_form,$date1,$record_type,$bib_lvl,$title)
 144                     ,"\n";
 145             } else {
 146                 # case a : isbn and pages
 147                 if (scalar(@isbns)>0 && $pages) {
 148                     foreach my $isbn ( @isbns ) {
 149                         print STDOUT
 150                           join("\t", $id, "case a", $item_form, $date1,
 151                                $record_type, $bib_lvl, $title, $isbn, $pages)
 152                             ,"\n";
 153                     }
 154                 }
 155                 # case b : edition
 156                 if ($edition) {
 157                     print STDOUT
 158                       join("\t", $id, "case b", $item_form, $date1,
 159                            $record_type, $bib_lvl, $title,$edition), "\n";
 160                 }
 161                 # case c : issn
 162                 if ($issn) {
 163                     print STDOUT join("\t", $id, "case c", $item_form, $date1,
 164                                       $record_type, $bib_lvl, $title, $issn)
 165                       ,"\n";
 166                 }
 167                 # case d : lccn
 168                 if ($lccn) {
 169                     print STDOUT join("\t", $id, "case d", $item_form, $date1,
 170                                       $record_type, $bib_lvl, $title, $lccn)
 171                       ,"\n";
 172                 }
 173                 # case e : author, publisher, pubyear, pages
 174                 if ($author && $publisher && $pubyear && $pages) {
 175                     print STDOUT join("\t", $id, "case e", $item_form, $date1,
 176                                       $record_type, $bib_lvl, $title, $author,
 177                                       $publisher, $pubyear, $pages), "\n";
 178                 }
 179             }
 180         } else {
 181             print STDERR "Record " . $id . " did not make the cut: ";
 182             print STDERR "Missing item_form. " unless ($item_form);
 183             print STDERR "Missing valid date1. " unless ($date1 =~ /\d\d\d\d/);
 184             print STDERR "Missing record_type. " unless ($record_type);
 185             print STDERR "Missing bib_lvl. " unless ($bib_lvl);
 186             print STDERR "Missing title. " unless ($title);
 187             print STDERR "\n";
 188         }
 189     }
 190     print STDERR "Processed $count records\n";
 191 }
 192
 193 =head2 initialyze
 194
 195 Performs boring script initialization. Handles argument parsing,
 196 mostly.
 197
 198 =cut
 199
 200 sub initialyze {
 201     my ($c) = @_;
 202     my @missing = ();
 203
 204     # set mode on existing filehandles
 205     binmode(STDOUT, ':utf8');
 206     binmode(STDIN, ':utf8');
 207
 208     my $rc = GetOptions( $c,
 209                          'runtype|r=s',
 210                          'tag|t=s',
 211                          'subfield|s=s',
 212                        );
 213     show_help() unless $rc;
 214     my @keys = keys %{$c};
 215     show_help() unless (@ARGV and @keys);
 216
 217     for my $key ('runtype', 'tag', 'subfield') {
 218         push @missing, $key unless $c->{$key}
 219     }
 220     if (@missing) {
 221         print "Required option: ", join(', ', @missing), " missing!\n";
 222         show_help();
 223     }
 224 }
 225
 226 =head2 show_help
 227
 228 =cut
 229
 230 sub show_help {
 231 print <<HELP;
 232 Usage is: fingerprinter [REQUIRED ARGS] [OPTIONS] <filelist>
 233 Req'd Arguments
 234   --runtype=(primary|full) -r  Do 'primary' or 'full' fingerprinting
 235   --tag=N                  -t  Which tag to use
 236   --subfield=X             -s  Which subfield to use
 237 Options
 238   None yet...
 239 HELP
 240 exit 1;
 241 }