fingerprints.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use open ':utf8';
   6 use MARC::Batch;
   7 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
   8 use MARC::Field;
   9 use Unicode::Normalize;
  10
  11 my $count = 0;
  12 my $which = shift;
  13 my $id_tag = shift;
  14 my $id_subfield = shift;
  15
  16 binmode(STDOUT, ':utf8');
  17 binmode(STDIN, ':utf8');
  18
  19 for my $file (@ARGV) {
  20
  21     print STDERR "Processing $file\n";
  22
  23     open my $M, '<:utf8', $file;
  24
  25     my $batch = MARC::Batch->new('XML',$M);
  26     $batch->strict_off();
  27     $batch->warnings_off();
  28
  29     my $record = 1;
  30     while ( $record ) {
  31         $count++;
  32         $record = $batch->next();
  33
  34         my $id = $record->field($id_tag);
  35         if (!$id) {
  36             print STDERR "ERROR: This record is missing a $id_tag field.\n"
  37               . $record->as_formatted() . "\n=====\n";
  38             next;
  39         }
  40         $id = $id->as_string($id_subfield);
  41
  42         my $leader = $record->leader();
  43         my $record_type = substr($leader,6,1);
  44         my $bib_lvl = substr($leader,7,1);
  45
  46         my $my_008 = $record->field('008');
  47         $my_008 = $my_008->as_string() if ($my_008);
  48         my $date1 = substr($my_008,7,4) if ($my_008);
  49         my $date2 = substr($my_008,11,4) if ($my_008);
  50         my $item_form;
  51         if ( $record_type =~ /[gkroef]/ ) { # MAP, VIS
  52             $item_form = substr($my_008,29,1) if ($my_008);
  53         } else {
  54             $item_form = substr($my_008,23,1) if ($my_008);
  55         }
  56
  57         my $title = $record->field('245');
  58         if ( $title ) { $title = $title->subfield('a'); }
  59
  60         my @isbns = ();
  61         my @isbns_020;
  62         if ($record->field('020')) { @isbns_020 = $record->field('020'); }
  63         foreach my $f ( @isbns_020 ) {
  64             if ($f->subfield('a')) {
  65                 if ( $f->subfield('a')=~/(\S+)/ ) {
  66                     push @isbns, $1;
  67                 }
  68             }
  69         }
  70         my @isbns_024;
  71         if ($record->field('024')) { @isbns_024 = $record->field('024'); }
  72         foreach my $f ( @isbns_024 ) {
  73             if ($f->subfield('a')) {
  74                 if ( $f->subfield('a')=~/(\S+)/ ) {
  75                     push @isbns, $1;
  76                 }
  77             }
  78         }
  79
  80         my $issn = $record->field('022');
  81         if ( $issn ) { $issn = $issn->subfield('a'); }
  82         my $lccn = $record->field('010');
  83         if ( $lccn ) { $lccn = $lccn->subfield('a'); }
  84         my $author;
  85         if ($record->field('100'))
  86           { $author = $record->field('100')->subfield('a'); }
  87         unless ( $author ) {
  88             $author = $record->field('110')->subfield('a')
  89               if ($record->field('110'));
  90             $author = $record->field('111')->subfield('a')
  91               if ($record->field('111'));
  92         }
  93         my $desc = $record->field('300');
  94         if ( $desc ) { $desc = $desc->subfield('a'); }
  95         my $pages;
  96         if (defined $desc and $desc =~ /(\d+)/) { $pages = $1; }
  97         my $my_260 = $record->field('260');
  98         my $publisher = $my_260->subfield('b') if ( $my_260 );
  99         my $pubyear = $my_260->subfield('c') if ( $my_260 );
 100         if ( $pubyear ) {
 101             if ( $pubyear =~ /(\d\d\d\d)/ )
 102               { $pubyear = $1; }
 103             else
 104               { $pubyear = ''; }
 105         }
 106         my $edition = $record->field('250');
 107         if ( $edition ) { $edition = $edition->subfield('a'); }
 108
 109         # NORMALIZE
 110         $record_type = 'a' if ($record_type eq ' ');
 111         if ($title) {
 112             $title = NFD($title); $title =~ s/[\x{80}-\x{ffff}]//go;
 113             $title = lc($title);
 114             $title =~ s/\W+$//go;
 115         }
 116         if ($author) {
 117             $author = NFD($author); $author =~ s/[\x{80}-\x{ffff}]//go;
 118             $author = lc($author);
 119             $author =~ s/\W+$//go;
 120             if ($author =~ /^(\w+)/) {
 121                 $author = $1;
 122             }
 123         }
 124         if ($publisher) {
 125             $publisher = NFD($publisher); $publisher =~ s/[\x{80}-\x{ffff}]//go;
 126             $publisher = lc($publisher);
 127             $publisher =~ s/\W+$//go;
 128             if ($publisher =~ /^(\w+)/) {
 129                 $publisher = $1;
 130             }
 131         }
 132
 133         # SPIT OUT FINGERPRINTS FROM THE "LOIS ALGORITHM"
 134         # If we're not getting good matches, we may want to change this.
 135         # The same thing goes for some other fields.
 136         if ($item_form && ($date1 =~ /\d\d\d\d/)
 137             && $record_type && $bib_lvl && $title) {
 138             if ($which eq "primary") {
 139                 print STDOUT
 140                   join("\t",$id,$item_form,$date1,$record_type,$bib_lvl,$title)
 141                     ,"\n";
 142             } else {
 143                 # case a : isbn and pages
 144                 if (scalar(@isbns)>0 && $pages) {
 145                     foreach my $isbn ( @isbns ) {
 146                         print STDOUT
 147                           join("\t", $id, "case a", $item_form, $date1,
 148                                $record_type, $bib_lvl, $title, $isbn, $pages)
 149                             ,"\n";
 150                     }
 151                 }
 152                 # case b : edition
 153                 if ($edition) {
 154                     print STDOUT
 155                       join("\t", $id, "case b", $item_form, $date1,
 156                            $record_type, $bib_lvl, $title,$edition), "\n";
 157                 }
 158                 # case c : issn
 159                 if ($issn) {
 160                     print STDOUT join("\t", $id, "case c", $item_form, $date1,
 161                                       $record_type, $bib_lvl, $title, $issn)
 162                       ,"\n";
 163                 }
 164                 # case d : lccn
 165                 if ($lccn) {
 166                     print STDOUT join("\t", $id, "case d", $item_form, $date1,
 167                                       $record_type, $bib_lvl, $title, $lccn)
 168                       ,"\n";
 169                 }
 170                 # case e : author, publisher, pubyear, pages
 171                 if ($author && $publisher && $pubyear && $pages) {
 172                     print STDOUT join("\t", $id, "case e", $item_form, $date1,
 173                                       $record_type, $bib_lvl, $title, $author,
 174                                       $publisher, $pubyear, $pages), "\n";
 175                 }
 176             }
 177         } else {
 178             print STDERR "Record " . $id . " did not make the cut: ";
 179             print STDERR "Missing item_form. " unless ($item_form);
 180             print STDERR "Missing valid date1. " unless ($date1 =~ /\d\d\d\d/);
 181             print STDERR "Missing record_type. " unless ($record_type);
 182             print STDERR "Missing bib_lvl. " unless ($bib_lvl);
 183             print STDERR "Missing title. " unless ($title);
 184             print STDERR "\n";
 185         }
 186     }
 187     print STDERR "Processed $count records\n";
 188 }