misc/link_bibs_to_authorities.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7
   8     # find Koha's Perl modules
   9     # test carefully before changing this
  10     use FindBin;
  11     eval { require "$FindBin::Bin/kohalib.pl" };
  12 }
  13
  14 use C4::Context;
  15 use C4::Biblio;
  16 use Getopt::Long;
  17 use Pod::Usage;
  18 use Data::Dumper;
  19 use Time::HiRes qw/time/;
  20 use POSIX qw/strftime ceil/;
  21 use Module::Load::Conditional qw(can_load);
  22
  23 sub usage {
  24     pod2usage( -verbose => 2 );
  25     exit;
  26 }
  27
  28 $| = 1;
  29
  30 # command-line parameters
  31 my $verbose     = 0;
  32 my $link_report = 0;
  33 my $test_only   = 0;
  34 my $want_help   = 0;
  35 my $auth_limit;
  36 my $bib_limit;
  37 my $commit = 100;
  38
  39 my $result = GetOptions(
  40     'v|verbose'      => \$verbose,
  41     't|test'         => \$test_only,
  42     'l|link-report'  => \$link_report,
  43     'a|auth-limit=s' => \$auth_limit,
  44     'b|bib-limit=s'  => \$bib_limit,
  45     'c|commit=i'     => \$commit,
  46     'h|help'         => \$want_help
  47 );
  48
  49 binmode( STDOUT, ":utf8" );
  50
  51 if ( not $result or $want_help ) {
  52     usage();
  53 }
  54
  55 my $linker_module =
  56   "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
  57 unless ( can_load( modules => { $linker_module => undef } ) ) {
  58     $linker_module = 'C4::Linker::Default';
  59     unless ( can_load( modules => { $linker_module => undef } ) ) {
  60         die "Unable to load linker module. Aborting.";
  61     }
  62 }
  63
  64 my $linker = $linker_module->new(
  65     {
  66         'auth_limit' => $auth_limit,
  67         'options'    => C4::Context->preference("LinkerOptions")
  68     }
  69 );
  70
  71 my $num_bibs_processed = 0;
  72 my $num_bibs_modified  = 0;
  73 my $num_bad_bibs       = 0;
  74 my %unlinked_headings;
  75 my %linked_headings;
  76 my %fuzzy_headings;
  77 my $dbh = C4::Context->dbh;
  78 $dbh->{AutoCommit} = 0;
  79 process_bibs( $linker, $bib_limit, $auth_limit, $commit );
  80 $dbh->commit();
  81
  82 exit 0;
  83
  84 sub process_bibs {
  85     my ( $linker, $bib_limit, $auth_limit, $commit ) = @_;
  86     my $bib_where = '';
  87     my $starttime = time();
  88     if ($bib_limit) {
  89         $bib_where = "WHERE $bib_limit";
  90     }
  91     my $sql =
  92       "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
  93     my $sth = $dbh->prepare($sql);
  94     $sth->execute();
  95     while ( my ($biblionumber) = $sth->fetchrow_array() ) {
  96         $num_bibs_processed++;
  97         process_bib( $linker, $biblionumber );
  98
  99         if ( not $test_only and ( $num_bibs_processed % $commit ) == 0 ) {
 100             print_progress_and_commit($num_bibs_processed);
 101         }
 102     }
 103
 104     if ( not $test_only ) {
 105         $dbh->commit;
 106     }
 107
 108     my $headings_linked   = 0;
 109     my $headings_unlinked = 0;
 110     my $headings_fuzzy    = 0;
 111     for ( values %linked_headings )   { $headings_linked   += $_; }
 112     for ( values %unlinked_headings ) { $headings_unlinked += $_; }
 113     for ( values %fuzzy_headings )    { $headings_fuzzy    += $_; }
 114
 115     my $endtime = time();
 116     my $totaltime = ceil (($endtime - $starttime) * 1000);
 117     $starttime = strftime('%D %T', localtime($starttime));
 118     $endtime = strftime('%D %T', localtime($endtime));
 119
 120     my $summary = <<_SUMMARY_;
 121
 122 Bib authority heading linking report
 123 =======================================================
 124 Linker module:                          $linker_module
 125 Run started at:                         $starttime
 126 Run ended at:                           $endtime
 127 Total run time:                         $totaltime ms
 128 Number of bibs checked:                 $num_bibs_processed
 129 Number of bibs modified:                $num_bibs_modified
 130 Number of bibs with errors:             $num_bad_bibs
 131 Number of headings linked:              $headings_linked
 132 Number of headings unlinked:            $headings_unlinked
 133 Number of headings fuzzily linked:      $headings_fuzzy
 134 _SUMMARY_
 135     $summary .= "\n****  Ran in test mode only  ****\n" if $test_only;
 136     print $summary;
 137
 138     if ($link_report) {
 139         my @keys;
 140         print <<_LINKED_HEADER_;
 141
 142 Linked headings (from most frequent to least):
 143 -------------------------------------------------------
 144
 145 _LINKED_HEADER_
 146
 147         @keys = sort {
 148             $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
 149         } keys %linked_headings;
 150         foreach my $key (@keys) {
 151             print "$key:\t" . $linked_headings{$key} . " occurrences\n";
 152         }
 153
 154         print <<_UNLINKED_HEADER_;
 155
 156 Unlinked headings (from most frequent to least):
 157 -------------------------------------------------------
 158
 159 _UNLINKED_HEADER_
 160
 161         @keys = sort {
 162             $unlinked_headings{$b} <=> $unlinked_headings{$a}
 163               or "\L$a" cmp "\L$b"
 164         } keys %unlinked_headings;
 165         foreach my $key (@keys) {
 166             print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
 167         }
 168
 169         print <<_FUZZY_HEADER_;
 170
 171 Fuzzily-matched headings (from most frequent to least):
 172 -------------------------------------------------------
 173
 174 _FUZZY_HEADER_
 175
 176         @keys = sort {
 177             $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
 178         } keys %fuzzy_headings;
 179         foreach my $key (@keys) {
 180             print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
 181         }
 182         print $summary;
 183     }
 184 }
 185
 186 sub process_bib {
 187     my $linker       = shift;
 188     my $biblionumber = shift;
 189
 190     my $bib = GetMarcBiblio({ biblionumber => $biblionumber });
 191     unless ( defined $bib ) {
 192         print
 193 "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
 194         $num_bad_bibs++;
 195         return;
 196     }
 197
 198     my $frameworkcode = GetFrameworkCode($biblionumber);
 199
 200     my ( $headings_changed, $results ) =
 201       LinkBibHeadingsToAuthorities( $linker, $bib, $frameworkcode );
 202     foreach my $key ( keys %{ $results->{'unlinked'} } ) {
 203         $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
 204     }
 205     foreach my $key ( keys %{ $results->{'linked'} } ) {
 206         $linked_headings{$key} += $results->{'linked'}->{$key};
 207     }
 208     foreach my $key ( keys %{ $results->{'fuzzy'} } ) {
 209         $fuzzy_headings{$key} += $results->{'fuzzy'}->{$key};
 210     }
 211
 212     if ($headings_changed) {
 213         if ($verbose) {
 214             my $title = substr( $bib->title, 0, 20 );
 215             printf(
 216                 "Bib %12d (%-20s): %3d headings changed\n",
 217                 $biblionumber,
 218                 $title,
 219                 $headings_changed
 220             );
 221         }
 222         if ( not $test_only ) {
 223             ModBiblio( $bib, $biblionumber, $frameworkcode, 1 );
 224             #Last param is to note ModBiblio was called from linking script and bib should not be linked again
 225             $num_bibs_modified++;
 226         }
 227     }
 228 }
 229
 230 sub print_progress_and_commit {
 231     my $recs = shift;
 232     $dbh->commit();
 233     print "... processed $recs records\n";
 234 }
 235
 236 =head1 NAME
 237
 238 link_bibs_to_authorities.pl
 239
 240 =head1 SYNOPSIS
 241
 242   link_bibs_to_authorities.pl
 243   link_bibs_to_authorities.pl -v
 244   link_bibs_to_authorities.pl -l
 245   link_bibs_to_authorities.pl --commit=1000
 246   link_bibs_to_authorities.pl --auth-limit=STRING
 247   link_bibs_to_authorities.pl --bib-limit=STRING
 248
 249 =head1 DESCRIPTION
 250
 251 This batch job checks each bib record in the Koha database and attempts to link
 252 each of its headings to the matching authority record.
 253
 254 =over 8
 255
 256 =item B<--help>
 257
 258 Prints this help
 259
 260 =item B<-v|--verbose>
 261
 262 Provide verbose log information (print the number of headings changed for each
 263 bib record).
 264
 265 =item B<-l|--link-report>
 266
 267 Provide a report of all the headings that were processed: which were matched,
 268 which were not, etc.
 269
 270 =item B<--auth-limit=S>
 271
 272 Only process those headings which match an authority record that matches the
 273 user-specified WHERE clause.
 274
 275 =item B<--bib-limit=S>
 276
 277 Only process those bib records that match the user-specified WHERE clause.
 278
 279 =item B<--commit=N>
 280
 281 Commit the results to the database after every N records are processed.
 282
 283 =item B<--test>
 284
 285 Only test the authority linking and report the results; do not change the bib
 286 records.
 287
 288 =back
 289
 290 =cut