View | Details | Raw Unified | Return to bug 40308
Collapse All | Expand All

(-)a/misc/maintenance/fetch_oclc_dewey_linked_data.pl (-1 / +447 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Copyright (C) 2025 Dataly Tech
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::AuthoritiesMarc qw( GetAuthority ModAuthority );
23
use C4::Context         qw( preference );
24
use Koha::Authorities;
25
use Koha::Caches;
26
use Koha::ExternalContent::OCLC;
27
use Koha::Script;
28
29
use Getopt::Long qw( GetOptions :config no_auto_abbrev no_ignore_case );
30
use JSON         qw( from_json );
31
use LWP::UserAgent;
32
use MARC::Record;
33
use Pod::Usage qw( pod2usage );
34
35
binmode( STDOUT, ':encoding(UTF-8)' );
36
37
my @authtypecodes;
38
my $confirm = 0;
39
my $help;
40
my $force = 0;
41
my $language;
42
my $man;
43
my $verbose = 0;
44
my $where;
45
46
GetOptions(
47
    'a|authtypecode=s' => \@authtypecodes,
48
    'c|confirm'        => \$confirm,
49
    'h|help'           => \$help,
50
    'f|force'          => \$force,
51
    'l|language=s{1}'  => \$language,
52
    'man'              => \$man,
53
    'v|verbose'        => \$verbose,
54
    'w|where=s'        => \$where,
55
) or pod2usage(1);
56
57
pod2usage(1)               if $help;
58
pod2usage( -verbose => 2 ) if $man;
59
60
my %languages = (
61
    'de' => 'German',
62
    'en' => 'English',
63
    'fr' => 'French',
64
    'it' => 'Italian',
65
    'no' => 'Norwegian',
66
    'sv' => 'Swedish',
67
);
68
69
my $langcodes = join '|', sort keys %languages;
70
71
if ( $language and $language !~ /^($langcodes)$/ ) {
72
    print "Incorrect language code passed, must be one of: $langcodes\n";
73
    exit;
74
}
75
76
print "Running in dry-run mode as -c/--confirm is not passed\n" unless $confirm;
77
78
my $cache         = Koha::Caches->get_instance;
79
my $client_id     = C4::Context->preference('OCLCAPIWSKeyClientID');
80
my $client_secret = C4::Context->preference('OCLCAPIWSKeyClientSecret');
81
my $pref_language = C4::Context->preference('OCLCDeweyLinkedDataLanguage');
82
my $marcflavour   = C4::Context->preference('marcflavour');
83
my $scope         = 'deweyLinkedData';
84
85
$verbose and print "OCLCDeweyLinkedDataLanguage set to '$pref_language' ($languages{$pref_language})\n";
86
$verbose and print "Language overriden and set to '$language' ($languages{$language})\n" if $language;
87
$verbose and print "Option --force passed, will overwrite subfield data\n"               if $force;
88
89
my ( $access_token, $msg );
90
if ( $client_id and $client_secret ) {
91
    $verbose and print "Found OCLC Dewey Linked Data API Client ID and Secret\n";
92
    $verbose and print "Requesting an access token from OCLC's OAuth server\n";
93
    ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token(
94
        {
95
            scope => $scope,
96
        }
97
    );
98
    if ( defined $access_token ) {
99
        $verbose and print "Got token '$access_token' via $msg\n";
100
    } else {
101
        $verbose and print "Cannot obtain API token ($msg)\n";
102
        exit;
103
    }
104
} else {
105
    print "Cannot request an API access token from OCLC's OAuth server\n"
106
        . "An OCLC Dewey Linked Data API Client ID and Secret are required\n"
107
        . "Please fill in the OCLCAPIWSKeyClientID and OCLCAPIWSKeyClientSecret\n"
108
        . "System Preferences, then try again.\n";
109
    exit;
110
}
111
112
$verbose and print "Fetching auth types\n";
113
my $params = undef;
114
if (@authtypecodes) {
115
    $params = { authtypecode => { -in => \@authtypecodes } };
116
}
117
my @auth_types = Koha::Authority::Types->search($params)->as_list;
118
$verbose and print "Done fetching auth types\n";
119
120
my ( $ddc_fields_regex, $ddc_url_subfield );
121
if ( $marcflavour eq 'MARC21' ) {
122
    $ddc_fields_regex = '082|083';
123
    $ddc_url_subfield = '1';
124
} elsif ( $marcflavour eq 'UNIMARC' ) {
125
    $ddc_fields_regex = '676';
126
    $ddc_url_subfield = 'R';
127
}
128
my $ddc_descr_subfield = 'c';
129
130
# The regex below Covers DDC numbers like 270, 248.4819, T4--313
131
my $ddc_regex = '^((T([1-6])--([0-9]+)))$|^([0-9]{3})$|^(([0-9]{3})\.([0-9]+))$';
132
133
foreach my $authtype (@auth_types) {
134
135
    my $authtypecode = $authtype->authtypecode;
136
    $verbose and print "Fetching authorities of type '$authtypecode'\n";
137
    my $authorities = Koha::Authorities->search(
138
        { authtypecode => $authtypecode },
139
        { order_by     => { -asc => 'authid' } }
140
    );
141
    $authorities = $authorities->search( \$where ) if $where;
142
143
    my $count = $authorities->count;
144
    $verbose and print "Found $count authorit" . ( $count == 1 ? 'y' : 'ies' ) . "\n";
145
146
    while ( my $authority = $authorities->next ) {
147
        process_authority($authority);
148
    }
149
150
}
151
152
sub process_authority {
153
154
    my ($authority) = @_;
155
156
    my $authid   = $authority->authid;
157
    my $record   = GetAuthority($authid);
158
    my @fields   = $record->field($ddc_fields_regex);
159
    my $modified = 0;
160
161
    foreach my $field (@fields) {
162
163
        my ( $ddc_range_begin, $ddc_range_end );
164
165
        $ddc_range_begin = $field && $field->subfield('a');
166
        if ( $ddc_range_begin and $ddc_range_begin !~ /$ddc_regex/ ) {
167
            $verbose and print "auth $authid: invalid DDC number '$ddc_range_begin' in subfield \$a\n";
168
            next;
169
        }
170
171
        if (   ( $marcflavour eq 'MARC21' and $field->tag eq '083' )
172
            or ( $marcflavour eq 'UNIMARC' and $field->tag eq '676' ) )
173
        {
174
            $ddc_range_end = $field && $field->subfield('b');
175
            if ( $ddc_range_end and $ddc_range_end !~ /$ddc_regex/ ) {
176
                $verbose and print "auth $authid: invalid DDC number '$ddc_range_end' in subfield \$b\n";
177
                next;
178
            }
179
        }
180
181
        my $rec_ddc =
182
              $ddc_range_end
183
            ? $ddc_range_begin . '-' . $ddc_range_end
184
            : $ddc_range_begin
185
            if $ddc_range_begin;
186
187
        my $rec_ddc_url   = $field && $field->subfield($ddc_url_subfield);
188
        my $rec_ddc_descr = $field && $field->subfield($ddc_descr_subfield);
189
190
        if ( $rec_ddc and $rec_ddc_url and $rec_ddc_descr ) {
191
            $verbose and print "auth $authid: found DDC '$rec_ddc', LD URL '$rec_ddc_url'\n";
192
            $verbose and print "auth $authid: found DDC '$rec_ddc', LD Description '$rec_ddc_descr'\n";
193
            $verbose and print "auth $authid: skipping this field, as all data is present\n"   unless $force;
194
            $verbose and print "auth $authid: you can use --force to override this behavior\n" unless $force;
195
            next unless $force;
196
        }
197
198
        if ($rec_ddc) {
199
200
            $verbose and print "auth $authid: found DDC '$rec_ddc', searching for URI/URL/Description\n";
201
202
            # Trim leading 'T' (uppercase 't') from DDC number
203
            $rec_ddc =~ s/^T//;
204
205
            my ( $ddc_uri, $ddc_url, $ddc_descr );
206
207
            ##################################################################
208
            # Get DDC URI (retry automatically if the token expired)
209
            ##################################################################
210
            ( $ddc_uri, $msg ) = _get_ddc_uri( $access_token, $rec_ddc );
211
            if ( defined $ddc_uri ) {
212
                $verbose and print "auth $authid: found LD URI '$ddc_uri' via $msg\n";
213
            } elsif ( $msg eq 'Unauthorized' ) {
214
                $verbose and print "auth $authid: cannot obtain LD URI ($msg)\n";
215
                $verbose and print "auth $authid: our API access token has expired\n";
216
                $verbose and print "auth $authid: removing the expired token from cache\n";
217
                $cache->clear_from_cache("OCLC_access_token-$scope");
218
                $verbose and print "auth $authid: requesting a new access token\n";
219
                ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token(
220
                    {
221
                        scope => $scope,
222
                    }
223
                );
224
                if ( defined $access_token ) {
225
                    $verbose and print "got renewed access token '$access_token' via $msg\n";
226
                    $verbose and print "retrying LD URI fetch for DDC '$rec_ddc'\n";
227
                    ( $ddc_uri, $msg ) = _get_ddc_uri( $access_token, $rec_ddc );
228
                } else {
229
                    $verbose and print "Cannot obtain API token ($msg)\n";
230
                    exit;
231
                }
232
                redo;
233
            } elsif ( $msg eq 'not found' ) {
234
                $verbose and print "auth $authid: no LD URI found for DDC '$rec_ddc'\n";
235
236
                # skip this field, as no URI was returned (no further API lookups needed)
237
                $verbose and print "auth $authid: skipping this field\n";
238
                next;
239
            }
240
241
            ##################################################################
242
            # Get DDC URL (retry automatically if the token expired)
243
            ##################################################################
244
            ( $ddc_url, $msg ) = _get_ddc_url( $access_token, $rec_ddc );
245
            if ( defined $ddc_url ) {
246
                $verbose and print "auth $authid: found LD URL '$ddc_url' via $msg\n";
247
            } elsif ( $msg eq 'Unauthorized' ) {
248
                $verbose and print "auth $authid: cannot obtain LD URL ($msg)\n";
249
                $verbose and print "auth $authid: our API access token has expired\n";
250
                $verbose and print "auth $authid: removing the expired token from cache\n";
251
                $cache->clear_from_cache("OCLC_access_token-$scope");
252
                $verbose and print "auth $authid: requesting a new access token\n";
253
                ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token(
254
                    {
255
                        scope => $scope,
256
                    }
257
                );
258
                if ( defined $access_token ) {
259
                    $verbose and print "Got renewed access token '$access_token' via $msg\n";
260
                    $verbose and print "retrying LD URL fetch for DDC '$rec_ddc'\n";
261
                    ( $ddc_url, $msg ) = _get_ddc_url( $access_token, $rec_ddc );
262
                } else {
263
                    $verbose and print "Cannot obtain API token ($msg)\n";
264
                    exit;
265
                }
266
                redo;
267
            } elsif ( $msg eq 'not found' ) {
268
                $verbose and print "auth $authid: no LD URL found for DDC '$rec_ddc'\n";
269
            }
270
271
            ##################################################################
272
            # Get DDC Description (retry automatically if the token expired)
273
            ##################################################################
274
            my $lang = $language ? $language : undef;
275
            ( $ddc_descr, $msg ) = _get_ddc_descr( $access_token, $ddc_uri, $lang );
276
            if ( defined $ddc_descr ) {
277
                $verbose and print "auth $authid: found LD Description '$ddc_descr' via $msg\n";
278
            } elsif ( $msg eq 'Unauthorized' ) {
279
                $verbose and print "auth $authid: cannot obtain LD Description ($msg)\n";
280
                $verbose and print "auth $authid: our API access token has expired\n";
281
                $verbose and print "auth $authid: removing the expired token from cache\n";
282
                $cache->clear_from_cache("OCLC_access_token-$scope");
283
                $verbose and print "auth $authid: requesting a new access token\n";
284
                ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token(
285
                    {
286
                        scope => $scope,
287
                    }
288
                );
289
                if ( defined $access_token ) {
290
                    $verbose and print "Got renewed access token '$access_token' via $msg\n";
291
                    $verbose and print "retrying LD Description fetch for DDC '$rec_ddc'\n";
292
                    ( $ddc_descr, $msg ) = _get_ddc_descr( $access_token, $ddc_uri, $lang );
293
                } else {
294
                    $verbose and print "Cannot obtain API token ($msg)\n";
295
                    exit;
296
                }
297
                redo;
298
            } elsif ( $msg eq 'not found' ) {
299
                $verbose and print "auth $authid: no LD Description found for DDC '$rec_ddc'\n";
300
            }
301
302
            if ( $confirm or $force ) {
303
                $field->update( $ddc_url_subfield => $ddc_url );
304
305
                # MARC21 authority field 082 does not have a $c subfield,
306
                # so we only update the description if the current field
307
                # is 083 (MARC21) or 676 (UNIMARC)
308
                if ( $field->tag eq '083' or $field->tag eq '676' ) {
309
                    $field->update( $ddc_descr_subfield => $ddc_descr );
310
                }
311
                $modified = 1;
312
            }
313
314
        }
315
316
    }
317
318
    if ($modified) {
319
        my $auth_count = $authority->get_usage_count;
320
        $verbose and print "auth $authid: used in $auth_count bibliographic records\n";
321
        $verbose and print "auth $authid: modified, calling ModAuthority()\n";
322
        my $ret = ModAuthority( $authid, $record, $authority->authtypecode );
323
        if ( $ret == $authid ) {
324
            $verbose and print "auth $authid: updated successfully\n";
325
        } else {
326
            $verbose and print "auth $authid: update failure\n";
327
        }
328
    }
329
330
}
331
332
sub _get_ddc_uri {
333
    my $access_token = shift;
334
    my $ddc_number   = shift;
335
    my ( $ddc_uri, $msg ) = Koha::ExternalContent::OCLC->get_ddc_uri(
336
        {
337
            access_token => $access_token,
338
            ddc_number   => $ddc_number,
339
        }
340
    );
341
    return ( $ddc_uri, $msg );
342
}
343
344
sub _get_ddc_url {
345
    my $access_token = shift;
346
    my $ddc_number   = shift;
347
    my ( $ddc_url, $msg ) = Koha::ExternalContent::OCLC->get_ddc_url(
348
        {
349
            access_token => $access_token,
350
            ddc_number   => $ddc_number,
351
        }
352
    );
353
    return ( $ddc_url, $msg );
354
}
355
356
sub _get_ddc_descr {
357
    my $access_token = shift;
358
    my $ddc_uri      = shift;
359
    my $language     = shift;
360
    my ( $ddc_descr, $msg ) = Koha::ExternalContent::OCLC->get_ddc_description(
361
        {
362
            access_token => $access_token,
363
            ddc_uri      => $ddc_uri,
364
            language     => $language,
365
        }
366
    );
367
    return ( $ddc_descr, $msg );
368
}
369
370
=head1 NAME
371
372
fetch_oclc_dewey_linked_data.pl - Updates authority records with OCLC Dewey Linked Data
373
374
=head1 SYNOPSIS
375
376
B<fetch_oclc_dewey_linked_data.pl>
377
[B<-a|--authtypecode ...>]
378
[B<-c|--confirm>]
379
[B<-h|--help>]
380
[B<-f|--force>]
381
[B<-l|--language de|en|fr|it|no|sv>]
382
[B<--man>]
383
[B<-v|--verbose>]
384
[B<-w|--where ...>]
385
386
=head1 DESCRIPTION
387
388
This script automatically fetches Linked Data URLs corresponding to the
389
DDC numbers stored in authority records, and stores them in the
390
appropriate MARC subfield. It works for both MARC21 and UNIMARC.
391
392
In order to use the OCLC Dewey Linked Data API an access token must be
393
generated (this is handled internally by the script), which requires the
394
OCLCAPIWSKeyClientID and OCLCAPIWSKeyClientSecret System Preferences to
395
be filled in.
396
397
=head1 OPTIONS
398
399
=over
400
401
=item B<-a|--authtypecode>
402
403
Repeatable; selects the authtypecode(s) to use when searching for authorities.
404
405
=item B<-c|--confirm>
406
407
Makes the script actually modify any matching authorities, otherwise only a
408
dry run will be performed.
409
410
=item B<-f|--force>
411
412
Enforces an overwrite of previously set MARC subfield values (specifically
413
the Linked Data URL and Description). Use this option in combination with
414
--language to re-fetch the DDC Descriptions from OCLC's API for a language
415
different than OCLCDeweyLinkedDataLanguage. Use this option on its own to
416
re-fetch DDC Descriptions for the language set in OCLCDeweyLinkedDataLanguage.
417
Implies --confirm.
418
419
=item B<-h|--help>
420
421
Prints a brief help message.
422
423
=item B<-l|--language>
424
425
Overrides the value set by the OCLCDeweyLinkedDataLanguage System Preference.
426
The argument to this option must be one of: de|en|fr|it|no|sv.
427
428
=item B<--man>
429
430
Prints a detailed help message.
431
432
=item B<-v|--verbose>
433
434
Highly recommended; prints verbose progress information.
435
436
=item B<-w|--where>
437
438
Passes an additional SQL 'WHERE' clause to the authority search, in order to
439
limit the results returned.
440
441
=back
442
443
=head1 AUTHOR
444
445
Andreas Roussos <a.roussos@dataly.gr>
446
447
=cut

Return to bug 40308