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

(-)a/Koha/Acquisition/Utils.pm (+180 lines)
Line 0 Link Here
1
package Koha::Acquisition::Utils;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use C4::Context;
21
22
=head1 NAME
23
24
Koha::Acquisition::Utils - Additional Koha functions for dealing with orders and acquisitions
25
26
=head1 SUBROUTINES
27
28
=head3 get_infos_syspref($syspref_name, $record, $field_list)
29
30
my $data = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', etc.]);
31
32
This subroutine accepts a syspref ( MarcFieldsToOrder ),
33
a marc record, and an arrayref of fields to retrieve.
34
35
The return value is a hashref of key value pairs, where the keys are the field list parameters,
36
and the values are extracted from the MARC record based on the key to MARC field mapping from the
37
given system preference.
38
39
=cut
40
41
sub get_infos_syspref {
42
    my ($syspref_name, $record, $field_list) = @_;
43
    my $syspref = C4::Context->preference($syspref_name);
44
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
45
    my $yaml = eval {
46
        YAML::Load($syspref);
47
    };
48
    if ( $@ ) {
49
        warn "Unable to parse $syspref syspref : $@";
50
        return ();
51
    }
52
    my $r;
53
    for my $field_name ( @$field_list ) {
54
        next unless exists $yaml->{$field_name};
55
        my @fields = split /\|/, $yaml->{$field_name};
56
        for my $field ( @fields ) {
57
            my ( $f, $sf ) = split /\$/, $field;
58
            next unless $f and $sf;
59
            if ( my $v = $record->subfield( $f, $sf ) ) {
60
                $r->{$field_name} = $v;
61
            }
62
            last if $yaml->{$field};
63
        }
64
    }
65
    return $r;
66
}
67
68
=head3 get_infos_syspref_on_item($syspref_name, $record, $field_list)
69
70
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']);
71
72
This subroutine accepts a syspref ( MarcItemFieldsToOrder ),
73
a marc record, and an arrayref of fields to retrieve.
74
75
The return value is a hashref of key value pairs, where the keys are the field list parameters,
76
and the values are extracted from the MARC record based on the key to MARC field mapping from the
77
given system preference.
78
79
The largest difference between get_infos_syspref and get_infos_syspref_on_item is that the former deals
80
with singular marc fields, while the latter works on multiple matching marc fields and returns -1 if it cannot
81
find a matching number of all fields to be looked up.
82
83
=cut
84
85
sub get_infos_syspref_on_item {
86
    my ($syspref_name, $record, $field_list) = @_;
87
    my $syspref = C4::Context->preference($syspref_name);
88
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
89
    my $yaml = eval {
90
        YAML::Load($syspref);
91
    };
92
    if ( $@ ) {
93
        warn "Unable to parse $syspref syspref : $@";
94
        return ();
95
    }
96
    my @result;
97
    my @tags_list;
98
99
    # Check tags in syspref definition
100
    for my $field_name ( @$field_list ) {
101
        next unless exists $yaml->{$field_name};
102
        my @fields = split /\|/, $yaml->{$field_name};
103
        for my $field ( @fields ) {
104
            my ( $f, $sf ) = split /\$/, $field;
105
            next unless $f and $sf;
106
            push @tags_list, $f;
107
        }
108
    }
109
    @tags_list = List::MoreUtils::uniq(@tags_list);
110
111
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
112
    # Return if the number of these fields in the record is not the same.
113
    return -1 if $tags_count == -1;
114
115
    # Gather the fields
116
    my $fields_hash;
117
    foreach my $tag (@tags_list) {
118
        my @tmp_fields;
119
        foreach my $field ($record->field($tag)) {
120
            push @tmp_fields, $field;
121
        }
122
        $fields_hash->{$tag} = \@tmp_fields;
123
    }
124
125
    for (my $i = 0; $i < $tags_count; $i++) {
126
        my $r;
127
        for my $field_name ( @$field_list ) {
128
            next unless exists $yaml->{$field_name};
129
            my @fields = split /\|/, $yaml->{$field_name};
130
            for my $field ( @fields ) {
131
                my ( $f, $sf ) = split /\$/, $field;
132
                next unless $f and $sf;
133
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
134
                $r->{$field_name} = $v if (defined $v);
135
                last if $yaml->{$field};
136
            }
137
        }
138
        push @result, $r;
139
    }
140
    return \@result;
141
}
142
143
=head3 equal_number_of_fields($tags_list, $record)
144
145
$value = equal_number_of_fields(\@tags_list, $record);
146
147
Returns -1 if the number of instances of the given tags are not equal.
148
149
For example, if you need to verify there are equal 975$i's and 975$a's,
150
this will let you know.
151
152
=cut
153
154
sub equal_number_of_fields {
155
    my ($tags_list, $record) = @_;
156
    my $tag_fields_count;
157
    for my $tag (@$tags_list) {
158
        my @fields = $record->field($tag);
159
        $tag_fields_count->{$tag} = scalar @fields;
160
    }
161
162
    my $tags_count;
163
    foreach my $key ( keys %$tag_fields_count ) {
164
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
165
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
166
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
167
        }
168
    }
