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 44-57 use C4::Items qw( PrepareItemrecordDisplay AddItemFromMarc ); Link Here
44
use C4::Budgets qw( GetBudget GetBudgets GetBudgetHierarchy CanUserUseBudget GetBudgetByCode );
44
use C4::Budgets qw( GetBudget GetBudgets GetBudgetHierarchy CanUserUseBudget GetBudgetByCode );
45
use C4::Suggestions;    # GetSuggestion
45
use C4::Suggestions;    # GetSuggestion
46
use C4::Members;
46
use C4::Members;
47
47
use C4::Output;
48
use Koha::Number::Price;
48
use C4::Search qw/FindDuplicate/;
49
use Koha::Libraries;
49
use C4::Suggestions;    # GetSuggestion
50
use Koha::Acquisition::Baskets;
50
use Koha::Acquisition::Baskets;
51
use Koha::Acquisition::Booksellers;
51
use Koha::Acquisition::Currencies;
52
use Koha::Acquisition::Currencies;
52
use Koha::Acquisition::Orders;
53
use Koha::Acquisition::Orders;
53
use Koha::Acquisition::Booksellers;
54
use Koha::Acquisition::Utils;
54
use Koha::Import::Records;
55
use Koha::Import::Records;
56
use Koha::Libraries;
57
use Koha::Number::Price;
55
use Koha::Patrons;
58
use Koha::Patrons;
56
59
57
my $input = CGI->new;
60
my $input = CGI->new;
Lines 489-495 sub import_biblios_list { Link Here
489
        );
492
        );
490
        my $marcrecord = $import_record->get_marc_record || die "couldn't translate marc information";
493
        my $marcrecord = $import_record->get_marc_record || die "couldn't translate marc information";
491
494
492
        my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']);
495
        my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2','replacementprice']);
493
        my $price = $infos->{price};
496
        my $price = $infos->{price};
494
        my $replacementprice = $infos->{replacementprice};
497
        my $replacementprice = $infos->{replacementprice};
495
        my $quantity = $infos->{quantity};
498
        my $quantity = $infos->{quantity};
