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 );
 224             $num_bibs_modified++;
 225         }
 226     }
 227 }
 228
 229 sub print_progress_and_commit {
 230     my $recs = shift;
 231     $dbh->commit();
 232     print "... processed $recs records\n";
 233 }
 234
 235 =head1 NAME
 236
 237 link_bibs_to_authorities.pl
 238
 239 =head1 SYNOPSIS
 240
 241   link_bibs_to_authorities.pl
 242   link_bibs_to_authorities.pl -v
 243   link_bibs_to_authorities.pl -l
 244   link_bibs_to_authorities.pl --commit=1000
 245   link_bibs_to_authorities.pl --auth-limit=STRING
 246   link_bibs_to_authorities.pl --bib-limit=STRING
 247
 248 =head1 DESCRIPTION
 249
 250 This batch job checks each bib record in the Koha database and attempts to link
 251 each of its headings to the matching authority record.
 252
 253 =over 8
 254
 255 =item B<--help>
 256
 257 Prints this help
 258
 259 =item B<-v|--verbose>
 260
 261 Provide verbose log information (print the number of headings changed for each
 262 bib record).
 263
 264 =item B<-l|--link-report>
 265
 266 Provide a report of all the headings that were processed: which were matched,
 267 which were not, etc.
 268
 269 =item B<--auth-limit=S>
 270
 271 Only process those headings which match an authority record that matches the
 272 user-specified WHERE clause.
 273
 274 =item B<--bib-limit=S>
 275
 276 Only process those bib records that match the user-specified WHERE clause.
 277
 278 =item B<--commit=N>
 279
 280 Commit the results to the database after every N records are processed.
 281
 282 =item B<--test>
 283
 284 Only test the authority linking and report the results; do not change the bib
 285 records.
 286
 287 =back
 288
 289 =cut