better docstring

[migration-tools.git] / fingerprinter

diff --git a/fingerprinter b/fingerprinter
index ef5a293..1fc7260 100755 (executable)
--- a/fingerprinter
+++ b/fingerprinter
@@ -208,69 +208,51 @@ sub marc_isvalid {
 
 Assign a score to the record based on various criteria.
 
-Score is constructed by pushing elements onto a list. At the end of
-the routine, the list is flattened into a string via join();
+Score is constructed by pushing elements onto a list, via a dispatch
+table.  This allows order of fingerprints in the output file to be
+varied.
 
 =cut
 
 sub score_marc {
     my ($marc, $record) = @_;
     my @score = ();
-    my $chunk;
-
-    # Is this an OCLC record?
-    if ($conf->{scores}{oclc}) {
-        if ($record->field('008')) {
-            $chunk = $record->field('008')->as_string();
-            push @score, ( $chunk =~ /^o/i ? 1 : 0 );
-        } else {
-            push @score, 0;
-        }
-    }
-
-    # does 040a contain "dlc"?
-    if ($conf->{scores}{dlc}) {
-        if ($record->field('040') and $record->field('040')->subfield('a')) {
-            $chunk = $record->field('040')->subfield('a');
-            push @score, ( $chunk =~ /dlc/i ? 1 : 0 );
-        } else {
-            push @score, 0;
-        }
-    }
-
-    # number of 650 datafields
-    # zero-padded to 4 digits with printf
-    if ($conf->{scores}{num_650}) {
-        if ($record->field('650')) {
-            my @tags = $record->field('650');
-            push @score, scalar @tags;
-        } else {
-            push @score, '0000';
-        }
-    }
-
-    # number of tags in total
-    # zero-padded to 4 digits with printf
-    if ($conf->{scores}{num_tags}) {
-        my @tags = $record->fields;
-        push @score, scalar @tags;
-    }
-
-    # encoding level
-    if ($conf->{scores}{enc_lvl}) {
-        my $enc = substr($record->leader, 17, 1);
+    my $json = '{';
+
+    my %scores_code = (
+      oclc    => sub { return $marc->{oclc}[0] ? 1 : 0 },
+      dlc     => sub {
+          if ($record->field('040') and $record->field('040')->subfield('a'))
+            { return scalar($record->subfield( '040', 'a')) =~ /dlc/io ? 1 : 0 }
+          else { return 0 }
+      },
+      num_650 => sub {
+          if ($record->field('650')) {
+              # can't say "scalar $record->field('650')"; MARC::Record
+              # behaves differently in list/scalar contexts
+              my @tags = $record->field('650');
+              return sprintf("%04d", scalar @tags)
+          } else { return '0000' }
+      },
+      num_tags=> sub { return sprintf( '%04d', scalar( $record->fields ) ) },
+      enc_lvl => sub {
+        my $enc = substr($record->leader, 17, 1) || 'u';
         my %levels = ( ' ' => 9, 1 => 8, 2 => 7,  3  => 6,  4  => 5, 5 => 4,
                        6   => 3, 7 => 2, 8 => 1, 'u' => 0, 'z' => 0 );
-        if (defined $enc and $levels{$enc})
-          { push @score, $levels{$enc} }
-        else
-          { push @score, 0 }
+        return $levels{$enc} || 0;
+      }
+      );
+
+    for ( @{ $conf->{dyn_scores} } ) {
+        push @score, $scores_code{$_}->($marc, $record);
+        $json .= $_ . ':' . $score[-1] . ',';
     }
+    chop($json); # get rid of the trailing comma
+
+    $json .= '}';
 
-    # put score in marc hash
-    $marc->{score} = join('', '{oclc:', $score[0], ',dlc:', $score[1],
-                          ',num_650:', $score[2], ',num_tags:', $score[3],
-                          ',enc_lvl:', $score[4], '}');
+    my $compact = join('', @score);
+    $marc->{score} = "$compact\t$json";
 }
 
 =head2 dump_fingerprints
@@ -421,6 +403,7 @@ sub initialize {
         $c->{fingerprints} = {oclc => 1, isbn => 1, edition => 1, issn => 1,
                               lccn => 1, accomp => 1, authpub => 1};
     }
+
     # check scores list for validity
     if ($c->{scores}) {
         my %scores = ();
@@ -431,10 +414,12 @@ sub initialize {
             die "Invalid score mode '$_'\n" unless $valid_scores{$_};
             $scores{$_} = 1;
         }
+        $c->{dyn_scores} = [split /,/, $c->{scores}];
         $c->{scores} = \%scores;
     } else {
         $c->{scores} = {oclc => 1, dlc => 1, num_650 => 1,
                         num_tags => 1, enc_lvl => 1};
+        $c->{dyn_scores} = [ qw/oclc dlc num_650 num_tags enc_lvl/ ];
     }
 
     # set defaults if told to do so