Lines 508-514 sub import_biblios_list { Link Here
508
        # Items
511
        # Items
509
        my @itemlist = ();
512
        my @itemlist = ();
510
        my $all_items_quantity = 0;
513
        my $all_items_quantity = 0;
511
        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']);
514
        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']);
512
        if ($alliteminfos != -1) {
515
        if ($alliteminfos != -1) {
513
            foreach my $iteminfos (@$alliteminfos) {
516
            foreach my $iteminfos (@$alliteminfos) {
514
                my $item_homebranch = $iteminfos->{homebranch};
517
                my $item_homebranch = $iteminfos->{homebranch};
Lines 643-749 sub add_matcher_list { Link Here
643
    }
646
    }
644
    $template->param(available_matchers => \@matchers);
647
    $template->param(available_matchers => \@matchers);
645
}
648
}
646
647
sub get_infos_syspref {
648
    my ($syspref_name, $record, $field_list) = @_;
649
    my $syspref = C4::Context->preference($syspref_name);
650
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
651
    my $yaml = eval {
652
        YAML::XS::Load(Encode::encode_utf8($syspref));
653
    };
654
    if ( $@ ) {
655
        warn "Unable to parse $syspref syspref : $@";
656
        return ();
657
    }
658
    my $r;
659
    for my $field_name ( @$field_list ) {
660
        next unless exists $yaml->{$field_name};
661
        my @fields = split /\|/, $yaml->{$field_name};
662
        for my $field ( @fields ) {
663
            my ( $f, $sf ) = split /\$/, $field;
664
            next unless $f and $sf;
665
            if ( my $v = $record->subfield( $f, $sf ) ) {
666
                $r->{$field_name} = $v;
667
            }
668
            last if $yaml->{$field};
669
        }
670
    }
671
    return $r;
672
}
673
674
sub equal_number_of_fields {
675
    my ($tags_list, $record) = @_;
676
    my $tag_fields_count;
677
    for my $tag (@$tags_list) {
678
        my @fields = $record->field($tag);
679
        $tag_fields_count->{$tag} = scalar @fields;
680
    }
681
682
    my $tags_count;
683
    foreach my $key ( keys %$tag_fields_count ) {
684
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
685
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
686
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
687
        }
688
    }
689
690
    return $tags_count;
691
}
692
693
sub get_infos_syspref_on_item {
694
    my ($syspref_name, $record, $field_list) = @_;
695
    my $syspref = C4::Context->preference($syspref_name);
696
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
697
    my $yaml = eval {
698
        YAML::XS::Load(Encode::encode_utf8($syspref));
699
    };
700
    if ( $@ ) {
701
        warn "Unable to parse $syspref syspref : $@";
702
        return ();
703
    }
704
    my @result;
705
    my @tags_list;
706
707
    # Check tags in syspref definition
708
    for my $field_name ( @$field_list ) {
709
        next unless exists $yaml->{$field_name};
710
        my @fields = split /\|/, $yaml->{$field_name};
711
        for my $field ( @fields ) {
712
            my ( $f, $sf ) = split /\$/, $field;
713
            next unless $f and $sf;
714
            push @tags_list, $f;
715
        }
716
    }
717
    @tags_list = List::MoreUtils::uniq(@tags_list);
718
719
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
720
    # Return if the number of these fields in the record is not the same.
721
    return -1 if $tags_count == -1;
722
723
    # Gather the fields
724
    my $fields_hash;
725
    foreach my $tag (@tags_list) {
726
        my @tmp_fields;
727
        foreach my $field ($record->field($tag)) {
728
            push @tmp_fields, $field;
729
        }
730
        $fields_hash->{$tag} = \@tmp_fields;
731
    }
732
733
    for (my $i = 0; $i < $tags_count; $i++) {
734
        my $r;
735
        for my $field_name ( @$field_list ) {
736
            next unless exists $yaml->{$field_name};
737
            my @fields = split /\|/, $yaml->{$field_name};
738
            for my $field ( @fields ) {
739
                my ( $f, $sf ) = split /\$/, $field;
740
                next unless $f and $sf;
741
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
742
                $r->{$field_name} = $v if (defined $v);
743
                last if $yaml->{$field};
744
            }
745
        }
746
        push @result, $r;
747
    }
748
    return \@result;
749
}
(-)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
use Koha::Acquisition::Booksellers;
91
use Koha::Acquisition::Booksellers;
93
use Koha::Acquisition::Currencies qw( get_active );
92
use Koha::Acquisition::Currencies qw( get_active );
94
use Koha::Biblios;
93
use Koha::Biblios;
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 629-635 sub staged_items_field { Link Here
629
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
629
    my ($marcrecord, $encoding) = MARCfindbreeding($breedingid);
630
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
630
    die("Could not find the selected record in the reservoir, bailing") unless $marcrecord;
631
631
632
    my $infos = get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
632
    my $infos = Koha::Acquisition::Utils::get_infos_syspref('MarcFieldsToOrder', $marcrecord, ['price', 'quantity', 'budget_code', 'discount', 'sort1', 'sort2', 'replacementprice']);
633
    my $price = $infos->{price};
633
    my $price = $infos->{price};
634
    my $replacementprice = $infos->{replacementprice};
634
    my $replacementprice = $infos->{replacementprice};
635
    my $quantity = $infos->{quantity};
635
    my $quantity = $infos->{quantity};
Lines 647-653 sub staged_items_field { Link Here
647
    # Items
647
    # Items
648
    my @itemlist = ();
648
    my @itemlist = ();
649
    my $all_items_quantity = 0;
649
    my $all_items_quantity = 0;
650
    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']);
650
    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']);
651
    if ($alliteminfos != -1) {
651
    if ($alliteminfos != -1) {
652
        foreach my $iteminfos (@$alliteminfos) {
652
        foreach my $iteminfos (@$alliteminfos) {
653
            my %itemrecord=(
653
            my %itemrecord=(
Lines 696-808 sub staged_items_field { Link Here
696
    return (\%cellrecord);
696
    return (\%cellrecord);
697
}
697
}
698
698
699
sub get_infos_syspref {
700
    my ($syspref_name, $record, $field_list) = @_;
701
    my $syspref = C4::Context->preference($syspref_name);
702
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
703
    my $yaml = eval {
704
        YAML::Load($syspref);
705
    };
706
    if ( $@ ) {
707
        warn "Unable to parse $syspref syspref : $@";
708
        return ();
709
    }
710
    my $r;
711
    for my $field_name ( @$field_list ) {
712
        next unless exists $yaml->{$field_name};
713
        my @fields = split /\|/, $yaml->{$field_name};
714
        for my $field ( @fields ) {
715
            my ( $f, $sf ) = split /\$/, $field;
716
            next unless $f and $sf;
717
            if ( my $v = $record->subfield( $f, $sf ) ) {
718
                $r->{$field_name} = $v;
719
            }
720
            last if $yaml->{$field};
721
        }
722
    }
723
    return $r;
724
}
725
726
sub equal_number_of_fields {
727
    my ($tags_list, $record) = @_;
728
    my $tag_fields_count;
729
    for my $tag (@$tags_list) {
730
        my @fields = $record->field($tag);
731
        $tag_fields_count->{$tag} = scalar @fields;
732
    }
733
734
    my $tags_count;
735
    foreach my $key ( keys %$tag_fields_count ) {
736
        if ( $tag_fields_count->{$key} > 0 ) { # Having 0 of a field is ok
737
            $tags_count //= $tag_fields_count->{$key}; # Start with the count from the first occurrence
738
            return -1 if $tag_fields_count->{$key} != $tags_count; # All counts of various fields should be equal if they exist
739
        }
740
    }
741
742
    return $tags_count;
743
}
744
745
sub get_infos_syspref_on_item {
746
    my ($syspref_name, $record, $field_list) = @_;
747
    my $syspref = C4::Context->preference($syspref_name);
748
    $syspref = "$syspref\n\n"; # YAML is anal on ending \n. Surplus does not hurt
749
    my $yaml = eval {
750
        YAML::Load($syspref);
751
    };
752
    if ( $@ ) {
753
        warn "Unable to parse $syspref syspref : $@";
754
        return ();
755
    }
756
    my @result;
757
    my @tags_list;
758
759
    # Check tags in syspref definition
760
    for my $field_name ( @$field_list ) {
761
        next unless exists $yaml->{$field_name};
762
        my @fields = split /\|/, $yaml->{$field_name};
763
        for my $field ( @fields ) {
764
            my ( $f, $sf ) = split /\$/, $field;
765
            next unless $f and $sf;
766
            push @tags_list, $f;
767
        }
768
    }
769
    @tags_list = List::MoreUtils::uniq(@tags_list);
770
771
    my $tags_count = equal_number_of_fields(\@tags_list, $record);
772
    # Return if the number of these fields in the record is not the same.
773
    return -1 if $tags_count == -1;
774
775
    # Gather the fields
776
    my $fields_hash;
777
    foreach my $tag (@tags_list) {
778
        my @tmp_fields;
779
        foreach my $field ($record->field($tag)) {
780
            push @tmp_fields, $field;
781
        }
782
        $fields_hash->{$tag} = \@tmp_fields;
783
    }
784
785
    for (my $i = 0; $i < $tags_count; $i++) {
786
        my $r;
787
        for my $field_name ( @$field_list ) {
788
            next unless exists $yaml->{$field_name};
789
            my @fields = split /\|/, $yaml->{$field_name};
790
            for my $field ( @fields ) {
791
                my ( $f, $sf ) = split /\$/, $field;
792
                next unless $f and $sf;
793
                my $v = $fields_hash->{$f}[$i] ? $fields_hash->{$f}[$i]->subfield( $sf ) : undef;
794
                $r->{$field_name} = $v if (defined $v);
795
                last if $yaml->{$field};
796
            }
797
        }
798
        push @result, $r;
799
    }
800
    return \@result;
801
}
802
699
803
sub _trim {
700
sub _trim {
804
    return $_[0] unless $_[0];
701
    my $string = shift;
805
    $_[0] =~ s/^\s+//;
702
    return unless $string;
806
    $_[0] =~ s/\s+$//;
703
    $string =~ s/^\s+|\s+$//g;
807
    $_[0];
704
    return $string;
808
}
705
}
809
- 

Return to bug 20817