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

Return to bug 20817