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

(-)a/Koha/Exporter/Record.pm (-48 / +57 lines)
Lines 3-8 package Koha::Exporter::Record; Link Here
3
use Modern::Perl;
3
use Modern::Perl;
4
use MARC::File::XML;
4
use MARC::File::XML;
5
use MARC::File::USMARC;
5
use MARC::File::USMARC;
6
use Carp;
6
7
7
use C4::AuthoritiesMarc;
8
use C4::AuthoritiesMarc;
8
use C4::Biblio  qw( GetMarcFromKohaField );
9
use C4::Biblio  qw( GetMarcFromKohaField );
Lines 18-23 use List::Util qw( all any ); Link Here
18
use MARC::Record;
19
use MARC::Record;
19
use MARC::File::XML;
20
use MARC::File::XML;
20
21
22
my %marc_conditions_operators = (
23
    '=' => sub {
24
        return $_[0] eq $_[1];
25
    },
26
    '!=' => sub {
27
        return $_[0] ne $_[1];
28
    },
29
    '>' => sub {
30
        return $_[0] gt $_[1];
31
    },
32
    '<' => sub {
33
        return $_[0] lt $_[1];
34
    },
35
);
36
37
# If multiple conditions all are required to match (and)
38
# For matching against multiple marc targets all are also required to match
39
sub _record_match_conditions {
40
    my ($record, $conditions) = @_;
41
42
    foreach my $condition (@{$conditions}) {
43
        my ($field_tag, $subfield, $operator, $match_value) = @{$condition};
44
        my @fields = $record->field($field_tag);
45
        my $no_target = 0;
46
47
        if (!@fields) {
48
            $no_target = 1;
49
        }
50
        else {
51
            if ($operator eq '?') {
52
                return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
53
            } elsif ($operator eq '!?') {
54
                return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
55
            } else {
56
                my $op;
57
                if (exists $marc_conditions_operators{$operator}) {
58
                    $op = $marc_conditions_operators{$operator};
59
                } else {
60
                    croak "Invalid operator: $op";
61
                }
62
                my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields;
63
                if (!@target_values) {
64
                    $no_target = 1;
65
                }
66
                else {
67
                    return unless all { $op->($_, $match_value) } @target_values;
68
                }
69
            }
70
        }
71
        return if $no_target && $operator ne '!=';
72
    }
73
    return 1;
74
}
75
21
sub _get_record_for_export {
76
sub _get_record_for_export {
22
    my ($params)           = @_;
77
    my ($params)           = @_;
23
    my $record_type        = $params->{record_type};
78
    my $record_type        = $params->{record_type};
Lines 41-94 sub _get_record_for_export { Link Here
41
        return;
96
        return;
42
    }
97
    }
43
98
44
    # If multiple conditions all are required to match (and)
45
    # For matching against multiple marc targets all are also required to match
46
    my %operators = (
47
        '=' => sub {
48
            return $_[0] eq $_[1];
49
        },
50
        '!=' => sub {
51
            return $_[0] ne $_[1];
52
        },
53
        '>' => sub {
54
            return $_[0] gt $_[1];
55
        },
56
        '<' => sub {
57
            return $_[0] lt $_[1];
58
        },
59
    );
60
    if ($conditions) {
61
        foreach my $condition ( @{$conditions} ) {
62
            my ( $field_tag, $subfield, $operator, $match_value ) = @{$condition};
63
            my @fields    = $record->field($field_tag);
64
            my $no_target = 0;
65
66
            if ( !@fields ) {
67
                $no_target = 1;
68
            } else {
69
                if ( $operator eq '?' ) {
70
                    return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
71
                } elsif ( $operator eq '!?' ) {
72
                    return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
73
                } else {
74
                    my $op;
75
                    if ( exists $operators{$operator} ) {
76
                        $op = $operators{$operator};
77
                    } else {
78
                        die("Invalid operator: $op");
79
                    }
80
                    my @target_values = map { $subfield ? $_->subfield($subfield) : ( $_->data() ) } @fields;
81
                    if ( !@target_values ) {
82
                        $no_target = 1;
83
                    } else {
84
                        return unless all { $op->( $_, $match_value ) } @target_values;
85
                    }
86
                }
87
            }
88
            return if $no_target && $operator ne '!=';
89
        }
90
    }
91
92
    if ($dont_export_fields) {
99
    if ($dont_export_fields) {
93
        for my $f ( split / /, $dont_export_fields ) {
100
        for my $f ( split / /, $dont_export_fields ) {
94
            if ( $f =~ m/^(\d{3})(.)?$/ ) {
101
            if ( $f =~ m/^(\d{3})(.)?$/ ) {
Lines 108-113 sub _get_record_for_export { Link Here
108
            }
115
            }
109
        }
116
        }
110
    }
117
    }
118
119
    return if $conditions && !_record_match_conditions($record, $conditions);
111
    C4::Biblio::RemoveAllNsb($record) if $clean;
120
    C4::Biblio::RemoveAllNsb($record) if $clean;
112
    return $record;
121
    return $record;
113
}
122
}
(-)a/misc/export_records.pl (-5 / +12 lines)
Lines 34-39 use Koha::CsvProfiles; Link Here
34
use Koha::Exporter::Record;
34
use Koha::Exporter::Record;
35
use Koha::DateUtils qw( dt_from_string output_pref );
35
use Koha::DateUtils qw( dt_from_string output_pref );
36
use Koha::Reports;
36
use Koha::Reports;
37
use Carp;
37
38
38
my (
39
my (
39
    $output_format,
40
    $output_format,
Lines 160-177 if ($report_id) { Link Here
160
$start_accession = dt_from_string($start_accession) if $start_accession;
161
$start_accession = dt_from_string($start_accession) if $start_accession;
161
$end_accession   = dt_from_string($end_accession)   if $end_accession;
162
$end_accession   = dt_from_string($end_accession)   if $end_accession;
162
163
163
# Parse marc conditions
164
sub _parse_marc_conditions {
164
my @marc_conditions;
165
    my ($marc_conditions) = @_;
165
if ($marc_conditions) {
166
    my @marc_conditions;
166
    foreach my $condition ( split( /,\s*/, $marc_conditions ) ) {
167
    foreach my $condition ( split( /,\s*/, $marc_conditions ) ) {
167
        if ( $condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/ ) {
168
        if ( $condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/ ) {
168
            push @marc_conditions, [ $1, $2, $3, $4 ];
169
            push @marc_conditions, [ $1, $2, $3, $4 ];
169
        } elsif ( $condition =~ /^(exists|not_exists)\((\d{3})([\w\d]?)\)$/ ) {
170
        } elsif ( $condition =~ /^(exists|not_exists)\((\d{3})([\w\d]?)\)$/ ) {
170
            push @marc_conditions, [ $2, $3, $1 eq 'exists' ? '?' : '!?' ];
171
            push @marc_conditions, [ $2, $3, $1 eq 'exists' ? '?' : '!?' ];
171
        } else {
172
        } else {
172
            die("Invalid condititon: $condition");
173
            croak "Invalid condititon: $condition";
173
        }
174
        }
174
    }
175
    }
176
    return @marc_conditions;
177
}
178
179
# Parse marc conditions
180
my @marc_conditions;
181
if ($marc_conditions) {
182
    @marc_conditions = _parse_marc_conditions($marc_conditions);
175
}
183
}
176
184
177
my $dbh = C4::Context->dbh;
185
my $dbh = C4::Context->dbh;
178
- 

Return to bug 20551