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