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

(-)a/Koha/Exporter/Record.pm (-48 / +55 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
        } else {
50
            if ( $operator eq '?' ) {
51
                return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
52
            } elsif ( $operator eq '!?' ) {
53
                return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
54
            } else {
55
                my $op;
56
                if ( exists $marc_conditions_operators{$operator} ) {
57
                    $op = $marc_conditions_operators{$operator};
58
                } else {
59
                    croak "Invalid operator: $op";
60
                }
61
                my @target_values = map { $subfield ? $_->subfield($subfield) : ( $_->data() ) } @fields;
62
                if ( !@target_values ) {
63
                    $no_target = 1;
64
                } else {
65
                    return unless all { $op->( $_, $match_value ) } @target_values;
66
                }
67
            }
68
        }
69
        return if $no_target && $operator ne '!=';
70
    }
71
    return 1;
72
}
73
21
sub _get_record_for_export {
74
sub _get_record_for_export {
22
    my ($params)           = @_;
75
    my ($params)           = @_;
23
    my $record_type        = $params->{record_type};
76
    my $record_type        = $params->{record_type};
Lines 41-94 sub _get_record_for_export { Link Here
41
        return;
94
        return;
42
    }
95
    }
43
96
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) {
97
    if ($dont_export_fields) {
93
        for my $f ( split / /, $dont_export_fields ) {
98
        for my $f ( split / /, $dont_export_fields ) {
94
            if ( $f =~ m/^(\d{3})(.)?$/ ) {
99
            if ( $f =~ m/^(\d{3})(.)?$/ ) {
Lines 108-113 sub _get_record_for_export { Link Here
108
            }
113
            }
109
        }
114
        }
110
    }
115
    }
116
117
    return                            if $conditions && !_record_match_conditions( $record, $conditions );
111
    C4::Biblio::RemoveAllNsb($record) if $clean;
118
    C4::Biblio::RemoveAllNsb($record) if $clean;
112
    return $record;
119
    return $record;
113
}
120
}
(-)a/misc/export_records.pl (-5 / +12 lines)
Lines 36-41 use Koha::Exporter::Record; Link Here
36
use Koha::DateUtils qw( dt_from_string output_pref );
36
use Koha::DateUtils qw( dt_from_string output_pref );
37
use Koha::Reports;
37
use Koha::Reports;
38
use Koha::File::Transports;
38
use Koha::File::Transports;
39
use Carp;
39
40
40
my (
41
my (
41
    $output_format,
42
    $output_format,
Lines 179-196 if ($report_id) { Link Here
179
$start_accession = dt_from_string($start_accession) if $start_accession;
180
$start_accession = dt_from_string($start_accession) if $start_accession;
180
$end_accession   = dt_from_string($end_accession)   if $end_accession;
181
$end_accession   = dt_from_string($end_accession)   if $end_accession;
181
182
182
# Parse marc conditions
183
sub _parse_marc_conditions {
183
my @marc_conditions;
184
    my ($marc_conditions) = @_;
184
if ($marc_conditions) {
185
    my @marc_conditions;
185
    foreach my $condition ( split( /,\s*/, $marc_conditions ) ) {
186
    foreach my $condition ( split( /,\s*/, $marc_conditions ) ) {
186
        if ( $condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/ ) {
187
        if ( $condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/ ) {
187
            push @marc_conditions, [ $1, $2, $3, $4 ];
188
            push @marc_conditions, [ $1, $2, $3, $4 ];
188
        } elsif ( $condition =~ /^(exists|not_exists)\((\d{3})([\w\d]?)\)$/ ) {
189
        } elsif ( $condition =~ /^(exists|not_exists)\((\d{3})([\w\d]?)\)$/ ) {
189
            push @marc_conditions, [ $2, $3, $1 eq 'exists' ? '?' : '!?' ];
190
            push @marc_conditions, [ $2, $3, $1 eq 'exists' ? '?' : '!?' ];
190
        } else {
191
        } else {
191
            die("Invalid condititon: $condition");
192
            croak "Invalid condititon: $condition";
192
        }
193
        }
193
    }
194
    }
195
    return @marc_conditions;
196
}
197
198
# Parse marc conditions
199
my @marc_conditions;
200
if ($marc_conditions) {
201
    @marc_conditions = _parse_marc_conditions($marc_conditions);
194
}
202
}
195
203
196
my $dbh = C4::Context->dbh;
204
my $dbh = C4::Context->dbh;
197
- 

Return to bug 20551