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 (-119 / +14 lines)
Lines 28-54 use YAML::XS; Link Here
28
use List::MoreUtils qw/uniq/;
28
use List::MoreUtils qw/uniq/;
29
use Encode;
29
use Encode;
30
30
31
use C4::Context;
32
use C4::Auth;
33
use C4::Output;
34
use C4::ImportBatch;
35
use C4::Matcher;
36
use C4::Search qw/FindDuplicate/;
37
use C4::Acquisition;
31
use C4::Acquisition;
32
use C4::Auth;
38
use C4::Biblio;
33
use C4::Biblio;
34
use C4::Budgets;
35
use C4::Context;
36
use C4::ImportBatch;
39
use C4::Items;
37
use C4::Items;
40
use C4::Koha;
38
use C4::Koha;
41
use C4::Budgets;
39
use C4::Matcher;
42
use C4::Acquisition;
43
use C4::Suggestions;    # GetSuggestion
44
use C4::Members;
40
use C4::Members;
45
41
use C4::Output;
46
use Koha::Number::Price;
42
use C4::Search qw/FindDuplicate/;
47
use Koha::Libraries;
43
use C4::Suggestions;    # GetSuggestion
44
use Koha::Acquisition::Utils;
48
use Koha::Acquisition::Baskets;
45
use Koha::Acquisition::Baskets;
46
use Koha::Acquisition::Booksellers;
49
use Koha::Acquisition::Currencies;
47
use Koha::Acquisition::Currencies;
50
use Koha::Acquisition::Orders;
48
use Koha::Acquisition::Orders;
51
use Koha::Acquisition::Booksellers;
49
use Koha::Libraries;
50
use Koha::Number::Price;
52
use Koha::Patrons;
51
use Koha::Patrons;
53
52
54
my $input = CGI->new;
53
my $input = CGI->new;
Lines 520-526 sub import_biblios_list { Link Here
520
        my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
519
        my ( $marcblob, $encoding ) = GetImportRecordMarc( $biblio->{'import_record_id'} );
521
        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";
522
521
523
        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']);
524
        my $price = $infos->{price};
523
        my $price = $infos->{price};
525
        my $replacementprice = $infos->{replacementprice};
524
        my $replacementprice = $infos->{replacementprice};
526
        my $quantity = $infos->{quantity};
525
        my $quantity = $infos->{quantity};
Lines 539-545 sub import_biblios_list { Link Here
539
        # Items
538
        # Items
540
        my @itemlist = ();
539
        my @itemlist = ();
541
        my $all_items_quantity = 0;
540
        my $all_items_quantity = 0;
542
        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']);
543
        if ($alliteminfos != -1) {
542
        if ($alliteminfos != -1) {
544
            foreach my $iteminfos (@$alliteminfos) {
543
            foreach my $iteminfos (@$alliteminfos) {
545
                my $item_homebranch = $iteminfos->{homebranch};
544
                my $item_homebranch = $iteminfos->{homebranch};
Lines 675-781 sub add_matcher_list { Link Here
675
    }
674
    }
676
    $template->param(available_matchers => \@matchers);
675
    $template->param(available_matchers => \@matchers);
677
}
676
}
678
679
sub get_infos_syspref {
680
    my ($syspref_name, $record, $field_list) = @_;
681
    my $syspref = C4::Context->preference($syspref_name);
682
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
683
    my $yaml = eval {
684
        YAML::XS::Load(Encode::encode_utf8($syspref));
685
    };
686
    if ( $@ ) {
687
        warn "Unable to parse $syspref syspref : $@";
688
        return ();
689
    }
690
    my $r;
691
    for my $field_name ( @$field_list ) {
692
        next unless exists $yaml->{$field_name};
693
        my @fields = split /\|/, $yaml->{$field_name};
694
        for my $field ( @fields ) {
695
            my ( $f, $sf ) = split /\$/, $field;
696
            next unless $f and $sf;
697
            if ( my $v = $record->subfield( $f, $sf ) ) {
698
                $r->{$field_name} = $v;
699
            }
700
            last if $yaml->{$field};
701
        }
702
    }
703
    return $r;
704
}
705
706
sub equal_number_of_fields {
707
    my ($tags_list, $record) = @_;
708
    my $tag_fields_count;
709
    for my $tag (@$tags_list) {
710
        my @fields = $record->field($tag);
711
        $tag_fields_count->{$tag} = scalar @fields;
712
    }
713
714
    my $tags_count;
715
    foreach my $key ( keys %$tag_fields_count ) {
716
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
717
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
718
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
719
        }
720
    }
721
722
    return $tags_count;
723
}
724
725
sub get_infos_syspref_on_item {
726
    my ($syspref_name, $record, $field_list) = @_;
727
    my $syspref = C4::Context->preference($syspref_name);
728
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
729
    my $yaml = eval {
730
        YAML::XS::Load(Encode::encode_utf8($syspref));
731
    };
732
    if ( $@ ) {
733
        warn "Unable to parse $syspref syspref : $@";
734
        return ();
735
    }
736
    my @result;
737
    my @tags_list;
738
739
    # Check tags in syspref definition
740
    for my $field_name ( @$field_list ) {
741
        next unless exists $yaml->{$field_name};
742
        my @fields = split /\|/, $yaml->{$field_name};
743
        for my $field ( @fields ) {
744
            my ( $f, $sf ) = split /\$/, $field;
745
            next unless $f and $sf;
746
            push @tags_list, $f;
747
        }
748
    }
749
    @tags_list = List::MoreUtils::uniq(@tags_list);
750
751
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
752
    # Return if the number of these fields in the record is not the same.
753
    return -1 if $tags_count == -1;
754
755
    # Gather the fields
756
    my $fields_hash;
757
    foreach my $tag (@tags_list) {
758
        my @tmp_fields;
759
        foreach my $field ($record->field($tag)) {
760
            push @tmp_fields, $field;
761
        }
762
        $fields_hash->{$tag} = \@tmp_fields;
763
    }
764
765
    for (my $i = 0; $i < $tags_count; $i++) {
766
        my $r;
767
        for my $field_name ( @$field_list ) {
768
            next unless exists $yaml->{$field_name};
769
            my @fields = split /\|/, $yaml->{$field_name};
770
            for my $field ( @fields ) {
771
                my ( $f, $sf ) = split /\$/, $field;
772
                next unless $f and $sf;
773
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
774
                $r->{$field_name} = $v if (defined $v);
775
                last if $yaml->{$field};
776
            }
777
        }
778
        push @result, $r;
779
    }
780
    return \@result;
781
}
(-)a/acqui/neworderempty.pl (-117 / +12 lines)
Lines 66-82 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
70
use C4::Acquisition;
71
use C4::Auth;
71
use C4::Auth;
72
use C4::Biblio; # GetBiblioData GetMarcPrice
72
use C4::Budgets;
73
use C4::Budgets;
73
74
use C4::Context;
74
use C4::Acquisition;
75
use C4::Contract;
75
use C4::Contract;
76
use C4::Suggestions;	# GetSuggestion
76
use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus/;  # needed for z3950 import:
77
use C4::Biblio;			# GetBiblioData GetMarcPrice
78
use C4::Items; #PrepareItemRecord
77
use C4::Items; #PrepareItemRecord
79
use C4::Output;
80
use C4::Koha;
78
use C4::Koha;
81
use C4::Members;
79
use C4::Members;
82
use C4::Search qw/FindDuplicate/;
80
use C4::Search qw/FindDuplicate/;
Lines 86-95 use C4::ImportBatch qw/GetImportRecordMarc SetImportRecordStatus SetMatchedBibli Link Here
86
84
87
use Koha::Acquisition::Booksellers;
85
use Koha::Acquisition::Booksellers;
88
use Koha::Acquisition::Currencies;
86
use Koha::Acquisition::Currencies;
87
use Koha::Acquisition::Utils;
89
use Koha::BiblioFrameworks;
88
use Koha::BiblioFrameworks;
90
use Koha::DateUtils qw( dt_from_string );
89
use Koha::DateUtils qw( dt_from_string );
91
use Koha::MarcSubfieldStructures;
92
use Koha::ItemTypes;
90
use Koha::ItemTypes;
91
use Koha::MarcSubfieldStructures;
93
use Koha::Patrons;
92
use Koha::Patrons;
94
use Koha::RecordProcessor;
93
use Koha::RecordProcessor;
95
use Koha::Subscriptions;
94
use Koha::Subscriptions;
Lines 627-633 sub staged_items_field { Link Here
627
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
626
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
628
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
627
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
629
628
630
    my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
629
    my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
631
    my $price = $infos->{price};
630
    my $price = $infos->{price};
632
    my $replacementprice = $infos->{replacementprice};
631
    my $replacementprice = $infos->{replacementprice};
633
    my $quantity = $infos->{quantity};
632
    my $quantity = $infos->{quantity};
Lines 645-651 sub staged_items_field { Link Here
645
    # Items
644
    # Items
646
    my @itemlist = ();
645
    my @itemlist = ();
647
    my $all_items_quantity = 0;
646
    my $all_items_quantity = 0;
648
    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']);
647
    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']);
649
    if ($alliteminfos != -1) {
648
    if ($alliteminfos != -1) {
650
        foreach my $iteminfos (@$alliteminfos) {
649
        foreach my $iteminfos (@$alliteminfos) {
651
            my %itemrecord=(
650
            my %itemrecord=(
Lines 694-806 sub staged_items_field { Link Here
694
    return (\%cellrecord);
693
    return (\%cellrecord);
695
}
694
}
696
695
697
sub get_infos_syspref {
698
    my ($syspref_name, $record, $field_list) = @_;
699
    my $syspref = C4::Context->preference($syspref_name);
700
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
701
    my $yaml = eval {
702
        YAML::Load($syspref);
703
    };
704
    if ( $@ ) {
705
        warn "Unable to parse $syspref syspref : $@";
706
        return ();
707
    }
708
    my $r;
709
    for my $field_name ( @$field_list ) {
710
        next unless exists $yaml->{$field_name};
711
        my @fields = split /\|/, $yaml->{$field_name};
712
        for my $field ( @fields ) {
713
            my ( $f, $sf ) = split /\$/, $field;
714
            next unless $f and $sf;
715
            if ( my $v = $record->subfield( $f, $sf ) ) {
716
                $r->{$field_name} = $v;
717
            }
718
            last if $yaml->{$field};
719
        }
720
    }
721
    return $r;
722
}
723
724
sub equal_number_of_fields {
725
    my ($tags_list, $record) = @_;
726
    my $tag_fields_count;
727
    for my $tag (@$tags_list) {
728
        my @fields = $record->field($tag);
729
        $tag_fields_count->{$tag} = scalar @fields;
730
    }
731
732
    my $tags_count;
733
    foreach my $key ( keys %$tag_fields_count ) {
734
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
735
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
736
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
737
        }
738
    }
739
740
    return $tags_count;
741
}
742
743
sub get_infos_syspref_on_item {
744
    my ($syspref_name, $record, $field_list) = @_;
745
    my $syspref = C4::Context->preference($syspref_name);
746
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
747
    my $yaml = eval {
748
        YAML::Load($syspref);
749
    };
750
    if ( $@ ) {
751
        warn "Unable to parse $syspref syspref : $@";
752
        return ();
753
    }
754
    my @result;
755
    my @tags_list;
756
757
    # Check tags in syspref definition
758
    for my $field_name ( @$field_list ) {
759
        next unless exists $yaml->{$field_name};
760
        my @fields = split /\|/, $yaml->{$field_name};
761
        for my $field ( @fields ) {
762
            my ( $f, $sf ) = split /\$/, $field;
763
            next unless $f and $sf;
764
            push @tags_list, $f;
765
        }
766
    }
767
    @tags_list = List::MoreUtils::uniq(@tags_list);
768
769
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
770
    # Return if the number of these fields in the record is not the same.
771
    return -1 if $tags_count == -1;
772
773
    # Gather the fields
774
    my $fields_hash;
775
    foreach my $tag (@tags_list) {
776
        my @tmp_fields;
777
        foreach my $field ($record->field($tag)) {
778
            push @tmp_fields, $field;
779
        }
780
        $fields_hash->{$tag} = \@tmp_fields;
781
    }
782
783
    for (my $i = 0; $i < $tags_count; $i++) {
784
        my $r;
785
        for my $field_name ( @$field_list ) {
786
            next unless exists $yaml->{$field_name};
787
            my @fields = split /\|/, $yaml->{$field_name};
788
            for my $field ( @fields ) {
789
                my ( $f, $sf ) = split /\$/, $field;
790
                next unless $f and $sf;
791
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
792
                $r->{$field_name} = $v if (defined $v);
793
                last if $yaml->{$field};
794
            }
795
        }
796
        push @result, $r;
797
    }
798
    return \@result;
799
}
800
696
801
sub _trim {
697
sub _trim {
802
    return $_[0] unless $_[0];
698
    my $string = shift;
803
    $_[0] =~ s/^\s+//;
699
    return unless $string;
804
    $_[0] =~ s/\s+$//;
700
    $string =~ s/^\s+|\s+$//g;
805
    $_[0];
701
    return $string;
806
}
702
}
807
- 

Return to bug 20817