8 # find Koha's Perl modules
9 # test carefully before changing this
11 eval { require "$FindBin::Bin/kohalib.pl" };
19 LinkBibHeadingsToAuthorities
22 use Getopt::Long qw( GetOptions );
23 use Pod::Usage qw( pod2usage );
24 use Time::HiRes qw( time );
25 use POSIX qw( ceil strftime );
26 use Module::Load::Conditional qw( can_load );
29 pod2usage( -verbose => 2 );
35 # command-line parameters
44 my $allowrelink = C4::Context->preference("CatalogModuleRelink") || '';
46 my $result = GetOptions(
47 'v|verbose' => \$verbose,
48 't|test' => \$test_only,
49 'l|link-report' => \$link_report,
50 'a|auth-limit=s' => \$auth_limit,
51 'b|bib-limit=s' => \$bib_limit,
52 'c|commit=i' => \$commit,
53 'g|tagtolink=i' => \$tagtolink,
54 'h|help' => \$want_help
57 binmode( STDOUT, ":encoding(UTF-8)" );
59 if ( not $result or $want_help ) {
64 "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
65 unless ( can_load( modules => { $linker_module => undef } ) ) {
66 $linker_module = 'C4::Linker::Default';
67 unless ( can_load( modules => { $linker_module => undef } ) ) {
68 die "Unable to load linker module. Aborting.";
72 my $linker = $linker_module->new(
74 'auth_limit' => $auth_limit,
75 'options' => C4::Context->preference("LinkerOptions")
79 my $num_bibs_processed = 0;
80 my $num_bibs_modified = 0;
82 my %unlinked_headings;
85 my $dbh = C4::Context->dbh;
86 $dbh->{AutoCommit} = 0;
87 process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink });
93 my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
94 my $tagtolink = $args->{tagtolink};
95 my $allowrelink = $args->{allowrelink};
97 my $starttime = time();
99 $bib_where = "WHERE $bib_limit";
102 "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
103 my $sth = $dbh->prepare($sql);
105 my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };
106 while ( my ($biblionumber) = $sth->fetchrow_array() ) {
107 $num_bibs_processed++;
108 process_bib( $linker, $biblionumber, $linker_args );
110 if ( not $test_only and ( $num_bibs_processed % $commit ) == 0 ) {
111 print_progress_and_commit($num_bibs_processed);
115 if ( not $test_only ) {
119 my $headings_linked = 0;
120 my $headings_unlinked = 0;
121 my $headings_fuzzy = 0;
122 for ( values %linked_headings ) { $headings_linked += $_; }
123 for ( values %unlinked_headings ) { $headings_unlinked += $_; }
124 for ( values %fuzzy_headings ) { $headings_fuzzy += $_; }
126 my $endtime = time();
127 my $totaltime = ceil (($endtime - $starttime) * 1000);
128 $starttime = strftime('%D %T', localtime($starttime));
129 $endtime = strftime('%D %T', localtime($endtime));
131 my $summary = <<_SUMMARY_;
133 Bib authority heading linking report
134 =======================================================
135 Linker module: $linker_module
136 Run started at: $starttime
137 Run ended at: $endtime
138 Total run time: $totaltime ms
139 Number of bibs checked: $num_bibs_processed
140 Number of bibs modified: $num_bibs_modified
141 Number of bibs with errors: $num_bad_bibs
142 Number of headings linked: $headings_linked
143 Number of headings unlinked: $headings_unlinked
144 Number of headings fuzzily linked: $headings_fuzzy
146 $summary .= "\n**** Ran in test mode only ****\n" if $test_only;
151 print <<_LINKED_HEADER_;
153 Linked headings (from most frequent to least):
154 -------------------------------------------------------
159 $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
160 } keys %linked_headings;
161 foreach my $key (@keys) {
162 print "$key:\t" . $linked_headings{$key} . " occurrences\n";
165 print <<_UNLINKED_HEADER_;
167 Unlinked headings (from most frequent to least):
168 -------------------------------------------------------
173 $unlinked_headings{$b} <=> $unlinked_headings{$a}
175 } keys %unlinked_headings;
176 foreach my $key (@keys) {
177 print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
180 print <<_FUZZY_HEADER_;
182 Fuzzily-matched headings (from most frequent to least):
183 -------------------------------------------------------
188 $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
189 } keys %fuzzy_headings;
190 foreach my $key (@keys) {
191 print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
199 my $biblionumber = shift;
201 my $tagtolink = $args->{tagtolink};
202 my $allowrelink = $args->{allowrelink};
203 my $bib = GetMarcBiblio({ biblionumber => $biblionumber });
204 unless ( defined $bib ) {
206 "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
211 my $frameworkcode = GetFrameworkCode($biblionumber);
213 my ( $headings_changed, $results ) =
214 LinkBibHeadingsToAuthorities( $linker, $bib, $frameworkcode, $allowrelink, $tagtolink );
215 foreach my $key ( keys %{ $results->{'unlinked'} } ) {
216 $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
218 foreach my $key ( keys %{ $results->{'linked'} } ) {
219 $linked_headings{$key} += $results->{'linked'}->{$key};
221 foreach my $key ( keys %{ $results->{'fuzzy'} } ) {
222 $fuzzy_headings{$key} += $results->{'fuzzy'}->{$key};
225 if ($headings_changed) {
227 my $title = substr( $bib->title, 0, 20 );
229 "Bib %12d (%-20s): %3d headings changed\n",
235 if ( not $test_only ) {
236 ModBiblio( $bib, $biblionumber, $frameworkcode, 1 );
237 #Last param is to note ModBiblio was called from linking script and bib should not be linked again
238 $num_bibs_modified++;
243 sub print_progress_and_commit {
246 print "... processed $recs records\n";
251 link_bibs_to_authorities.pl
255 link_bibs_to_authorities.pl
256 link_bibs_to_authorities.pl -v
257 link_bibs_to_authorities.pl -l
258 link_bibs_to_authorities.pl --commit=1000
259 link_bibs_to_authorities.pl --auth-limit=STRING
260 link_bibs_to_authorities.pl --bib-limit=STRING
261 link_bibs_to_authorities.pl -g=700
265 This batch job checks each bib record in the Koha database and attempts to link
266 each of its headings to the matching authority record.
274 =item B<-v|--verbose>
276 Provide verbose log information (print the number of headings changed for each
279 =item B<-l|--link-report>
281 Provide a report of all the headings that were processed: which were matched,
284 =item B<--auth-limit=S>
286 Only process those headings which match an authority record that matches the
287 user-specified WHERE clause.
289 =item B<--bib-limit=S>
291 Only process those bib records that match the user-specified WHERE clause.
295 Commit the results to the database after every N records are processed.
299 Only process those headings found in MARC field N.
303 Only test the authority linking and report the results; do not change the bib