fingerprinter

   1 #!/usr/bin/perl
   2
   3 # Copyright 2009-2012, Equinox Software, Inc.
   4 #
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  18
  19 use strict;
  20 use warnings;
  21 use open ':utf8';
  22
  23 use Getopt::Long;
  24 use MARC::Batch;
  25 use Unicode::Normalize;
  26 use MARC::File::XML ( BinaryEncoding => 'utf-8' );
  27 use Equinox::Migration::SubfieldMapper;
  28 use Equinox::Migration::Utils qw/normalize_oclc_number/;
  29
  30 my $conf  = {}; # configuration hashref
  31 my $count = 0; my $scount = 0;
  32 my $start = time;
  33 $| = 1;
  34
  35 initialize($conf);
  36
  37 open OF, '>', $conf->{output} or die "$0: cannot open output file $conf->{output}: $!\n";
  38 open XF, '>', $conf->{exception} or die "$0: cannot open exception file $conf->{exception}: $!\n";
  39
  40 for my $file (@ARGV) {
  41     print XF "Processing $file\n";
  42
  43     my $batch = MARC::Batch->new($conf->{marctype}, $file);
  44     $batch->strict_off();
  45     $batch->warnings_off();
  46
  47     my $record;
  48     while ( 1 ) {
  49         eval { $record = $batch->next; };
  50         if ($@) {
  51             import MARC::File::XML;
  52             print "skipping bad record: $@\n";
  53             next;
  54         }
  55         last unless $record;
  56         $count++; progress_ticker();
  57         my $marc = undef;
  58         unless ( defined $record )
  59           { dump_exception($marc); next; }
  60
  61         my $id = $record->field($conf->{tag});
  62         unless ($id) {
  63             print XF "ERROR: Record $count in $file is missing a ",
  64               $conf->{tag}, " field.\n", $record->as_formatted(), "\n=====\n";
  65             next;
  66         }
  67
  68         # populate and normalize marc
  69         $marc = populate_marc($record, $id);
  70         # check for manual exclusion
  71         next if this_record_is_excluded($record, $marc);
  72         normalize_marc($marc);
  73         unless (marc_isvalid($marc))
  74           { dump_exception($marc); next; }
  75
  76         # if everything looks good, score it and dump fingerprints
  77         score_marc($marc, $record);
  78         dump_fingerprints_score_id($marc);
  79         $scount++; progress_ticker();
  80     }
  81 }
  82
  83 print "\nSuccessfully processed:\t$count\n" unless $conf->{quiet};
  84
  85 =head2 populate_marc
  86
  87 Constructs a hash containing the relevant MARC data for a record and
  88 returns a reference to it.
  89
  90 =cut
  91
  92 sub populate_marc {
  93     my ($record, $id) = @_;
  94     my %marc = (); $marc{isbns} = [];
  95
  96     # id, stringified
  97     $marc{id} = $id->as_string($conf->{subfield});
  98
  99     # record_type, bib_lvl
 100     $marc{record_type} = substr($record->leader, 6, 1);
 101     $marc{bib_lvl}     = substr($record->leader, 7, 1);
 102
 103     # date1, date2
 104     my $my_008 = $record->field('008');
 105     my @my_007 = $record->field('007');
 106     my $my_006 = $record->field('006');
 107     $marc{tag008} = $my_008->as_string() if ($my_008);
 108     if (defined $marc{tag008}) {
 109         unless (length $marc{tag008} == 40) {
 110             $marc{tag008} = $marc{tag008} . ('|' x (40 - length($marc{tag008})));
 111             print XF ">> Short 008 padded to ",length($marc{tag008})," at rec $count\n";
 112         }
 113         $marc{date1} = substr($marc{tag008},7,4) if ($marc{tag008});
 114         $marc{date2} = substr($marc{tag008},11,4) if ($marc{tag008}); # UNUSED
 115     }
 116     unless ($marc{date1} and $marc{date1} =~ /\d{4}/) {
 117         my $my_260 = $record->field('260');
 118         if ($my_260 and $my_260->subfield('c')) {
 119             my $date1 = $my_260->subfield('c');
 120             $date1 =~ s/\D//g;
 121             if (defined $date1 and $date1 =~ /\d{4}/) {
 122                 $marc{date1} = $date1;
 123                 $marc{fudgedate} = 1;
 124                 print XF ">> using 260c as date1 at rec $count\n";
 125             }
 126         }
 127     }
 128     $marc{tag006} = $my_006->as_string() if ($my_006);
 129     $marc{tag007} = \@my_007 if (@my_007);
 130     $marc{audioformat}='';
 131     $marc{videoformat}='';
 132     foreach(@my_007)
 133     {
 134         if(substr($_->data(),0,1) eq 's' && $marc{audioformat} eq '')
 135         {
 136             $marc{audioformat} = substr($_->data(),3,1) unless (length $_->data() < 4);
 137         }
 138         elsif(substr($_->data(),0,1) eq 'v' && $marc{videoformat} eq '')
 139         {
 140             $marc{videoformat} = substr($_->data(),4,1) unless (length $_->data() < 5);
 141         }
 142     }
 143     #print "$marc{audioformat}\n";
 144     #print "$marc{videoformat}\n";
 145
 146     # item_form
 147     $marc{item_form}='';
 148     if ( $marc{record_type} =~ /[gkroef]/ ) { # MAP, VIS
 149         $marc{item_form} = substr($marc{tag008},29,1) if ($marc{tag008} && (length $marc{tag008} > 29 ));
 150     } else {
 151         $marc{item_form} = substr($marc{tag008},23,1) if ($marc{tag008} && (length $marc{tag008} > 23 ));
 152     }
 153     #fall through to 006 if 008 doesn't have info for item form
 154     if ($marc{item_form} eq '|')
 155     {
 156         $marc{item_form} = substr($marc{tag006},6,1) if ($marc{tag006} && (length $marc{tag006} > 6 ));
 157     }
 158
 159     # isbns
 160     my @isbns = $record->field('020') if $record->field('020');
 161     push @isbns, $record->field('024') if $record->field('024');
 162     for my $f ( @isbns ) {
 163         push @{ $marc{isbns} }, $1 if ( defined $f->subfield('a') and
 164                                         $f->subfield('a')=~/(\S+)/ );
 165     }
 166
 167     # author
 168     for my $rec_field (100, 110, 111) {
 169         if ($record->field($rec_field)) {
 170             $marc{author} = $record->field($rec_field)->subfield('a');
 171             last;
 172         }
 173     }
 174
 175     # oclc
 176     $marc{oclc} = [];
 177     if ($record->field('001') &&
 178         $record->field('003') &&
 179         $record->field('003')->as_string() =~ /OCo{0,1}LC/ &&
 180         defined normalize_oclc_number($record->field('001')->as_string())) {
 181         push @{ $marc{oclc} }, normalize_oclc_number($record->field('001')->as_string());
 182     }
 183     for ($record->field('035')) {
 184         my $oclc = $_->subfield('a');
 185         if (defined $oclc &&
 186             ($oclc =~ /\(OCoLC\)/ || $oclc =~ /(ocm|ocl7|ocn|on)/) &&
 187             defined normalize_oclc_number($oclc)) {
 188             push @{ $marc{oclc} }, normalize_oclc_number($oclc);
 189         }
 190     }
 191
 192     if ($record->field('999')) {
 193         my $koha_bib_id = $record->field('999')->subfield('c');
 194         $marc{koha_bib_id} = $koha_bib_id if defined $koha_bib_id and $koha_bib_id =~ /^\d+$/;
 195     }
 196
 197     # "Accompanying material" and check for "copy" (300)
 198     if ($record->field('300')) {
 199         $marc{accomp} = $record->field('300')->subfield('e');
 200         $marc{tag300a} = $record->field('300')->subfield('a');
 201     }
 202
 203     # issn, lccn, title, desc, pages, pub, pubyear, edition
 204     $marc{lccn} = $record->field('010')->subfield('a') if $record->field('010');
 205     $marc{issn} = $record->field('022')->subfield('a') if $record->field('022');
 206     $marc{desc} = $record->field('300')->subfield('a') if $record->field('300');
 207     $marc{pages} = $1 if (defined $marc{desc} and $marc{desc} =~ /(\d+)/);
 208     $marc{title} = $record->field('245')->subfield('a')
 209       if $record->field('245');
 210     $marc{title} .= ' ' . $record->field('245')->subfield('b')
 211       if ($record->field('245') and
 212           $record->field('245')->subfield('b') and
 213           not $conf->{ignoresubtitle});
 214     $marc{edition} = $record->field('250')->subfield('a')
 215       if $record->field('250');
 216     if ($record->field('260')) {
 217         $marc{publisher} = $record->field('260')->subfield('b');
 218         $marc{pubyear} = $record->field('260')->subfield('c');
 219         $marc{pubyear} =
 220           (defined $marc{pubyear} and $marc{pubyear} =~ /(\d{4})/) ? $1 : '';
 221     }
 222     return \%marc;
 223 }
 224
 225
 226
 227 =head2 normalize_marc
 228
 229 Gently massages your data.
 230
 231 =cut
 232
 233 sub normalize_marc {
 234     my ($marc) = @_;
 235
 236     $marc->{record_type }= 'a' if ($marc->{record_type} eq ' ');
 237     if ($marc->{title}) {
 238         $marc->{title} = NFD($marc->{title});
 239         $marc->{title} =~ s/[\x{80}-\x{ffff}]//go;
 240         $marc->{title} = lc($marc->{title});
 241         $marc->{title} =~ s/\W+$//go;
 242     }
 243     if ($marc->{author}) {
 244         $marc->{author} = NFD($marc->{author});
 245         $marc->{author} =~ s/[\x{80}-\x{ffff}]//go;
 246         $marc->{author} = lc($marc->{author});
 247         $marc->{author} =~ s/\W+$//go;
 248         if ($marc->{author} =~ /^(\w+)/) {
 249             $marc->{author} = $1;
 250         }
 251     }
 252     if ($marc->{publisher}) {
 253         $marc->{publisher} = NFD($marc->{publisher});
 254         $marc->{publisher} =~ s/[\x{80}-\x{ffff}]//go;
 255         $marc->{publisher} = lc($marc->{publisher});
 256         $marc->{publisher} =~ s/\W+$//go;
 257         if ($marc->{publisher} =~ /^(\w+)/) {
 258             $marc->{publisher} = $1;
 259         }
 260     }
 261     return $marc;
 262 }
 263
 264
 265
 266 =head2 marc_isvalid
 267
 268 Checks MARC record to see if neccessary fingerprinting data is
 269 available
 270
 271 =cut
 272
 273 sub marc_isvalid {
 274     my ($marc) = @_;
 275     return 1 if ($marc->{item_form} and ($marc->{date1} =~ /\d{4}/) and
 276                  $marc->{record_type} and $marc->{bib_lvl} and $marc->{title});
 277     return 0;
 278 }
 279
 280
 281 =head2 score_marc
 282
 283 Assign a score to the record based on various criteria.
 284
 285 Score is constructed by pushing elements onto a list, via a dispatch
 286 table.  This allows order of fingerprints in the output file to be
 287 varied.
 288
 289 =cut
 290
 291 sub score_marc {
 292     my ($marc, $record) = @_;
 293     my @score = ();
 294     my $json = '{';
 295
 296     #----------------------------------
 297     # static criteria scoring
 298     #----------------------------------
 299     $marc->{misc_score} = 999;
 300     $marc->{age_score}  = 999999999999;
 301
 302     # -1 if 008 has been padded, -2 if it doesn't exist
 303     if ($marc->{tag008})
 304       { $marc->{misc_score}-- if ($marc->{tag008} =~ /\|$/) }
 305     else
 306       { $marc->{misc_score} -= 2 }
 307     # -1 if date has been pulled from 260
 308     $marc->{misc_score}-- if $marc->{fudgedate};
 309     # -1 if this is a copy record
 310     $marc->{misc_score}--
 311       if (defined $marc->{tag300a} and $marc->{tag300a} =~ /copy/i);
 312
 313     # subtract record id if we want older records to win
 314     #$marc->{age_score} -= $marc->{id} unless ($conf->{newwins});
 315     # handle arbitrary adjustments
 316     $marc->{age_score} = 1;
 317     if ($conf->{'arbitrarily-lose-above'}) {
 318         $marc->{age_score} = 0
 319           if ($marc->{id} >= $conf->{'arbitrarily-lose-above'});
 320     }
 321     if ($conf->{'arbitrarily-lose-below'}) {
 322         $marc->{age_score} = 0
 323           if ($marc->{id} <= $conf->{'arbitrarily-lose-below'});
 324     }
 325
 326     #----------------------------------
 327     # dynamic calculated scoring
 328     #----------------------------------
 329     my %scores_code = (
 330       oclc    => sub { return $marc->{oclc}[0] ? 1 : 0 },
 331       dlc     => sub {
 332           if ($record->field('040') and $record->field('040')->subfield('a'))
 333             { return scalar($record->subfield( '040', 'a')) =~ /dlc/io ? 1 : 0 }
 334           else { return 0 }
 335       },
 336       num_650 => sub {
 337           if ($record->field('650')) {
 338               # can't say "scalar $record->field('650')"; MARC::Record
 339               # behaves differently in list/scalar contexts
 340               my @tags = $record->field('650');
 341               return sprintf("%04d", scalar @tags)
 342           } else { return '0000' }
 343       },
 344       num_tags=> sub { return sprintf( '%04d', scalar( $record->fields ) ) },
 345       enc_lvl => sub {
 346         my $enc = substr($record->leader, 17, 1) || 'u';
 347         my %levels = ( ' ' => 9, 1 => 8, 2 => 7,  3  => 6,  4  => 5, 5 => 4,
 348                        6   => 3, 7 => 2, 8 => 1, 'u' => 0, 'z' => 0 );
 349         return $levels{$enc} || 0;
 350     }
 351                       );
 352
 353     #----------------------------------
 354     # assemble and store scores
 355     #----------------------------------
 356     for ( @{ $conf->{dyn_scores} } ) {
 357         push @score, $scores_code{$_}->($marc, $record);
 358         $json .= $_ . ':' . $score[-1] . ',';
 359     }
 360     $json .= 'misc:' . $marc->{misc_score} . '}';
 361
 362     my $compact = join('', $marc->{age_score}, $marc->{misc_score}, @score);
 363     $marc->{score} = "$compact\t$json";
 364 }
 365
 366 =head2 dump_fingerprints
 367
 368 =cut
 369
 370 sub dump_fingerprints {
 371     my ($marc) = @_;
 372
 373     if ($conf->{fingerprints}{baseline}) {
 374         print OF join("\t", $marc->{score}, $marc->{id}, 'baseline',
 375                       $marc->{item_form}, $marc->{date1}, $marc->{record_type},
 376                       $marc->{bib_lvl}, $marc->{title}), "\n";
 377     }
 378
 379     if ($conf->{fingerprints}{oclc} and scalar @{$marc->{oclc} }) {
 380         for (@{$marc->{oclc} }) {
 381             print OF join("\t", $marc->{score}, $marc->{id}, "oclc",
 382                           $marc->{item_form}, $marc->{date1},
 383                           $marc->{record_type}, $marc->{bib_lvl},
 384                           $marc->{title}, $_, "\n");
 385         }
 386     }
 387
 388     if ($conf->{fingerprints}{koha_bib_id} and exists $marc->{koha_bib_id}) {
 389         print OF join("\t", $marc->{score}, $marc->{id}, "z_koha_bib_id",
 390                       $marc->{item_form}, $marc->{date1},
 391                       $marc->{record_type},
 392                       $marc->{bib_lvl}, $marc->{title},
 393                       $marc->{koha_bib_id}), "\n";
 394     }
 395
 396     if ($conf->{fingerprints}{isbn}) {
 397         if ((scalar @{ $marc->{isbns} } > 0) and $marc->{pages}) {
 398             foreach my $isbn ( @{ $marc->{isbns}} ) {
 399                 print OF join("\t", $marc->{score}, $marc->{id}, "isbn",
 400                               $marc->{item_form}, $marc->{date1},
 401                               $marc->{record_type},
 402                               $marc->{bib_lvl}, $marc->{title},
 403                               $isbn, $marc->{pages}), "\n";
 404             }
 405         }
 406     }
 407
 408     if ($conf->{fingerprints}{edition} and $marc->{edition} and $marc->{author}) {
 409         print OF join("\t", $marc->{score}, $marc->{id}, "edition",
 410                       $marc->{item_form}, $marc->{date1},
 411                       $marc->{record_type}, $marc->{bib_lvl},
 412                       $marc->{title}, $marc->{author}, $marc->{edition}), "\n";
 413     }
 414
 415     if ($conf->{fingerprints}{issn} and $marc->{issn}) {
 416         print OF join("\t", $marc->{score}, $marc->{id}, "issn",
 417                       $marc->{item_form}, $marc->{date1},
 418                       $marc->{record_type}, $marc->{bib_lvl},
 419                       $marc->{title}, $marc->{issn}), "\n";
 420     }
 421
 422     if ($conf->{fingerprints}{lccn} and $marc->{lccn}) {
 423         print OF join("\t", $marc->{score}, $marc->{id}, "lccn",
 424                       $marc->{item_form}, $marc->{date1},
 425                       $marc->{record_type}, $marc->{bib_lvl},
 426                       $marc->{title}, $marc->{lccn}) ,"\n";
 427     }
 428
 429     if ($conf->{fingerprints}{accomp} and $marc->{accomp}) {
 430         print OF join("\t", $marc->{score}, $marc->{id}, "accomp",
 431                       $marc->{item_form}, $marc->{date1},
 432                       $marc->{record_type}, $marc->{bib_lvl},
 433                       $marc->{title}, $marc->{accomp}) ,"\n";
 434     }
 435
 436     if ($conf->{fingerprints}{authpub} and $marc->{author} and
 437         $marc->{publisher} and $marc->{pubyear} and $marc->{pages}) {
 438         print OF join("\t", $marc->{score}, $marc->{id}, "authpub",
 439                       $marc->{item_form}, $marc->{date1},
 440                       $marc->{record_type}, $marc->{bib_lvl},
 441                       $marc->{title}, $marc->{author},
 442                       $marc->{publisher}, $marc->{pubyear},
 443                       $marc->{pages}), "\n";
 444     }
 445 }
 446
 447 sub dump_fingerprints_score_id {
 448     my ($marc) = @_;
 449
 450     if ($conf->{fingerprints}{baseline}) {
 451         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, 'baseline',
 452                       $marc->{item_form}, $marc->{date1}, $marc->{record_type},
 453                       $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat}, $marc->{title}), "\n";
 454     }
 455
 456     if ($conf->{fingerprints}{oclc} and scalar @{$marc->{oclc} }) {
 457         for (@{$marc->{oclc} }) {
 458             print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "oclc",
 459                           $marc->{item_form}, $marc->{date1},
 460                           $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 461                           $marc->{title}, $_, "\n");
 462         }
 463     }
 464
 465     if ($conf->{fingerprints}{koha_bib_id} and exists $marc->{koha_bib_id}) {
 466         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "z_koha_bib_id",
 467                       $marc->{item_form}, $marc->{date1},
 468                       $marc->{record_type},
 469                       $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat}, $marc->{title},
 470                       $marc->{koha_bib_id}), "\n";
 471     }
 472
 473     if ($conf->{fingerprints}{isbn}) {
 474         if ((scalar @{ $marc->{isbns} } > 0) and $marc->{pages}) {
 475             foreach my $isbn ( @{ $marc->{isbns}} ) {
 476                 print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "isbn",
 477                               $marc->{item_form}, $marc->{date1},
 478                               $marc->{record_type},
 479                               $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat}, $marc->{title},
 480                               $isbn, $marc->{pages}), "\n";
 481             }
 482         }
 483     }
 484
 485     if ($conf->{fingerprints}{edition} and $marc->{edition} and $marc->{author}) {
 486         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "edition",
 487                       $marc->{item_form}, $marc->{date1},
 488                       $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 489                       $marc->{title}, $marc->{author}, $marc->{edition}), "\n";
 490     }
 491
 492     if ($conf->{fingerprints}{issn} and $marc->{issn}) {
 493         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "issn",
 494                       $marc->{item_form}, $marc->{date1},
 495                       $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 496                       $marc->{title}, $marc->{issn}), "\n";
 497     }
 498
 499     if ($conf->{fingerprints}{lccn} and $marc->{lccn}) {
 500         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "lccn",
 501                       $marc->{item_form}, $marc->{date1},
 502                       $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 503                       $marc->{title}, $marc->{lccn}) ,"\n";
 504     }
 505
 506     if ($conf->{fingerprints}{accomp} and $marc->{accomp}) {
 507         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "accomp",
 508                       $marc->{item_form}, $marc->{date1},
 509                       $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 510                       $marc->{title}, $marc->{accomp}) ,"\n";
 511     }
 512
 513     if ($conf->{fingerprints}{authpub} and $marc->{author} and
 514         $marc->{publisher} and $marc->{pubyear} and $marc->{pages}) {
 515         print OF join("\t", sortvalfromid($marc->{id}),"json", $marc->{id}, "authpub",
 516                       $marc->{item_form}, $marc->{date1},
 517                       $marc->{record_type}, $marc->{bib_lvl},$marc->{audioformat},$marc->{videoformat},
 518                       $marc->{title}, $marc->{author},
 519                       $marc->{publisher}, $marc->{pubyear},
 520                       $marc->{pages}), "\n";
 521     }
 522 }
 523
 524 sub sortvalfromid
 525 {
 526     my $sortval = shift;
 527     while(length($sortval)<17)
 528     {
 529         $sortval = '0'.$sortval;
 530     }
 531     return $sortval;
 532 }
 533
 534 sub dump_fingerprints_hash_score {
 535     my ($marc) = @_;
 536
 537     if ($conf->{fingerprints}{baseline}) {
 538         my $string = join("", 'baseline',
 539                       $marc->{item_form}, $marc->{date1}, $marc->{record_type},
 540                       $marc->{bib_lvl}, $marc->{title});
 541         $string =~ s/[^A-Za-z0-9]//g;
 542         $string = sha1_base64($string);
 543         print OF join("\t", $string,"json", $marc->{id}, 'baseline',
 544                       $marc->{item_form}, $marc->{date1}, $marc->{record_type},
 545                       $marc->{bib_lvl}, $marc->{title}), "\n";
 546     }
 547
 548     if ($conf->{fingerprints}{oclc} and scalar @{$marc->{oclc} }) {
 549         for (@{$marc->{oclc} }) {
 550             my $string = join("", "oclc",
 551                           $marc->{item_form}, $marc->{date1},
 552                           $marc->{record_type}, $marc->{bib_lvl},
 553                           $marc->{title}, $_);
 554             $string =~ s/[^A-Za-z0-9]//g;
 555             $string = sha1_base64($string);
 556             print OF join("\t", $string,"json", $marc->{id}, "oclc",
 557                           $marc->{item_form}, $marc->{date1},
 558                           $marc->{record_type}, $marc->{bib_lvl},
 559                           $marc->{title}, $_, "\n");
 560         }
 561     }
 562
 563     if ($conf->{fingerprints}{koha_bib_id} and exists $marc->{koha_bib_id}) {
 564         my $string = join("", "z_koha_bib_id",
 565                       $marc->{item_form}, $marc->{date1},
 566                       $marc->{record_type},
 567                       $marc->{bib_lvl}, $marc->{title},
 568                       $marc->{koha_bib_id});
 569         $string =~ s/[^A-Za-z0-9]//g;
 570         $string = sha1_base64($string);
 571         print OF join("\t", $string,"json", $marc->{id}, "z_koha_bib_id",
 572                       $marc->{item_form}, $marc->{date1},
 573                       $marc->{record_type},
 574                       $marc->{bib_lvl}, $marc->{title},
 575                       $marc->{koha_bib_id}), "\n";
 576     }
 577
 578     if ($conf->{fingerprints}{isbn}) {
 579         if ((scalar @{ $marc->{isbns} } > 0) and $marc->{pages}) {
 580             foreach my $isbn ( @{ $marc->{isbns}} ) {
 581                 my $string = join("", "isbn",
 582                               $marc->{item_form}, $marc->{date1},
 583                               $marc->{record_type},
 584                               $marc->{bib_lvl}, $marc->{title},
 585                               $isbn, $marc->{pages});
 586                 $string =~ s/[^A-Za-z0-9]//g;
 587                 $string = sha1_base64($string);
 588                 print OF join("\t", $string,"json", $marc->{id}, "isbn",
 589                               $marc->{item_form}, $marc->{date1},
 590                               $marc->{record_type},
 591                               $marc->{bib_lvl}, $marc->{title},
 592                               $isbn, $marc->{pages}), "\n";
 593             }
 594         }
 595     }
 596
 597     if ($conf->{fingerprints}{edition} and $marc->{edition} and $marc->{author}) {
 598         my $string = join("", "edition",
 599                       $marc->{item_form}, $marc->{date1},
 600                       $marc->{record_type}, $marc->{bib_lvl},
 601                       $marc->{title}, $marc->{author}, $marc->{edition});
 602         $string =~ s/[^A-Za-z0-9]//g;
 603         $string = sha1_base64($string);
 604         print OF join("\t", $string,"json", $marc->{id}, "edition",
 605                       $marc->{item_form}, $marc->{date1},
 606                       $marc->{record_type}, $marc->{bib_lvl},
 607                       $marc->{title}, $marc->{author}, $marc->{edition}), "\n";
 608     }
 609
 610     if ($conf->{fingerprints}{issn} and $marc->{issn}) {
 611         my $string = join("", "issn",
 612                       $marc->{item_form}, $marc->{date1},
 613                       $marc->{record_type}, $marc->{bib_lvl},
 614                       $marc->{title}, $marc->{issn});
 615         $string =~ s/[^A-Za-z0-9]//g;
 616         $string = sha1_base64($string);
 617         print OF join("\t", $string,"json", $marc->{id}, "issn",
 618                       $marc->{item_form}, $marc->{date1},
 619                       $marc->{record_type}, $marc->{bib_lvl},
 620                       $marc->{title}, $marc->{issn}), "\n";
 621     }
 622
 623     if ($conf->{fingerprints}{lccn} and $marc->{lccn}) {
 624         my $string = join("", "lccn",
 625                       $marc->{item_form}, $marc->{date1},
 626                       $marc->{record_type}, $marc->{bib_lvl},
 627                       $marc->{title}, $marc->{lccn});
 628         $string =~ s/[^A-Za-z0-9]//g;
 629         $string = sha1_base64($string);
 630         print OF join("\t", $string,"json", $marc->{id}, "lccn",
 631                       $marc->{item_form}, $marc->{date1},
 632                       $marc->{record_type}, $marc->{bib_lvl},
 633                       $marc->{title}, $marc->{lccn}) ,"\n";
 634     }
 635
 636     if ($conf->{fingerprints}{accomp} and $marc->{accomp}) {
 637         my $string = join("", "accomp",
 638                       $marc->{item_form}, $marc->{date1},
 639                       $marc->{record_type}, $marc->{bib_lvl},
 640                       $marc->{title}, $marc->{accomp});
 641         $string =~ s/[^A-Za-z0-9]//g;
 642         $string = sha1_base64($string);
 643         print OF join("\t", $string,"json", $marc->{id}, "accomp",
 644                       $marc->{item_form}, $marc->{date1},
 645                       $marc->{record_type}, $marc->{bib_lvl},
 646                       $marc->{title}, $marc->{accomp}) ,"\n";
 647     }
 648
 649     if ($conf->{fingerprints}{authpub} and $marc->{author} and
 650         $marc->{publisher} and $marc->{pubyear} and $marc->{pages}) {
 651         my $string = join("", "authpub",
 652                       $marc->{item_form}, $marc->{date1},
 653                       $marc->{record_type}, $marc->{bib_lvl},
 654                       $marc->{title}, $marc->{author},
 655                       $marc->{publisher}, $marc->{pubyear},
 656                       $marc->{pages});
 657         $string =~ s/[^A-Za-z0-9]//g;
 658         $string = sha1_base64($string);
 659         print OF join("\t", $string,"json", $marc->{id}, "authpub",
 660                       $marc->{item_form}, $marc->{date1},
 661                       $marc->{record_type}, $marc->{bib_lvl},
 662                       $marc->{title}, $marc->{author},
 663                       $marc->{publisher}, $marc->{pubyear},
 664                       $marc->{pages}), "\n";
 665     }
 666 }
 667
 668
 669
 670 =head2 dump_exception
 671
 672 Write line of exception report
 673
 674 =cut
 675
 676 sub dump_exception {
 677     my ($marc, $msg) = @_;
 678     unless (defined $marc) {
 679         print XF "Undefined record at line $count; likely bad XML\n";
 680         return;
 681     }
 682
 683     print XF "Record ", $marc->{id}, " excluded: ";
 684     if (defined $msg) {
 685         print XF "$msg\n";
 686         return
 687     }
 688
 689     print XF "missing item_form; " unless ($marc->{item_form});
 690     unless (defined $marc->{date1})
 691       { print XF "missing date1; " }
 692     else
 693       { print XF "invalid date1: '", $marc->{date1}, "'; "
 694           unless ($marc->{date1} =~ /\d{4}/); }
 695     print XF "missing record_type; " unless ($marc->{record_type});
 696     print XF "missing bib_lvl; " unless ($marc->{bib_lvl});
 697     print XF "missing title " unless ($marc->{title});
 698     print XF "\n";
 699 }
 700
 701
 702 =head2 this_record_is_excluded
 703
 704 Returns 1 if the record B<is> and 0 if the record B<is not> excluded,
 705 according to the subfield mapping (generated via the C<--excludelist>
 706 option).
 707
 708 =cut
 709
 710 sub this_record_is_excluded {
 711     my ($rec, $marc) = @_;
 712     return 0 unless defined $conf->{excludelist};
 713
 714     for my $tag (keys %{ $conf->{excludelist}->{tags} }) {
 715         for my $sub (keys %{$conf->{excludelist}->{tags}{$tag}}) {
 716             my $f = $conf->{excludelist}->field($tag, $sub);
 717
 718             # if this record doesn't have the right tag/sub, it can't be
 719             return 0 unless ($rec->field($tag) and $rec->field($tag)->subfield($sub));
 720             # but it does, so if there are no filters to check...
 721             unless ($conf->{excludelist}->filters($f))
 722               { dump_exception($marc, "exclusion $tag$sub"); return 1 }
 723
 724             my $sub_contents = $rec->field($tag)->subfield($sub);
 725             for my $filter (@{ $conf->{excludelist}->filters($f)}) {
 726                 if ($sub_contents =~ /$filter/i) {
 727                     # filter matches. no fp.
 728                     dump_exception($marc, "exclusion $tag$sub '$filter'");
 729                     return 1;
 730                 }
 731                 # no match, no exclude
 732                 return 0;
 733             }
 734         }
 735     }
 736 }
 737
 738 =head2 initialize
 739
 740 Performs boring script initialization. Handles argument parsing,
 741 mostly.
 742
 743 =cut
 744
 745 sub initialize {
 746     my ($c) = @_;
 747     my @missing = ();
 748
 749     # set mode on existing filehandles
 750     binmode(STDIN, ':utf8');
 751
 752     my $rc = GetOptions( $c,
 753                          'exception|x=s',
 754                          'output|o=s',
 755                          'prefix|p=s',
 756                          'marctype|m=s',
 757                          'subfield|s=s',
 758                          'tag|t=s',
 759                          'fingerprints=s',
 760                          'scores=s',
 761                          'arbitrarily-lose-above=i',
 762                          'arbitrarily-lose-below=i',
 763                          'newwins',
 764                          'excludelist=s',
 765                          'ignoresubtitle|i',
 766                          'quiet|q',
 767                          'help|h',
 768                        );
 769     show_help() unless $rc;
 770     show_help() if ($c->{help});
 771
 772     # check fingerprints list for validity
 773     if ($c->{fingerprints}) {
 774         my %fps = ();
 775         my %valid_fps = ( oclc => 1, isbn => 1, issn => 1, lccn => 1,
 776                           edition => 1, accomp => 1, authpub => 1,
 777                           baseline => 1, crap => 1,
 778                           koha_bib_id => 1,
 779                         );
 780         for (split /,/, $c->{fingerprints}) {
 781             die "Invalid fingerprint '$_'\n" unless $valid_fps{$_};
 782             $fps{$_} = 1;
 783         }
 784         $c->{fingerprints} = \%fps
 785     } else {
 786         $c->{fingerprints} = {oclc => 1, isbn => 1, edition => 1, issn => 1,
 787                               lccn => 1, accomp => 1, authpub => 1};
 788     }
 789
 790     # check scores list for validity
 791     if ($c->{scores}) {
 792         my %scores = ();
 793         my %valid_scores = ( oclc => 1, dlc => 1, num_650 => 1,
 794                              num_tags => 1, enc_lvl => 1,
 795                            );
 796         for (split /,/, $c->{scores}) {
 797             die "Invalid score mode '$_'\n" unless $valid_scores{$_};
 798             $scores{$_} = 1;
 799         }
 800         $c->{dyn_scores} = [split /,/, $c->{scores}];
 801         $c->{scores} = \%scores;
 802     } else {
 803         $c->{scores} = {oclc => 1, dlc => 1, num_650 => 1,
 804                         num_tags => 1, enc_lvl => 1};
 805         $c->{dyn_scores} = [ qw/oclc dlc num_650 num_tags enc_lvl/ ];
 806     }
 807
 808     # set defaults
 809     $c->{tag} = 903 unless defined $c->{tag};
 810     $c->{subfield} = 'a' unless defined $c->{subfield};
 811     $c->{marctype} = 'XML' unless defined $c->{marctype};
 812     if ($c->{prefix}) {
 813         $c->{output} = join('.',$c->{prefix},'fp');
 814         $c->{exception} = join('.',$c->{prefix},'fp','ex');
 815     }
 816
 817     # get SFM object if excludelist was specified
 818     if ($c->{excludelist}) {
 819         $c->{excludelist} =
 820           Equinox::Migration::SubfieldMapper->new( file => $c->{excludelist} );
 821     }
 822
 823     my @keys = keys %{$c};
 824     show_help() unless (@ARGV and @keys);
 825     for my $key ('tag', 'subfield', 'output', 'exception')
 826       { push @missing, $key unless $c->{$key} }
 827     if (@missing) {
 828         print "Required option: ", join(', ', @missing), " missing!\n";
 829         show_help();
 830     }
 831 }
 832
 833
 834 =head2 progress_ticker
 835
 836 =cut
 837
 838 sub progress_ticker {
 839     return if $conf->{quiet};
 840     printf("\r> %d recs seen; %d processed", $count, $scount);
 841     printf(" (%d/s)", ($count / (time - $start + 1)))
 842       if ($count % 500 == 0);
 843 }
 844
 845 =head2 show_help
 846
 847 Display usage message when things go wrong
 848
 849 =cut
 850
 851 sub show_help {
 852 print <<HELP;
 853 Usage is: $0 [REQUIRED ARGS] [OPTIONS] <filelist>
 854 Req'd Arguments
 855   --output=<FILE>      -o  Output filename
 856   --exceptions=<FILE>  -x  Exception report filename
 857        or
 858   --prefix=<PREFIX>>   -p  Shared prefix for output/exception files. Will
 859                            produce PREFIX.fp and PREFIX.fp.ex
 860 Options
 861   --tag=N           -t  Which tag to use (default 903)
 862   --subfield=X      -s  Which subfield to use (default 'a')
 863   --quiet           -q  Don't write status messages to STDOUT
 864   --ignoresubtitle  -i  Ignore 245\$b and construct the title from 245\$a alone.
 865
 866   --fingerprints=LIST  Fingerprints to generate, comma separated
 867                        Default: oclc,isbn,edition,issn,lccn,accomp,authpub
 868                        Others:  baseline,koha_bib_id
 869   --excludelist=FILE   Name of fingerprints exclusions file
 870
 871   --scores=LIST  Scores to calculate, comma separated
 872                  Default: oclc,dlc,num_650,num_tags,enc_level
 873   --newwins      New record IDs score higher (default is old wins)
 874   --arbitrarily-lose-above
 875   --arbitrarily-lose-below
 876   --arbitrarily-decrease-score-by
 877       Modify fingerprint scoring of records whose EG id is above or below a
 878       given value, inclusive (so 5 is <= 5 or >= 5) such that they lose.
 879
 880   --marctype=TYPE Defaults to 'XML'
 881 HELP
 882 exit 1;
 883 }