11 LinkBibHeadingsToAuthorities
14 use Getopt::Long qw( GetOptions );
15 use Pod::Usage qw( pod2usage );
16 use Time::HiRes qw( time );
17 use POSIX qw( ceil strftime );
18 use Module::Load::Conditional qw( can_load );
21 pod2usage( -verbose => 2 );
27 # command-line parameters
36 my $allowrelink = C4::Context->preference("CatalogModuleRelink") || '';
38 my $result = GetOptions(
39 'v|verbose' => \$verbose,
40 't|test' => \$test_only,
41 'l|link-report' => \$link_report,
42 'a|auth-limit=s' => \$auth_limit,
43 'b|bib-limit=s' => \$bib_limit,
44 'c|commit=i' => \$commit,
45 'g|tagtolink=i' => \$tagtolink,
46 'h|help' => \$want_help
49 binmode( STDOUT, ":encoding(UTF-8)" );
51 if ( not $result or $want_help ) {
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.";
64 my $linker = $linker_module->new(
66 'auth_limit' => $auth_limit,
67 'options' => C4::Context->preference("LinkerOptions")
71 my $num_bibs_processed = 0;
72 my $num_bibs_modified = 0;
74 my %unlinked_headings;
77 my $dbh = C4::Context->dbh;
78 $dbh->{AutoCommit} = 0;
79 process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink });
85 my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
86 my $tagtolink = $args->{tagtolink};
87 my $allowrelink = $args->{allowrelink};
89 my $starttime = time();
91 $bib_where = "WHERE $bib_limit";
94 "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
95 my $sth = $dbh->prepare($sql);
97 my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };
98 while ( my ($biblionumber) = $sth->fetchrow_array() ) {
99 $num_bibs_processed++;
100 process_bib( $linker, $biblionumber, $linker_args );
102 if ( not $test_only and ( $num_bibs_processed % $commit ) == 0 ) {
103 print_progress_and_commit($num_bibs_processed);
107 if ( not $test_only ) {
111 my $headings_linked = 0;
112 my $headings_unlinked = 0;
113 my $headings_fuzzy = 0;
114 for ( values %linked_headings ) { $headings_linked += $_; }
115 for ( values %unlinked_headings ) { $headings_unlinked += $_; }
116 for ( values %fuzzy_headings ) { $headings_fuzzy += $_; }
118 my $endtime = time();
119 my $totaltime = ceil (($endtime - $starttime) * 1000);
120 $starttime = strftime('%D %T', localtime($starttime));
121 $endtime = strftime('%D %T', localtime($endtime));
123 my $summary = <<_SUMMARY_;
125 Bib authority heading linking report
126 =======================================================
127 Linker module: $linker_module
128 Run started at: $starttime
129 Run ended at: $endtime
130 Total run time: $totaltime ms
131 Number of bibs checked: $num_bibs_processed
132 Number of bibs modified: $num_bibs_modified
133 Number of bibs with errors: $num_bad_bibs
134 Number of headings linked: $headings_linked
135 Number of headings unlinked: $headings_unlinked
136 Number of headings fuzzily linked: $headings_fuzzy
138 $summary .= "\n**** Ran in test mode only ****\n" if $test_only;
143 print <<_LINKED_HEADER_;
145 Linked headings (from most frequent to least):
146 -------------------------------------------------------
151 $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
152 } keys %linked_headings;
153 foreach my $key (@keys) {
154 print "$key:\t" . $linked_headings{$key} . " occurrences\n";
157 print <<_UNLINKED_HEADER_;
159 Unlinked headings (from most frequent to least):
160 -------------------------------------------------------
165 $unlinked_headings{$b} <=> $unlinked_headings{$a}
167 } keys %unlinked_headings;
168 foreach my $key (@keys) {
169 print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
172 print <<_FUZZY_HEADER_;
174 Fuzzily-matched headings (from most frequent to least):
175 -------------------------------------------------------
180 $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
181 } keys %fuzzy_headings;
182 foreach my $key (@keys) {
183 print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
191 my $biblionumber = shift;
193 my $tagtolink = $args->{tagtolink};
194 my $allowrelink = $args->{allowrelink};
195 my $bib = GetMarcBiblio({ biblionumber => $biblionumber });
196 unless ( defined $bib ) {
198 "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
203 my $frameworkcode = GetFrameworkCode($biblionumber);
205 my ( $headings_changed, $results ) =
206 LinkBibHeadingsToAuthorities( $linker, $bib, $frameworkcode, $allowrelink, $tagtolink );
207 foreach my $key ( keys %{ $results->{'unlinked'} } ) {
208 $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
210 foreach my $key ( keys %{ $results->{'linked'} } ) {
211 $linked_headings{$key} += $results->{'linked'}->{$key};
213 foreach my $key ( keys %{ $results->{'fuzzy'} } ) {
214 $fuzzy_headings{$key} += $results->{'fuzzy'}->{$key};
217 if ($headings_changed) {
219 my $title = substr( $bib->title, 0, 20 );
221 "Bib %12d (%-20s): %3d headings changed\n",
227 if ( not $test_only ) {
228 ModBiblio( $bib, $biblionumber, $frameworkcode, { disable_autolink => 1 });
229 #Last param is to note ModBiblio was called from linking script and bib should not be linked again
230 $num_bibs_modified++;
235 sub print_progress_and_commit {
238 print "... processed $recs records\n";
243 link_bibs_to_authorities.pl
247 link_bibs_to_authorities.pl
248 link_bibs_to_authorities.pl -v
249 link_bibs_to_authorities.pl -l
250 link_bibs_to_authorities.pl --commit=1000
251 link_bibs_to_authorities.pl --auth-limit=STRING
252 link_bibs_to_authorities.pl --bib-limit=STRING
253 link_bibs_to_authorities.pl -g=700
257 This batch job checks each bib record in the Koha database and attempts to link
258 each of its headings to the matching authority record.
266 =item B<-v|--verbose>
268 Provide verbose log information (print the number of headings changed for each
271 =item B<-l|--link-report>
273 Provide a report of all the headings that were processed: which were matched,
276 =item B<--auth-limit=S>
278 Only process those headings which match an authority record that matches the
279 user-specified WHERE clause.
281 =item B<--bib-limit=S>
283 Only process those bib records that match the user-specified WHERE clause.
287 Commit the results to the database after every N records are processed.
291 Only process those headings found in MARC field N.
295 Only test the authority linking and report the results; do not change the bib