From 6b516802f5e270947c74dfe332aa1d56546361d7 Mon Sep 17 00:00:00 2001 From: Andreas Roussos Date: Mon, 7 Jul 2025 02:54:16 +0300 Subject: [PATCH] Bug 40308: add a command-line tool that updates authorities en masse In Bugs 40309, 40310, and 40311 we will add three new Authority Framework plugins that allow for easy DDC lookups using OCLC's Dewey Linked Data API while cataloguing authorities in the Staff Interface. However, users may want to retroactively enrich their existing authorities using a command-line tool that can modify authorities en masse. This patch adds misc/maintenance/fetch_oclc_dewey_linked_data.pl, which is a Perl script that can accept a number of options in order to facilitate selective operation on specific authority types, or even authid ranges. Test plan (NOTE: you need to have an organizational account with OCLC and an active WebDewey subscription associated with it in order to request a WSKey for accessing the Dewey Linked Data API): [ I recommend working with two KTD instances in parallel. ] 0) First of all, run: ktd_proxy --start 1) Then, edit your KTD .env file so that: KOHA_MARC_FLAVOUR=marc21 Then: ktd --proxy --name marc21 up Wait until it starts up. Then, in a different terminal, edit your KTD .env file so that: KOHA_MARC_FLAVOUR=unimarc Then: ktd --proxy --name unimarc up Wait until it starts up. You now have two KTDs running, one for each MARC flavour you want to test. 2) Get inside the MARC21 Koha container: ktd --name marc21 --shell Download the sample MARC21 authority records (sample_auth_records_marc21.mrc) attached to this Bug report (the file contains 15 records): wget -O sample_auth_records_marc21.mrc https://bugs.koha-community.org/bugzilla3/attachment.cgi?id=183809 Then, import the authorities: misc/migration_tools/bulkmarcimport.pl -a --file sample_auth_records_marc21.mrc -v -c MARC21 -m ISO2709 Repeat for the UNIMARC Koha container: ktd --name unimarc --shell Download the sample UNIMARC authority records (sample_auth_records_unimarc.mrc) attached to this Bug report (the file contains 12 records): wget -O sample_auth_records_unimarc.mrc https://bugs.koha-community.org/bugzilla3/attachment.cgi?id=183810 Then, import the authorities: misc/migration_tools/bulkmarcimport.pl -a --file sample_auth_records_unimarc.mrc -v -c UNIMARC -m ISO2709 3) Once the sample authorities have been imported, you must fill in these two System Preferences (this is the tricky part, as, in order to request a WSKey you need to have an organizational account with OCLC and an active WebDewey subscription associated with it): - OCLCAPIWSKeyClientID - OCLCAPIWSKeyClientSecret 4) When the above System Preferences have been filled in, try running the new script (passing as many variations of the command-line options as you can). For example: cd misc/maintenance/ ./fetch_oclc_dewey_linked_data.pl -h ./fetch_oclc_dewey_linked_data.pl --man | cat ./fetch_oclc_dewey_linked_data.pl -v ./fetch_oclc_dewey_linked_data.pl -v -l el ./fetch_oclc_dewey_linked_data.pl -v -a SNC ./fetch_oclc_dewey_linked_data.pl -v -a SNC -w "authid = 5955" ./fetch_oclc_dewey_linked_data.pl -v -a SNC -w "authid = 5955" -c ./fetch_oclc_dewey_linked_data.pl -v -a SNC -w "authid = 5955" -l it ./fetch_oclc_dewey_linked_data.pl -v -a SNC -w "authid = 5955" -l it -f ./fetch_oclc_dewey_linked_data.pl -v -l no -f ./fetch_oclc_dewey_linked_data.pl ...etc The output of the script for the above commands should resemble what is being depicted in the following asciinema screencast: https://asciinema.org/a/FKxWqNHLeZbxcgCBwYWZ4fod9 If all goes well, you should have updated all authorities that have a DDC field with their matching Dewey Linked Data. --- .../fetch_oclc_dewey_linked_data.pl | 447 ++++++++++++++++++ 1 file changed, 447 insertions(+) create mode 100755 misc/maintenance/fetch_oclc_dewey_linked_data.pl diff --git a/misc/maintenance/fetch_oclc_dewey_linked_data.pl b/misc/maintenance/fetch_oclc_dewey_linked_data.pl new file mode 100755 index 0000000000..0066859a92 --- /dev/null +++ b/misc/maintenance/fetch_oclc_dewey_linked_data.pl @@ -0,0 +1,447 @@ +#!/usr/bin/perl + +# This file is part of Koha. +# +# Copyright (C) 2025 Dataly Tech +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use C4::AuthoritiesMarc qw( GetAuthority ModAuthority ); +use C4::Context qw( preference ); +use Koha::Authorities; +use Koha::Caches; +use Koha::ExternalContent::OCLC; +use Koha::Script; + +use Getopt::Long qw( GetOptions :config no_auto_abbrev no_ignore_case ); +use JSON qw( from_json ); +use LWP::UserAgent; +use MARC::Record; +use Pod::Usage qw( pod2usage ); + +binmode( STDOUT, ':encoding(UTF-8)' ); + +my @authtypecodes; +my $confirm = 0; +my $help; +my $force = 0; +my $language; +my $man; +my $verbose = 0; +my $where; + +GetOptions( + 'a|authtypecode=s' => \@authtypecodes, + 'c|confirm' => \$confirm, + 'h|help' => \$help, + 'f|force' => \$force, + 'l|language=s{1}' => \$language, + 'man' => \$man, + 'v|verbose' => \$verbose, + 'w|where=s' => \$where, +) or pod2usage(1); + +pod2usage(1) if $help; +pod2usage( -verbose => 2 ) if $man; + +my %languages = ( + 'de' => 'German', + 'en' => 'English', + 'fr' => 'French', + 'it' => 'Italian', + 'no' => 'Norwegian', + 'sv' => 'Swedish', +); + +my $langcodes = join '|', sort keys %languages; + +if ( $language and $language !~ /^($langcodes)$/ ) { + print "Incorrect language code passed, must be one of: $langcodes\n"; + exit; +} + +print "Running in dry-run mode as -c/--confirm is not passed\n" unless $confirm; + +my $cache = Koha::Caches->get_instance; +my $client_id = C4::Context->preference('OCLCAPIWSKeyClientID'); +my $client_secret = C4::Context->preference('OCLCAPIWSKeyClientSecret'); +my $pref_language = C4::Context->preference('OCLCDeweyLinkedDataLanguage'); +my $marcflavour = C4::Context->preference('marcflavour'); +my $scope = 'deweyLinkedData'; + +$verbose and print "OCLCDeweyLinkedDataLanguage set to '$pref_language' ($languages{$pref_language})\n"; +$verbose and print "Language overriden and set to '$language' ($languages{$language})\n" if $language; +$verbose and print "Option --force passed, will overwrite subfield data\n" if $force; + +my ( $access_token, $msg ); +if ( $client_id and $client_secret ) { + $verbose and print "Found OCLC Dewey Linked Data API Client ID and Secret\n"; + $verbose and print "Requesting an access token from OCLC's OAuth server\n"; + ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token( + { + scope => $scope, + } + ); + if ( defined $access_token ) { + $verbose and print "Got token '$access_token' via $msg\n"; + } else { + $verbose and print "Cannot obtain API token ($msg)\n"; + exit; + } +} else { + print "Cannot request an API access token from OCLC's OAuth server\n" + . "An OCLC Dewey Linked Data API Client ID and Secret are required\n" + . "Please fill in the OCLCAPIWSKeyClientID and OCLCAPIWSKeyClientSecret\n" + . "System Preferences, then try again.\n"; + exit; +} + +$verbose and print "Fetching auth types\n"; +my $params = undef; +if (@authtypecodes) { + $params = { authtypecode => { -in => \@authtypecodes } }; +} +my @auth_types = Koha::Authority::Types->search($params)->as_list; +$verbose and print "Done fetching auth types\n"; + +my ( $ddc_fields_regex, $ddc_url_subfield ); +if ( $marcflavour eq 'MARC21' ) { + $ddc_fields_regex = '082|083'; + $ddc_url_subfield = '1'; +} elsif ( $marcflavour eq 'UNIMARC' ) { + $ddc_fields_regex = '676'; + $ddc_url_subfield = 'R'; +} +my $ddc_descr_subfield = 'c'; + +# The regex below Covers DDC numbers like 270, 248.4819, T4--313 +my $ddc_regex = '^((T([1-6])--([0-9]+)))$|^([0-9]{3})$|^(([0-9]{3})\.([0-9]+))$'; + +foreach my $authtype (@auth_types) { + + my $authtypecode = $authtype->authtypecode; + $verbose and print "Fetching authorities of type '$authtypecode'\n"; + my $authorities = Koha::Authorities->search( + { authtypecode => $authtypecode }, + { order_by => { -asc => 'authid' } } + ); + $authorities = $authorities->search( \$where ) if $where; + + my $count = $authorities->count; + $verbose and print "Found $count authorit" . ( $count == 1 ? 'y' : 'ies' ) . "\n"; + + while ( my $authority = $authorities->next ) { + process_authority($authority); + } + +} + +sub process_authority { + + my ($authority) = @_; + + my $authid = $authority->authid; + my $record = GetAuthority($authid); + my @fields = $record->field($ddc_fields_regex); + my $modified = 0; + + foreach my $field (@fields) { + + my ( $ddc_range_begin, $ddc_range_end ); + + $ddc_range_begin = $field && $field->subfield('a'); + if ( $ddc_range_begin and $ddc_range_begin !~ /$ddc_regex/ ) { + $verbose and print "auth $authid: invalid DDC number '$ddc_range_begin' in subfield \$a\n"; + next; + } + + if ( ( $marcflavour eq 'MARC21' and $field->tag eq '083' ) + or ( $marcflavour eq 'UNIMARC' and $field->tag eq '676' ) ) + { + $ddc_range_end = $field && $field->subfield('b'); + if ( $ddc_range_end and $ddc_range_end !~ /$ddc_regex/ ) { + $verbose and print "auth $authid: invalid DDC number '$ddc_range_end' in subfield \$b\n"; + next; + } + } + + my $rec_ddc = + $ddc_range_end + ? $ddc_range_begin . '-' . $ddc_range_end + : $ddc_range_begin + if $ddc_range_begin; + + my $rec_ddc_url = $field && $field->subfield($ddc_url_subfield); + my $rec_ddc_descr = $field && $field->subfield($ddc_descr_subfield); + + if ( $rec_ddc and $rec_ddc_url and $rec_ddc_descr ) { + $verbose and print "auth $authid: found DDC '$rec_ddc', LD URL '$rec_ddc_url'\n"; + $verbose and print "auth $authid: found DDC '$rec_ddc', LD Description '$rec_ddc_descr'\n"; + $verbose and print "auth $authid: skipping this field, as all data is present\n" unless $force; + $verbose and print "auth $authid: you can use --force to override this behavior\n" unless $force; + next unless $force; + } + + if ($rec_ddc) { + + $verbose and print "auth $authid: found DDC '$rec_ddc', searching for URI/URL/Description\n"; + + # Trim leading 'T' (uppercase 't') from DDC number + $rec_ddc =~ s/^T//; + + my ( $ddc_uri, $ddc_url, $ddc_descr ); + + ################################################################## + # Get DDC URI (retry automatically if the token expired) + ################################################################## + ( $ddc_uri, $msg ) = _get_ddc_uri( $access_token, $rec_ddc ); + if ( defined $ddc_uri ) { + $verbose and print "auth $authid: found LD URI '$ddc_uri' via $msg\n"; + } elsif ( $msg eq 'Unauthorized' ) { + $verbose and print "auth $authid: cannot obtain LD URI ($msg)\n"; + $verbose and print "auth $authid: our API access token has expired\n"; + $verbose and print "auth $authid: removing the expired token from cache\n"; + $cache->clear_from_cache("OCLC_access_token-$scope"); + $verbose and print "auth $authid: requesting a new access token\n"; + ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token( + { + scope => $scope, + } + ); + if ( defined $access_token ) { + $verbose and print "got renewed access token '$access_token' via $msg\n"; + $verbose and print "retrying LD URI fetch for DDC '$rec_ddc'\n"; + ( $ddc_uri, $msg ) = _get_ddc_uri( $access_token, $rec_ddc ); + } else { + $verbose and print "Cannot obtain API token ($msg)\n"; + exit; + } + redo; + } elsif ( $msg eq 'not found' ) { + $verbose and print "auth $authid: no LD URI found for DDC '$rec_ddc'\n"; + + # skip this field, as no URI was returned (no further API lookups needed) + $verbose and print "auth $authid: skipping this field\n"; + next; + } + + ################################################################## + # Get DDC URL (retry automatically if the token expired) + ################################################################## + ( $ddc_url, $msg ) = _get_ddc_url( $access_token, $rec_ddc ); + if ( defined $ddc_url ) { + $verbose and print "auth $authid: found LD URL '$ddc_url' via $msg\n"; + } elsif ( $msg eq 'Unauthorized' ) { + $verbose and print "auth $authid: cannot obtain LD URL ($msg)\n"; + $verbose and print "auth $authid: our API access token has expired\n"; + $verbose and print "auth $authid: removing the expired token from cache\n"; + $cache->clear_from_cache("OCLC_access_token-$scope"); + $verbose and print "auth $authid: requesting a new access token\n"; + ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token( + { + scope => $scope, + } + ); + if ( defined $access_token ) { + $verbose and print "Got renewed access token '$access_token' via $msg\n"; + $verbose and print "retrying LD URL fetch for DDC '$rec_ddc'\n"; + ( $ddc_url, $msg ) = _get_ddc_url( $access_token, $rec_ddc ); + } else { + $verbose and print "Cannot obtain API token ($msg)\n"; + exit; + } + redo; + } elsif ( $msg eq 'not found' ) { + $verbose and print "auth $authid: no LD URL found for DDC '$rec_ddc'\n"; + } + + ################################################################## + # Get DDC Description (retry automatically if the token expired) + ################################################################## + my $lang = $language ? $language : undef; + ( $ddc_descr, $msg ) = _get_ddc_descr( $access_token, $ddc_uri, $lang ); + if ( defined $ddc_descr ) { + $verbose and print "auth $authid: found LD Description '$ddc_descr' via $msg\n"; + } elsif ( $msg eq 'Unauthorized' ) { + $verbose and print "auth $authid: cannot obtain LD Description ($msg)\n"; + $verbose and print "auth $authid: our API access token has expired\n"; + $verbose and print "auth $authid: removing the expired token from cache\n"; + $cache->clear_from_cache("OCLC_access_token-$scope"); + $verbose and print "auth $authid: requesting a new access token\n"; + ( $access_token, $msg ) = Koha::ExternalContent::OCLC->get_access_token( + { + scope => $scope, + } + ); + if ( defined $access_token ) { + $verbose and print "Got renewed access token '$access_token' via $msg\n"; + $verbose and print "retrying LD Description fetch for DDC '$rec_ddc'\n"; + ( $ddc_descr, $msg ) = _get_ddc_descr( $access_token, $ddc_uri, $lang ); + } else { + $verbose and print "Cannot obtain API token ($msg)\n"; + exit; + } + redo; + } elsif ( $msg eq 'not found' ) { + $verbose and print "auth $authid: no LD Description found for DDC '$rec_ddc'\n"; + } + + if ( $confirm or $force ) { + $field->update( $ddc_url_subfield => $ddc_url ); + + # MARC21 authority field 082 does not have a $c subfield, + # so we only update the description if the current field + # is 083 (MARC21) or 676 (UNIMARC) + if ( $field->tag eq '083' or $field->tag eq '676' ) { + $field->update( $ddc_descr_subfield => $ddc_descr ); + } + $modified = 1; + } + + } + + } + + if ($modified) { + my $auth_count = $authority->get_usage_count; + $verbose and print "auth $authid: used in $auth_count bibliographic records\n"; + $verbose and print "auth $authid: modified, calling ModAuthority()\n"; + my $ret = ModAuthority( $authid, $record, $authority->authtypecode ); + if ( $ret == $authid ) { + $verbose and print "auth $authid: updated successfully\n"; + } else { + $verbose and print "auth $authid: update failure\n"; + } + } + +} + +sub _get_ddc_uri { + my $access_token = shift; + my $ddc_number = shift; + my ( $ddc_uri, $msg ) = Koha::ExternalContent::OCLC->get_ddc_uri( + { + access_token => $access_token, + ddc_number => $ddc_number, + } + ); + return ( $ddc_uri, $msg ); +} + +sub _get_ddc_url { + my $access_token = shift; + my $ddc_number = shift; + my ( $ddc_url, $msg ) = Koha::ExternalContent::OCLC->get_ddc_url( + { + access_token => $access_token, + ddc_number => $ddc_number, + } + ); + return ( $ddc_url, $msg ); +} + +sub _get_ddc_descr { + my $access_token = shift; + my $ddc_uri = shift; + my $language = shift; + my ( $ddc_descr, $msg ) = Koha::ExternalContent::OCLC->get_ddc_description( + { + access_token => $access_token, + ddc_uri => $ddc_uri, + language => $language, + } + ); + return ( $ddc_descr, $msg ); +} + +=head1 NAME + +fetch_oclc_dewey_linked_data.pl - Updates authority records with OCLC Dewey Linked Data + +=head1 SYNOPSIS + +B +[B<-a|--authtypecode ...>] +[B<-c|--confirm>] +[B<-h|--help>] +[B<-f|--force>] +[B<-l|--language de|en|fr|it|no|sv>] +[B<--man>] +[B<-v|--verbose>] +[B<-w|--where ...>] + +=head1 DESCRIPTION + +This script automatically fetches Linked Data URLs corresponding to the +DDC numbers stored in authority records, and stores them in the +appropriate MARC subfield. It works for both MARC21 and UNIMARC. + +In order to use the OCLC Dewey Linked Data API an access token must be +generated (this is handled internally by the script), which requires the +OCLCAPIWSKeyClientID and OCLCAPIWSKeyClientSecret System Preferences to +be filled in. + +=head1 OPTIONS + +=over + +=item B<-a|--authtypecode> + +Repeatable; selects the authtypecode(s) to use when searching for authorities. + +=item B<-c|--confirm> + +Makes the script actually modify any matching authorities, otherwise only a +dry run will be performed. + +=item B<-f|--force> + +Enforces an overwrite of previously set MARC subfield values (specifically +the Linked Data URL and Description). Use this option in combination with +--language to re-fetch the DDC Descriptions from OCLC's API for a language +different than OCLCDeweyLinkedDataLanguage. Use this option on its own to +re-fetch DDC Descriptions for the language set in OCLCDeweyLinkedDataLanguage. +Implies --confirm. + +=item B<-h|--help> + +Prints a brief help message. + +=item B<-l|--language> + +Overrides the value set by the OCLCDeweyLinkedDataLanguage System Preference. +The argument to this option must be one of: de|en|fr|it|no|sv. + +=item B<--man> + +Prints a detailed help message. + +=item B<-v|--verbose> + +Highly recommended; prints verbose progress information. + +=item B<-w|--where> + +Passes an additional SQL 'WHERE' clause to the authority search, in order to +limit the results returned. + +=back + +=head1 AUTHOR + +Andreas Roussos + +=cut -- 2.39.5