Bugzilla – Attachment 105215 Details for
Bug 20817
Add ability to retain 9xx fields when adding on order item to existing record
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 20817: Move subroutines to a new Perl module
Bug-20817-Move-subroutines-to-a-new-Perl-module.patch (text/plain), 19.30 KB, created by
Kyle M Hall
on 2020-05-21 15:12:35 UTC
(
hide
)
Description:
Bug 20817: Move subroutines to a new Perl module
Filename:
MIME Type:
Creator:
Kyle M Hall
Created:
2020-05-21 15:12:35 UTC
Size:
19.30 KB
patch
obsolete
>From 652f32732d5ec391239e97770715cbe016719c4a Mon Sep 17 00:00:00 2001 >From: Kyle M Hall <kyle@bywatersolutions.com> >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 | 132 +++------------------------- > acqui/neworderempty.pl | 136 ++++------------------------ > 3 files changed, 209 insertions(+), 239 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 <http://www.gnu.org/licenses>. >+ >+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 <http://koha-community.org/> >+ >+=cut >diff --git a/acqui/addorderiso2709.pl b/acqui/addorderiso2709.pl >index 1caee77950..1ba3206c17 100755 >--- a/acqui/addorderiso2709.pl >+++ b/acqui/addorderiso2709.pl >@@ -27,27 +27,26 @@ use Carp; > use YAML qw/Load/; > use List::MoreUtils qw/uniq/; > >-use C4::Context; >-use C4::Auth; >-use C4::Output; >-use C4::ImportBatch; >-use C4::Matcher; >-use C4::Search qw/FindDuplicate/; > use C4::Acquisition; >+use C4::Auth; > use C4::Biblio; >+use C4::Budgets; >+use C4::Context; >+use C4::ImportBatch; > use C4::Items; > use C4::Koha; >-use C4::Budgets; >-use C4::Acquisition; >-use C4::Suggestions; # GetSuggestion >+use C4::Matcher; > 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::Utils; > use Koha::Acquisition::Baskets; >+use Koha::Acquisition::Booksellers; > use Koha::Acquisition::Currencies; > use Koha::Acquisition::Orders; >-use Koha::Acquisition::Booksellers; >+use Koha::Libraries; >+use Koha::Number::Price; > use Koha::Patrons; > > my $input = new CGI; >@@ -514,7 +513,7 @@ sub import_biblios_list { > my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} ); > my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || 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}; >@@ -533,7 +532,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}; >@@ -670,106 +669,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::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; >-} >diff --git a/acqui/neworderempty.pl b/acqui/neworderempty.pl >index cdf8d6088e..8fc1ffff75 100755 >--- a/acqui/neworderempty.pl >+++ b/acqui/neworderempty.pl >@@ -66,30 +66,27 @@ the item's id in the breeding reservoir > > use Modern::Perl; > use CGI qw ( -utf8 ); >-use C4::Context; > >+use C4::Acquisition; > use C4::Auth; >+use C4::Biblio; # GetBiblioData GetMarcPrice > use C4::Budgets; >- >-use C4::Acquisition; >+use C4::Context; > use C4::Contract; >-use C4::Suggestions; # GetSuggestion >-use C4::Biblio; # GetBiblioData GetMarcPrice >+use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/; # needed for z3950 import: > use C4::Items; #PrepareItemRecord >-use C4::Output; > use C4::Koha; > use C4::Members; >-use C4::Search qw/FindDuplicate/; >- >-#needed for z3950 import: >-use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/; >- >+use C4::Output; >+use C4::Search qw/ FindDuplicate /; >+use C4::Suggestions; # GetSuggestion > use Koha::Acquisition::Booksellers; > use Koha::Acquisition::Currencies; >+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; >@@ -622,7 +619,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}; >@@ -640,7 +637,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=( >@@ -689,113 +686,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.24.1 (Apple Git-126)
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 20817
:
79867
|
80537
|
86711
|
86746
|
105214
|
105215
|
105216
|
105217
|
105218
|
105219
|
115343
|
118371
|
118372
|
118373
|
118374
|
118375
|
118376
|
118377
|
118378
|
122692
|
122834
|
122841
|
122858
|
122861
|
128766
|
128767
|
128768
|
128769
|
128770
|
128771
|
128772
|
128773
|
128774
|
128775
|
128776
|
128777
|
128782
|
128783
|
128785
|
128786
|
128787
|
128788
|
128789
|
128790
|
128791
|
128792
|
128793
|
128794
|
128795
|
128796
|
128797
|
128798
|
131732
|
131733
|
131734
|
131735
|
131736
|
131737
|
131738
|
131739
|
131740
|
131741
|
131742
|
131743
|
131744
|
131745
|
131746
|
131747
|
131748
|
131749
|
142630
|
142631
|
142632
|
142633
|
142634
|
142635
|
142636
|
142637
|
142638
|
142639
|
142640
|
142641
|
142642
|
142643
|
142644
|
142645
|
142646
|
142647
|
142648
|
142649
|
142650
|
142651
|
142829