From 197e1b30c41561e83ed9be268492184decbf633b Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Wed, 20 May 2020 12:07:53 -0400 Subject: [PATCH] Bug 20817: Move subroutines to a new Perl module --- Koha/Acquisition/Utils.pm | 180 ++++++++++++++++++++++++++++++++++++++ acqui/addorderiso2709.pl | 119 ++----------------------- acqui/neworderempty.pl | 119 ++----------------------- 3 files changed, 197 insertions(+), 221 deletions(-) create mode 100644 Koha/Acquisition/Utils.pm diff --git a/Koha/Acquisition/Utils.pm b/Koha/Acquisition/Utils.pm new file mode 100644 index 0000000000..0e9e98b937 --- /dev/null +++ b/Koha/Acquisition/Utils.pm @@ -0,0 +1,180 @@ +package Koha::Acquisition::Utils; + +# This file is part of Koha. +# +# 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::Context; + +=head1 NAME + +Koha::Acquisition::Utils - Additional Koha functions for dealing with orders and acquisitions + +=head1 SUBROUTINES + +=head3 get_infos_syspref($syspref_name, $record, $field_list) + +my $data = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', etc.]); + +This subroutine accepts a syspref ( MarcFieldsToOrder ), +a marc record, and an arrayref of fields to retrieve. + +The return value is a hashref of key value pairs, where the keys are the field list parameters, +and the values are extracted from the MARC record based on the key to MARC field mapping from the +given system preference. + +=cut + +sub get_infos_syspref { + my ($syspref_name, $record, $field_list) = @_; + my $syspref = C4::Context->preference($syspref_name); + $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt + my $yaml = eval { + YAML::Load($syspref); + }; + if ( $@ ) { + warn "Unable to parse $syspref syspref : $@"; + return (); + } + my $r; + for my $field_name ( @$field_list ) { + next unless exists $yaml->{$field_name}; + my @fields = split /\|/, $yaml->{$field_name}; + for my $field ( @fields ) { + my ( $f, $sf ) = split /\$/, $field; + next unless $f and $sf; + if ( my $v = $record->subfield( $f, $sf ) ) { + $r->{$field_name} = $v; + } + last if $yaml->{$field}; + } + } + return $r; +} + +=head3 get_infos_syspref_on_item($syspref_name, $record, $field_list) + +my $data = get_infos_syspref_on_item('MarcItemFieldsToOrder', $marcrecord, ['homebranch', 'holdingbranch', 'itype', 'nonpublic_note', 'public_note', 'loc', 'ccode', 'notforloan', 'uri', 'copyno', 'price', 'replacementprice', 'itemcallnumber', 'quantity', 'budget_code']); + +This subroutine accepts a syspref ( MarcItemFieldsToOrder ), +a marc record, and an arrayref of fields to retrieve. + +The return value is a hashref of key value pairs, where the keys are the field list parameters, +and the values are extracted from the MARC record based on the key to MARC field mapping from the +given system preference. + +The largest difference between get_infos_syspref and get_infos_syspref_on_item is that the former deals +with singular marc fields, while the latter works on multiple matching marc fields and returns -1 if it cannot +find a matching number of all fields to be looked up. + +=cut + +sub get_infos_syspref_on_item { + my ($syspref_name, $record, $field_list) = @_; + my $syspref = C4::Context->preference($syspref_name); + $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt + my $yaml = eval { + YAML::Load($syspref); + }; + if ( $@ ) { + warn "Unable to parse $syspref syspref : $@"; + return (); + } + my @result; + my @tags_list; + + # Check tags in syspref definition + for my $field_name ( @$field_list ) { + next unless exists $yaml->{$field_name}; + my @fields = split /\|/, $yaml->{$field_name}; + for my $field ( @fields ) { + my ( $f, $sf ) = split /\$/, $field; + next unless $f and $sf; + push @tags_list, $f; + } + } + @tags_list = List::MoreUtils::uniq(@tags_list); + + my $tags_count = equal_number_of_fields(\@tags_list, $record); + # Return if the number of these fields in the record is not the same. + return -1 if $tags_count == -1; + + # Gather the fields + my $fields_hash; + foreach my $tag (@tags_list) { + my @tmp_fields; + foreach my $field ($record->field($tag)) { + push @tmp_fields, $field; + } + $fields_hash->{$tag} = \@tmp_fields; + } + + for (my $i = 0; $i < $tags_count; $i++) { + my $r; + for my $field_name ( @$field_list ) { + next unless exists $yaml->{$field_name}; + my @fields = split /\|/, $yaml->{$field_name}; + for my $field ( @fields ) { + my ( $f, $sf ) = split /\$/, $field; + next unless $f and $sf; + my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef; + $r->{$field_name} = $v if (defined $v); + last if $yaml->{$field}; + } + } + push @result, $r; + } + return \@result; +} + +=head3 equal_number_of_fields($tags_list, $record) + +$value = equal_number_of_fields(\@tags_list, $record); + +Returns -1 if the number of instances of the given tags are not equal. + +For example, if you need to verify there are equal 975$i's and 975$a's, +this will let you know. + +=cut + +sub equal_number_of_fields { + my ($tags_list, $record) = @_; + my $tag_fields_count; + for my $tag (@$tags_list) { + my @fields = $record->field($tag); + $tag_fields_count->{$tag} = scalar @fields; + } + + my $tags_count; + foreach my $key ( keys %$tag_fields_count ) { + if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok + $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence + return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist + } + } + + return $tags_count; +} + +1; +__END__ + +=head1 AUTHOR + +Koha Development Team + +=cut diff --git a/acqui/addorderiso2709.pl b/acqui/addorderiso2709.pl index b65663d862..10c74762d7 100755 --- a/acqui/addorderiso2709.pl +++ b/acqui/addorderiso2709.pl @@ -44,14 +44,17 @@ use C4::Items qw( PrepareItemrecordDisplay AddItemFromMarc ); use C4::Budgets qw( GetBudget GetBudgets GetBudgetHierarchy CanUserUseBudget GetBudgetByCode ); use C4::Suggestions; # GetSuggestion use C4::Members; - -use Koha::Number::Price; -use Koha::Libraries; +use C4::Output; +use C4::Search qw/FindDuplicate/; +use C4::Suggestions; # GetSuggestion use Koha::Acquisition::Baskets; +use Koha::Acquisition::Booksellers; use Koha::Acquisition::Currencies; use Koha::Acquisition::Orders; -use Koha::Acquisition::Booksellers; +use Koha::Acquisition::Utils; use Koha::Import::Records; +use Koha::Libraries; +use Koha::Number::Price; use Koha::Patrons; my $input = CGI->new; @@ -489,7 +492,7 @@ sub import_biblios_list { ); my $marcrecord = $import_record->get_marc_record || die "couldn't translate marc information"; - my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']); + my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']); my $price = $infos->{price}; my $replacementprice = $infos->{replacementprice}; my $quantity = $infos->{quantity}; @@ -508,7 +511,7 @@ sub import_biblios_list { # Items my @itemlist = (); my $all_items_quantity = 0; - my $alliteminfos = get_infos_syspref_on_item('MarcItemFieldsToOrder', $marcrecord, ['homebranch', 'holdingbranch', 'itype', 'nonpublic_note', 'public_note', 'loc', 'ccode', 'notforloan', 'uri', 'copyno', 'price', 'replacementprice', 'itemcallnumber', 'quantity', 'budget_code']); + my $alliteminfos = C4::Acquisition::Utils::get_infos_syspref_on_item('MarcItemFieldsToOrder', $marcrecord, ['homebranch', 'holdingbranch', 'itype', 'nonpublic_note', 'public_note', 'loc', 'ccode', 'notforloan', 'uri', 'copyno', 'price', 'replacementprice', 'itemcallnumber', 'quantity', 'budget_code']); if ($alliteminfos != -1) { foreach my $iteminfos (@$alliteminfos) { my $item_homebranch = $iteminfos->{homebranch}; @@ -643,107 +646,3 @@ sub add_matcher_list { } $template->param(available_matchers => \@matchers); } - -sub get_infos_syspref { - my ($syspref_name, $record, $field_list) = @_; - my $syspref = C4::Context->preference($syspref_name); - $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt - my $yaml = eval { - YAML::XS::Load(Encode::encode_utf8($syspref)); - }; - if ( $@ ) { - warn "Unable to parse $syspref syspref : $@"; - return (); - } - my $r; - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - if ( my $v = $record->subfield( $f, $sf ) ) { - $r->{$field_name} = $v; - } - last if $yaml->{$field}; - } - } - return $r; -} - -sub equal_number_of_fields { - my ($tags_list, $record) = @_; - my $tag_fields_count; - for my $tag (@$tags_list) { - my @fields = $record->field($tag); - $tag_fields_count->{$tag} = scalar @fields; - } - - my $tags_count; - foreach my $key ( keys %$tag_fields_count ) { - if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok - $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence - return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist - } - } - - return $tags_count; -} - -sub get_infos_syspref_on_item { - my ($syspref_name, $record, $field_list) = @_; - my $syspref = C4::Context->preference($syspref_name); - $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt - my $yaml = eval { - YAML::XS::Load(Encode::encode_utf8($syspref)); - }; - if ( $@ ) { - warn "Unable to parse $syspref syspref : $@"; - return (); - } - my @result; - my @tags_list; - - # Check tags in syspref definition - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - push @tags_list, $f; - } - } - @tags_list = List::MoreUtils::uniq(@tags_list); - - my $tags_count = equal_number_of_fields(\@tags_list, $record); - # Return if the number of these fields in the record is not the same. - return -1 if $tags_count == -1; - - # Gather the fields - my $fields_hash; - foreach my $tag (@tags_list) { - my @tmp_fields; - foreach my $field ($record->field($tag)) { - push @tmp_fields, $field; - } - $fields_hash->{$tag} = \@tmp_fields; - } - - for (my $i = 0; $i < $tags_count; $i++) { - my $r; - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef; - $r->{$field_name} = $v if (defined $v); - last if $yaml->{$field}; - } - } - push @result, $r; - } - return \@result; -} diff --git a/acqui/neworderempty.pl b/acqui/neworderempty.pl index c787eed3e5..f1b041a1c1 100755 --- a/acqui/neworderempty.pl +++ b/acqui/neworderempty.pl @@ -66,7 +66,6 @@ the item's id in the breeding reservoir use Modern::Perl; use CGI qw ( -utf8 ); -use C4::Context; use C4::Auth qw( get_template_and_user ); use C4::Budgets qw( GetBudget GetBudgetHierarchy CanUserUseBudget ); @@ -92,10 +91,11 @@ use C4::ImportBatch qw( SetImportRecordStatus SetMatchedBiblionumber GetImportRe use Koha::Acquisition::Booksellers; use Koha::Acquisition::Currencies qw( get_active ); use Koha::Biblios; +use Koha::Acquisition::Utils; use Koha::BiblioFrameworks; use Koha::DateUtils qw( dt_from_string ); -use Koha::MarcSubfieldStructures; use Koha::ItemTypes; +use Koha::MarcSubfieldStructures; use Koha::Patrons; use Koha::RecordProcessor; use Koha::Subscriptions; @@ -629,7 +629,7 @@ sub staged_items_field { my ($marcrecord, $encoding) = MARCfindbreeding($breedingid); die("Could not find the selected record in the reservoir, bailing") unless $marcrecord; - my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']); + my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']); my $price = $infos->{price}; my $replacementprice = $infos->{replacementprice}; my $quantity = $infos->{quantity}; @@ -647,7 +647,7 @@ sub staged_items_field { # Items my @itemlist = (); my $all_items_quantity = 0; - my $alliteminfos = get_infos_syspref_on_item('MarcItemFieldsToOrder', $marcrecord, ['homebranch', 'holdingbranch', 'itype', 'nonpublic_note', 'public_note', 'loc', 'ccode', 'notforloan', 'uri', 'copyno', 'price', 'replacementprice', 'itemcallnumber', 'quantity', 'budget_code']); + my $alliteminfos = C4::Acquisition::Utils::get_infos_syspref_on_item('MarcItemFieldsToOrder', $marcrecord, ['homebranch', 'holdingbranch', 'itype', 'nonpublic_note', 'public_note', 'loc', 'ccode', 'notforloan', 'uri', 'copyno', 'price', 'replacementprice', 'itemcallnumber', 'quantity', 'budget_code']); if ($alliteminfos != -1) { foreach my $iteminfos (@$alliteminfos) { my %itemrecord=( @@ -696,113 +696,10 @@ sub staged_items_field { return (\%cellrecord); } -sub get_infos_syspref { - my ($syspref_name, $record, $field_list) = @_; - my $syspref = C4::Context->preference($syspref_name); - $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt - my $yaml = eval { - YAML::Load($syspref); - }; - if ( $@ ) { - warn "Unable to parse $syspref syspref : $@"; - return (); - } - my $r; - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - if ( my $v = $record->subfield( $f, $sf ) ) { - $r->{$field_name} = $v; - } - last if $yaml->{$field}; - } - } - return $r; -} - -sub equal_number_of_fields { - my ($tags_list, $record) = @_; - my $tag_fields_count; - for my $tag (@$tags_list) { - my @fields = $record->field($tag); - $tag_fields_count->{$tag} = scalar @fields; - } - - my $tags_count; - foreach my $key ( keys %$tag_fields_count ) { - if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok - $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence - return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist - } - } - - return $tags_count; -} - -sub get_infos_syspref_on_item { - my ($syspref_name, $record, $field_list) = @_; - my $syspref = C4::Context->preference($syspref_name); - $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt - my $yaml = eval { - YAML::Load($syspref); - }; - if ( $@ ) { - warn "Unable to parse $syspref syspref : $@"; - return (); - } - my @result; - my @tags_list; - - # Check tags in syspref definition - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - push @tags_list, $f; - } - } - @tags_list = List::MoreUtils::uniq(@tags_list); - - my $tags_count = equal_number_of_fields(\@tags_list, $record); - # Return if the number of these fields in the record is not the same. - return -1 if $tags_count == -1; - - # Gather the fields - my $fields_hash; - foreach my $tag (@tags_list) { - my @tmp_fields; - foreach my $field ($record->field($tag)) { - push @tmp_fields, $field; - } - $fields_hash->{$tag} = \@tmp_fields; - } - - for (my $i = 0; $i < $tags_count; $i++) { - my $r; - for my $field_name ( @$field_list ) { - next unless exists $yaml->{$field_name}; - my @fields = split /\|/, $yaml->{$field_name}; - for my $field ( @fields ) { - my ( $f, $sf ) = split /\$/, $field; - next unless $f and $sf; - my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef; - $r->{$field_name} = $v if (defined $v); - last if $yaml->{$field}; - } - } - push @result, $r; - } - return \@result; -} sub _trim { - return $_[0] unless $_[0]; - $_[0] =~ s/^\s+//; - $_[0] =~ s/\s+$//; - $_[0]; + my $string = shift; + return unless $string; + $string =~ s/^\s+|\s+$//g; + return $string; } -- 2.30.2