@@ -, +, @@ ---------- note how the framework is set to "Default". imported records - they're all "default". - 000/06: a: BKS c: SR m: CF This rule sets framework code to 'BKS' if 000/06 is 'a', etc. default, if the record 000/06 was one of 'a', 'c', or 'm'. framework - note how the framework you chose is kept, even if the record would match the syspref rules. should override the syspref rules. framework you chose should override the syspref rules. ------------------------------- - : - 008/35-37 + 000/06: fin+a: BKSFIN - 000/06: a: BKS c: MU e: MP --- C4/Biblio.pm | 136 +++++++++++++++ cataloguing/addbiblio.pl | 8 + installer/data/mysql/atomicupdate/bug_21559.perl | 11 ++ .../en/modules/admin/preferences/cataloguing.pref | 6 + t/Biblio/AutoFrameworkcode.t | 182 +++++++++++++++++++++ 5 files changed, 343 insertions(+) create mode 100644 installer/data/mysql/atomicupdate/bug_21559.perl create mode 100644 t/Biblio/AutoFrameworkcode.t --- a/C4/Biblio.pm +++ a/C4/Biblio.pm @@ -53,6 +53,7 @@ BEGIN { GetMarcFromKohaField GetMarcSubfieldStructureFromKohaField GetFrameworkCode + GetAutoFrameworkCode TransformKohaToMarc PrepHostMarcField CountItemsIssued @@ -88,6 +89,7 @@ use MARC::File::USMARC; use MARC::File::XML; use POSIX qw(strftime); use Module::Load::Conditional qw(can_load); +use YAML qw(Load); use C4::Koha; use C4::Log; # logaction @@ -216,6 +218,9 @@ sub AddBiblio { # transform the data into koha-table style data SetUTF8Flag($record); + + $frameworkcode = GetAutoFrameworkCode($record) if (!$frameworkcode || $frameworkcode eq ''); + my $olddata = TransformMarcToKoha( $record, $frameworkcode ); ( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode ); $olddata->{'biblionumber'} = $biblionumber; @@ -290,6 +295,7 @@ sub ModBiblio { my $dbh = C4::Context->dbh; $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX + $frameworkcode = GetAutoFrameworkCode($record) if ($frameworkcode eq ""); _strip_item_fields($record, $frameworkcode); @@ -2114,6 +2120,135 @@ sub GetFrameworkCode { return $frameworkcode; } +=head2 _matchRecordFieldspec + + $language = _matchRecordFieldspec($record, '008/35-37'); + +Returns field value from record. Fieldspec is a string of the following type: +'003', '100$a', '000/07', '008/35-37', or any of those types joined with plus sign. +If a matching field has been repeated in the record, the value from the first one is returned. + +=cut + +sub _matchRecordFieldspec { + my ($record, $fieldstr) = @_; + + $fieldstr =~ s/^\s+//; + $fieldstr =~ s/\s+$//; + + if ($fieldstr =~ /^(\d\d\d)$/) { + my $fld = $1; + my $data = ''; + if ($fld eq '000') { + $data = $record->leader(); + } else { + my $field = $record->field($fld); + $data = $field->data() if ($field && $field->is_control_field()); + } + return $data; + } elsif ($fieldstr =~ /^(\d\d\d)\$(\S)$/) { + my ($fld, $subfld) = ($1, $2); + my $data = ''; + my @fields = $record->field($fld); + foreach my $field (@fields) { + if ($field && !$field->is_control_field() && $field->subfield($subfld)) { + return $field->subfield($subfld); + } + } + return $data; + } elsif ($fieldstr =~ /^(\d\d\d)\/(\d+)$/) { + my ($fld, $pos) = ($1, int($2)); + my $data = ''; + if ($fld eq '000') { + $data = $record->leader(); + } else { + my $field = $record->field($fld); + $data = $field->data() if ($field && $field->is_control_field()); + } + return substr($data, $pos, 1); + } elsif ($fieldstr =~ /^(\d\d\d)\/(\d+)-(\d+)$/) { + my ($fld, $spos, $epos) = ($1, int($2), int($3)); + my $data = ''; + if ($fld eq '000') { + $data = $record->leader(); + } else { + my $field = $record->field($fld); + $data = $field->data() if ($field && $field->is_control_field()); + } + return substr($data, $spos, ($epos-$spos)+1); + } elsif ($fieldstr =~ /^(.+)\+(.+)$/) { + my ($fld1, $fld2) = ($1, $2); + return _matchRecordFieldspec($record, $fld1) . '+' . _matchRecordFieldspec($record, $fld2); + } else { + warn "_matchRecordFieldspec: unknown fieldspec '$fieldstr'"; + } + return ''; +} + +=head2 GetAutoFrameworkCode + + $frameworkcode = GetAutoFrameworkCode( $marcRecord ); + +Uses the MarcToFrameworkcodeAutoconvert system preference to determine what +framework code the MARC record should have, based on the record field values. + +=cut + +sub GetAutoFrameworkCode { + my ($record) = @_; + + my $prefname = 'MarcToFrameworkcodeAutoconvert'; + + my $cache = Koha::Caches->get_instance(); + my $cache_key = "parsed-pref-$prefname"; + my $fwcoderules = $cache->get_from_cache($cache_key); + + if (!$fwcoderules) { + my $yaml = C4::Context->preference($prefname) || ''; + return '' if ($yaml !~ /\S/); + + $yaml = "$yaml\n\n"; + eval { + $fwcoderules = YAML::Load($yaml); + }; + if ($@) { + warn "Unable to parse $prefname syspref: $@"; + return ''; + } + + if (ref($fwcoderules) ne 'ARRAY') { + warn "$prefname YAML root element is not array"; + return ''; + } + + $cache->set_in_cache($cache_key, $fwcoderules); + } + + foreach my $elem (@$fwcoderules) { + if (ref($elem) ne 'HASH') { + warn "$prefname 2nd level YAML element not a hash"; + $cache->clear_from_cache($cache_key); + return ''; + } + foreach my $ekey (keys(%{$elem})) { + my $matchvalue = _matchRecordFieldspec($record, $ekey) || ''; + if (defined($elem->{$ekey})) { + my $matches = $elem->{$ekey}; + if (ref($elem->{$ekey}) ne 'HASH') { + warn "$prefname 3rd level YAML element not a hash"; + $cache->clear_from_cache($cache_key); + return ''; + } + my %hmatches = %{$matches}; + foreach my $elm (keys(%hmatches)) { + return $hmatches{$elm} if ($elm eq $matchvalue); + } + } + } + } + return ''; +} + =head2 TransformKohaToMarc $record = TransformKohaToMarc( $hash [, $params ] ) @@ -3247,6 +3382,7 @@ sub ModBiblioMarc { if ( !$frameworkcode ) { $frameworkcode = ""; } + $frameworkcode = GetAutoFrameworkCode($record) if ($frameworkcode eq ""); my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"); $sth->execute( $frameworkcode, $biblionumber ); $sth->finish; --- a/cataloguing/addbiblio.pl +++ a/cataloguing/addbiblio.pl @@ -704,6 +704,14 @@ my $changed_framework = $input->param('changed_framework') // q{}; $frameworkcode = &GetFrameworkCode($biblionumber) if ( $biblionumber and not( defined $frameworkcode) and $op ne 'addbiblio' ); +if ( ($frameworkcode eq '' || !defined($frameworkcode)) && $z3950 && $breedingid ) { + my ($tmpmarc, $tmpencoding) = GetImportRecordMarc($breedingid); + if ($tmpmarc) { + my $tmprecord = MARC::Record->new_from_usmarc($tmpmarc); + $frameworkcode = C4::Biblio::GetAutoFrameworkCode($tmprecord); + } +} + if ($frameworkcode eq 'FA'){ $userflags = 'fast_cataloging'; } --- a/installer/data/mysql/atomicupdate/bug_21559.perl +++ a/installer/data/mysql/atomicupdate/bug_21559.perl @@ -0,0 +1,11 @@ +$DBversion = 'XXX'; # will be replaced by the RM +if( CheckVersion( $DBversion ) ) { + + $dbh->do("INSERT INTO systempreferences (variable,value,options,explanation,type) + VALUES ('MarcToFrameworkcodeAutoconvert', '', '70|10', + 'Rules to automatically set the framework code based on values in the record. This is YAML.', 'Textarea')"); + + # Always end with this (adjust the bug info) + SetVersion( $DBversion ); + print "Upgrade to $DBversion done (Bug 21559: Automatic frameworkcode from MARC record)\n"; +} --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref @@ -138,6 +138,12 @@ Cataloging: - 'MARC21: "952$a 952$b 952$c"' - Note that the FA framework is excluded from the permission. - If the pref is empty, no fields are restricted. + - + - Rules to automatically set the framework code based on values in the record, if the framework is not set or is the default. + - This is YAML. + - pref: MarcToFrameworkcodeAutoconvert + type: textarea + class: code Display: - - 'Separate multiple displayed authors, series or subjects with ' --- a/t/Biblio/AutoFrameworkcode.t +++ a/t/Biblio/AutoFrameworkcode.t @@ -0,0 +1,182 @@ +#!/usr/bin/perl + +use Modern::Perl; +use Test::More; +use Test::Warn; +use Test::MockModule; + +use C4::Record; +use C4::Biblio; +use Koha::Caches; + +my $cache = Koha::Caches->get_instance(); + +my $marcxml = ' + + + 00439cam a22001934a 4500 + JOENS + 1953 xx |||||||||| ||||1|eng|c + + BB + EE + + + AA + DD + + + KI + +'; + +my $fwcode_rules; + +my $return_undef = 0; +my $module_context = new Test::MockModule('C4::Context'); + +my $prefname = 'MarcToFrameworkcodeAutoconvert'; +my $cachepref = "parsed-pref-$prefname"; + +$module_context->mock( + preference => sub { + my ($self, $pref) = @_; + return undef if ($return_undef); + return $fwcode_rules if ($pref eq $prefname); + return 'XXX'; + }, + ); + +my ($error, $record) = marcxml2marc($marcxml); + +subtest "_matchRecordFieldspec tests", \&_test_matchRecordFieldspec; +sub _test_matchRecordFieldspec { + my $fn = '_matchRecordFieldspec'; + is(C4::Biblio::_matchRecordFieldspec($record, '003 '), 'JOENS', "$fn: single field"); + is(C4::Biblio::_matchRecordFieldspec($record, ' 000/06'), 'a', "$fn: field part"); + is(C4::Biblio::_matchRecordFieldspec($record, ' 008/35-37 '), 'eng', "$fn: field part range"); + is(C4::Biblio::_matchRecordFieldspec($record, '942$c'), 'KI', "$fn: subfield"); + is(C4::Biblio::_matchRecordFieldspec($record, '590$a'), 'AA', "$fn: subfield, first instance only"); + is(C4::Biblio::_matchRecordFieldspec($record, '590$b'), 'BB', "$fn: subfield, first instance only"); + is(C4::Biblio::_matchRecordFieldspec($record, '942$c+003'), 'KI+JOENS', "$fn: concat two fields"); + is(C4::Biblio::_matchRecordFieldspec($record, ' 942$c + 003'), 'KI+JOENS', "$fn: concat two fields plus spaces"); + is(C4::Biblio::_matchRecordFieldspec($record, '942$c+003 + 000/06 '), 'KI+JOENS+a', "$fn: concat three fields"); + + my %warnings = ('NOTEXIST' => '', + '00' => '', + '942$' => '', + '+' => '', + '' => ''); + + foreach my $tmp (keys(%warnings)) { + warning_is { + is(C4::Biblio::_matchRecordFieldspec($record, $tmp), + $warnings{$tmp}, "$fn: nonexistent field"); } + "$fn: unknown fieldspec '".$tmp."'", "$fn: raises a warning"; + } +} + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ''; +is(GetAutoFrameworkCode($record), '', "empty rules"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' '; +is(GetAutoFrameworkCode($record), '', "empty rules"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' + +'; +is(GetAutoFrameworkCode($record), '', "empty rules"); + + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +foo: bar'; +warning_is { + is(GetAutoFrameworkCode($record), '', "empty rules"); +} "MarcToFrameworkcodeAutoconvert YAML root element is not array", + "raises a warning"; + + + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- foo'; +warning_is { + is(GetAutoFrameworkCode($record), '', "empty rules"); +} "MarcToFrameworkcodeAutoconvert 2nd level YAML element not a hash", + "raises a warning"; + + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 000: + - foo'; +warning_is { + is(GetAutoFrameworkCode($record), '', "empty rules"); +} "MarcToFrameworkcodeAutoconvert 3rd level YAML element not a hash", + "raises a warning"; + + +$fwcode_rules = ' +- 003: + JOENS: BKS'; +is(GetAutoFrameworkCode($record), 'BKS', "correct value"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 003: + FOO: BAR +- 003: + JOENS: KIR'; +is(GetAutoFrameworkCode($record), 'KIR', "later matching rule"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 003: + JOENS: JNS +- 003: + FOO: BAR +'; +is(GetAutoFrameworkCode($record), 'JNS', "first matching rule"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 000/06: + a: QUX + b: KIR +- 003: + JOENS: JNS +'; +is(GetAutoFrameworkCode($record), 'QUX', "first matching rule, pt 2"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 000/06: + b: KIR + c: BKS +- 003: + JOENS: JOE +'; +is(GetAutoFrameworkCode($record), 'JOE', "first matching rule, pt 3"); + +$cache->clear_from_cache($cachepref); +$fwcode_rules = ' +- 000/06: + b: KIR + c: BKS +- 003: + JNS: JOENS +'; +is(GetAutoFrameworkCode($record), '', "no matching rule"); + +$cache->clear_from_cache($cachepref); +$return_undef = 1; +is(GetAutoFrameworkCode($record), '', "no return value if no syspref"); + +done_testing(); --