169
170
    return $tags_count;
171
}
172
173
1;
174
__END__
175
176
=head1 AUTHOR
177
178
Koha Development Team <http://koha-community.org/>
179
180
=cut
(-)a/acqui/addorderiso2709.pl (-110 / +9 lines)
Lines 46-58 use C4::Budgets qw( GetBudget GetBudgets GetBudgetHierarchy CanUserUseBudget Get Link Here
46
use C4::Acquisition qw( populate_order_with_prices );
46
use C4::Acquisition qw( populate_order_with_prices );
47
use C4::Suggestions;    # GetSuggestion
47
use C4::Suggestions;    # GetSuggestion
48
use C4::Members;
48
use C4::Members;
49
49
use C4::Output;
50
use Koha::Number::Price;
50
use C4::Search qw/FindDuplicate/;
51
use Koha::Libraries;
51
use C4::Suggestions;    # GetSuggestion
52
use Koha::Acquisition::Utils;
52
use Koha::Acquisition::Baskets;
53
use Koha::Acquisition::Baskets;
54
use Koha::Acquisition::Booksellers;
53
use Koha::Acquisition::Currencies;
55
use Koha::Acquisition::Currencies;
54
use Koha::Acquisition::Orders;
56
use Koha::Acquisition::Orders;
55
use Koha::Acquisition::Booksellers;
57
use Koha::Libraries;
58
use Koha::Number::Price;
56
use Koha::Patrons;
59
use Koha::Patrons;
57
60
58
my $input = CGI->new;
61
my $input = CGI->new;
Lines 516-522 sub import_biblios_list { Link Here
516
        my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
519
        my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
517
        my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
520
        my $marcrecord = MARC::Record->new_from_usmarc($marcblob) || die "couldn't translate marc information";
518
521
519
        my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']);
522
        my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']);
520
        my $price = $infos->{price};
523
        my $price = $infos->{price};
521
        my $replacementprice = $infos->{replacementprice};
524
        my $replacementprice = $infos->{replacementprice};
522
        my $quantity = $infos->{quantity};
525
        my $quantity = $infos->{quantity};
Lines 535-541 sub import_biblios_list { Link Here
535
        # Items
538
        # Items
536
        my @itemlist = ();
539
        my @itemlist = ();
537
        my $all_items_quantity = 0;
540
        my $all_items_quantity = 0;
538
        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']);
541
        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']);
539
        if ($alliteminfos != -1) {
542
        if ($alliteminfos != -1) {
540
            foreach my $iteminfos (@$alliteminfos) {
543
            foreach my $iteminfos (@$alliteminfos) {
541
                my $item_homebranch = $iteminfos->{homebranch};
544
                my $item_homebranch = $iteminfos->{homebranch};
Lines 671-777 sub add_matcher_list { Link Here
671
    }
674
    }
672
    $template->param(available_matchers => \@matchers);
675
    $template->param(available_matchers => \@matchers);
673
}
676
}
674
675
sub get_infos_syspref {
676
    my ($syspref_name, $record, $field_list) = @_;
677
    my $syspref = C4::Context->preference($syspref_name);
678
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
679
    my $yaml = eval {
680
        YAML::XS::Load(Encode::encode_utf8($syspref));
681
    };
682
    if ( $@ ) {
683
        warn "Unable to parse $syspref syspref : $@";
684
        return ();
685
    }
686
    my $r;
687
    for my $field_name ( @$field_list ) {
688
        next unless exists $yaml->{$field_name};
689
        my @fields = split /\|/, $yaml->{$field_name};
690
        for my $field ( @fields ) {
691
            my ( $f, $sf ) = split /\$/, $field;
692
            next unless $f and $sf;
693
            if ( my $v = $record->subfield( $f, $sf ) ) {
694
                $r->{$field_name} = $v;
695
            }
696
            last if $yaml->{$field};
697
        }
698
    }
699
    return $r;
700
}
701
702
sub equal_number_of_fields {
703
    my ($tags_list, $record) = @_;
704
    my $tag_fields_count;
705
    for my $tag (@$tags_list) {
706
        my @fields = $record->field($tag);
707
        $tag_fields_count->{$tag} = scalar @fields;
708
    }
709
710
    my $tags_count;
711
    foreach my $key ( keys %$tag_fields_count ) {
712
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
713
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
714
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
715
        }
716
    }
717
718
    return $tags_count;
719
}
720
721
sub get_infos_syspref_on_item {
722
    my ($syspref_name, $record, $field_list) = @_;
723
    my $syspref = C4::Context->preference($syspref_name);
724
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
725
    my $yaml = eval {
726
        YAML::XS::Load(Encode::encode_utf8($syspref));
727
    };
728
    if ( $@ ) {
729
        warn "Unable to parse $syspref syspref : $@";
730
        return ();
731
    }
732
    my @result;
733
    my @tags_list;
734
735
    # Check tags in syspref definition
736
    for my $field_name ( @$field_list ) {
737
        next unless exists $yaml->{$field_name};
738
        my @fields = split /\|/, $yaml->{$field_name};
739
        for my $field ( @fields ) {
740
            my ( $f, $sf ) = split /\$/, $field;
741
            next unless $f and $sf;
742
            push @tags_list, $f;
743
        }
744
    }
745
    @tags_list = List::MoreUtils::uniq(@tags_list);
746
747
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
748
    # Return if the number of these fields in the record is not the same.
749
    return -1 if $tags_count == -1;
750
751
    # Gather the fields
752
    my $fields_hash;
753
    foreach my $tag (@tags_list) {
754
        my @tmp_fields;
755
        foreach my $field ($record->field($tag)) {
756
            push @tmp_fields, $field;
757
        }
758
        $fields_hash->{$tag} = \@tmp_fields;
759
    }
760
761
    for (my $i = 0; $i < $tags_count; $i++) {
762
        my $r;
763
        for my $field_name ( @$field_list ) {
764
            next unless exists $yaml->{$field_name};
765
            my @fields = split /\|/, $yaml->{$field_name};
766
            for my $field ( @fields ) {
767
                my ( $f, $sf ) = split /\$/, $field;
768
                next unless $f and $sf;
769
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
770
                $r->{$field_name} = $v if (defined $v);
771
                last if $yaml->{$field};
772
            }
773
        }
774
        push @result, $r;
775
    }
776
    return \@result;
777
}
(-)a/acqui/neworderempty.pl (-112 / +8 lines)
Lines 66-72 the item's id in the breeding reservoir Link Here
66
66
67
use Modern::Perl;
67
use Modern::Perl;
68
use CGI qw ( -utf8 );
68
use CGI qw ( -utf8 );
69
use C4::Context;
70
69
71
use C4::Auth qw( get_template_and_user );
70
use C4::Auth qw( get_template_and_user );
72
use C4::Budgets qw( GetBudget GetBudgetHierarchy CanUserUseBudget );
71
use C4::Budgets qw( GetBudget GetBudgetHierarchy CanUserUseBudget );
Lines 92-101 use C4::ImportBatch qw( SetImportRecordStatus SetMatchedBiblionumber GetImportRe Link Here
92
91
93
use Koha::Acquisition::Booksellers;
92
use Koha::Acquisition::Booksellers;
94
use Koha::Acquisition::Currencies qw( get_active );
93
use Koha::Acquisition::Currencies qw( get_active );
94
use Koha::Acquisition::Utils;
95
use Koha::BiblioFrameworks;
95
use Koha::BiblioFrameworks;
96
use Koha::DateUtils qw( dt_from_string );
96
use Koha::DateUtils qw( dt_from_string );
97
use Koha::MarcSubfieldStructures;
98
use Koha::ItemTypes;
97
use Koha::ItemTypes;
98
use Koha::MarcSubfieldStructures;
99
use Koha::Patrons;
99
use Koha::Patrons;
100
use Koha::RecordProcessor;
100
use Koha::RecordProcessor;
101
use Koha::Subscriptions;
101
use Koha::Subscriptions;
Lines 631-637 sub staged_items_field { Link Here
631
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
631
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
632
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
632
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
633
633
634
    my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
634
    my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
635
    my $price = $infos->{price};
635
    my $price = $infos->{price};
636
    my $replacementprice = $infos->{replacementprice};
636
    my $replacementprice = $infos->{replacementprice};
637
    my $quantity = $infos->{quantity};
637
    my $quantity = $infos->{quantity};
Lines 649-655 sub staged_items_field { Link Here
649
    # Items
649
    # Items
650
    my @itemlist = ();
650
    my @itemlist = ();
651
    my $all_items_quantity = 0;
651
    my $all_items_quantity = 0;
652
    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']);
652
    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']);
653
    if ($alliteminfos != -1) {
653
    if ($alliteminfos != -1) {
654
        foreach my $iteminfos (@$alliteminfos) {
654
        foreach my $iteminfos (@$alliteminfos) {
655
            my %itemrecord=(
655
            my %itemrecord=(
Lines 698-810 sub staged_items_field { Link Here
698
    return (\%cellrecord);
698
    return (\%cellrecord);
699
}
699
}
700
700
701
sub get_infos_syspref {
702
    my ($syspref_name, $record, $field_list) = @_;
703
    my $syspref = C4::Context->preference($syspref_name);
704
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
705
    my $yaml = eval {
706
        YAML::Load($syspref);
707
    };
708
    if ( $@ ) {
709
        warn "Unable to parse $syspref syspref : $@";
710
        return ();
711
    }
712
    my $r;
713
    for my $field_name ( @$field_list ) {
714
        next unless exists $yaml->{$field_name};
715
        my @fields = split /\|/, $yaml->{$field_name};
716
        for my $field ( @fields ) {
717
            my ( $f, $sf ) = split /\$/, $field;
718
            next unless $f and $sf;
719
            if ( my $v = $record->subfield( $f, $sf ) ) {
720
                $r->{$field_name} = $v;
721
            }
722
            last if $yaml->{$field};
723
        }
724
    }
725
    return $r;
726
}
727
728
sub equal_number_of_fields {
729
    my ($tags_list, $record) = @_;
730
    my $tag_fields_count;
731
    for my $tag (@$tags_list) {
732
        my @fields = $record->field($tag);
733
        $tag_fields_count->{$tag} = scalar @fields;
734
    }
735
736
    my $tags_count;
737
    foreach my $key ( keys %$tag_fields_count ) {
738
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
739
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
740
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
741
        }
742
    }
743
744
    return $tags_count;
745
}
746
747
sub get_infos_syspref_on_item {
748
    my ($syspref_name, $record, $field_list) = @_;
749
    my $syspref = C4::Context->preference($syspref_name);
750
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
751
    my $yaml = eval {
752
        YAML::Load($syspref);
753
    };
754
    if ( $@ ) {
755
        warn "Unable to parse $syspref syspref : $@";
756
        return ();
757
    }
758
    my @result;
759
    my @tags_list;
760
761
    # Check tags in syspref definition
762
    for my $field_name ( @$field_list ) {
763
        next unless exists $yaml->{$field_name};
764
        my @fields = split /\|/, $yaml->{$field_name};
765
        for my $field ( @fields ) {
766
            my ( $f, $sf ) = split /\$/, $field;
767
            next unless $f and $sf;
768
            push @tags_list, $f;
769
        }
770
    }
771
    @tags_list = List::MoreUtils::uniq(@tags_list);
772
773
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
774
    # Return if the number of these fields in the record is not the same.
775
    return -1 if $tags_count == -1;
776
777
    # Gather the fields
778
    my $fields_hash;
779
    foreach my $tag (@tags_list) {
780
        my @tmp_fields;
781
        foreach my $field ($record->field($tag)) {
782
            push @tmp_fields, $field;
783
        }
784
        $fields_hash->{$tag} = \@tmp_fields;
785
    }
786
787
    for (my $i = 0; $i < $tags_count; $i++) {
788
        my $r;
789
        for my $field_name ( @$field_list ) {
790
            next unless exists $yaml->{$field_name};
791
            my @fields = split /\|/, $yaml->{$field_name};
792
            for my $field ( @fields ) {
793
                my ( $f, $sf ) = split /\$/, $field;
794
                next unless $f and $sf;
795
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
796
                $r->{$field_name} = $v if (defined $v);
797
                last if $yaml->{$field};
798
            }
799
        }
800
        push @result, $r;
801
    }
802
    return \@result;
803
}
804
701
805
sub _trim {
702
sub _trim {
806
    return $_[0] unless $_[0];
703
    my $string = shift;
807
    $_[0] =~ s/^\s+//;
704
    return unless $string;
808
    $_[0] =~ s/\s+$//;
705
    $string =~ s/^\s+|\s+$//g;
809
    $_[0];
706
    return $string;
810
}
707
}
811
- 

Return to bug 20817