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

(-)a/Koha/Exporter/Record.pm (-50 / +67 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;
9
use C4::Biblio;
Lines 16-26 use List::Util qw(all any); Link Here
16
use MARC::Record;
17
use MARC::Record;
17
use MARC::File::XML;
18
use MARC::File::XML;
18
19
20
my %marc_conditions_operators = (
21
    '=' => sub {
22
        return $_[0] eq $_[1];
23
    },
24
    '!=' => sub {
25
        return $_[0] ne $_[1];
26
    },
27
    '>' => sub {
28
        return $_[0] gt $_[1];
29
    },
30
    '<' => sub {
31
        return $_[0] lt $_[1];
32
    },
33
);
34
35
# If multiple conditions all are required to match (and)
36
# For matching against multiple marc targets all are also required to match
37
sub _record_match_conditions {
38
    my ($record, $conditions) = @_;
39
40
    foreach my $condition (@{$conditions}) {
41
        my ($field_tag, $subfield, $operator, $match_value) = @{$condition};
42
        my @fields = $record->field($field_tag);
43
        my $no_target = 0;
44
45
        if (!@fields) {
46
            $no_target = 1;
47
        }
48
        else {
49
            if ($operator eq '?') {
50
                return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
51
            } elsif ($operator eq '!?') {
52
                return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
53
            } else {
54
                my $op;
55
                if (exists $marc_conditions_operators{$operator}) {
56
                    $op = $marc_conditions_operators{$operator};
57
                } else {
58
                    croak "Invalid operator: $op";
59
                }
60
                my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields;
61
                if (!@target_values) {
62
                    $no_target = 1;
63
                }
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
19
sub _get_record_for_export {
74
sub _get_record_for_export {
20
    my ($params)           = @_;
75
    my ($params)           = @_;
21
    my $record_type        = $params->{record_type};
76
    my $record_type        = $params->{record_type};
22
    my $record_id          = $params->{record_id};
77
    my $record_id          = $params->{record_id};
23
    my $conditions         = $params->{record_conditions};
78
    my $conditions         = $params->{record_conditions};
79
    my $deleted_conditions = $params->{deleted_record_conditions};
24
    my $dont_export_fields = $params->{dont_export_fields};
80
    my $dont_export_fields = $params->{dont_export_fields};
25
    my $clean              = $params->{clean};
81
    my $clean              = $params->{clean};
26
82
Lines 37-90 sub _get_record_for_export { Link Here
37
        return;
93
        return;
38
    }
94
    }
39
95
40
    # If multiple conditions all are required to match (and)
96
    return if $conditions && !_record_match_conditions($record, $conditions);
41
    # For matching against multiple marc targets all are also required to match
97
42
    my %operators = (
98
    if ($deleted_conditions && _record_match_conditions($record, $deleted_conditions)) {
43
        '=' => sub {
99
        _record_set_deleted($record)
44
            return $_[0] eq $_[1];
45
        },
46
        '!=' => sub {
47
            return $_[0] ne $_[1];
48
        },
49
        '>' => sub {
50
            return $_[0] gt $_[1];
51
        },
52
        '<' => sub {
53
            return $_[0] lt $_[1];
54
        },
55
    );
56
    if ($conditions) {
57
        foreach my $condition (@{$conditions}) {
58
            my ($field_tag, $subfield, $operator, $match_value) = @{$condition};
59
            my @fields = $record->field($field_tag);
60
            my $no_target = 0;
61
62
            if (!@fields) {
63
                $no_target = 1;
64
            }
65
            else {
66
                if ($operator eq '?') {
67
                    return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
68
                } elsif ($operator eq '!?') {
69
                    return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
70
                } else {
71
                    my $op;
72
                    if (exists $operators{$operator}) {
73
                        $op = $operators{$operator};
74
                    } else {
75
                        die("Invalid operator: $op");
76
                    }
77
                    my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields;
78
                    if (!@target_values) {
79
                        $no_target = 1;
80
                    }
81
                    else {
82
                        return unless all { $op->($_, $match_value) } @target_values;
83
                    }
84
                }
85
            }
86
            return if $no_target && $operator ne '!=';
87
        }
88
    }
100
    }
89
101
90
    if ($dont_export_fields) {
102
    if ($dont_export_fields) {
Lines 137-147 sub _get_deleted_biblio_for_export { Link Here
137
        );
149
        );
138
        return;
150
        return;
139
    }
151
    }
140
    # Set deleted flag (record status, position 05)
152
    _record_set_deleted($record);
153
    return $record;
154
}
155
156
sub _record_set_deleted {
157
    my ($record) = @_;
141
    my $leader = $record->leader;
158
    my $leader = $record->leader;
159
    # Set deleted flag (record status, position 05)
142
    substr $leader, 5, 1, 'd';
160
    substr $leader, 5, 1, 'd';
143
    $record->leader($leader);
161
    $record->leader($leader);
144
    return $record;
145
}
162
}
146
163
147
sub _get_authority_for_export {
164
sub _get_authority_for_export {
(-)a/misc/export_records.pl (-4 / +26 lines)
Lines 21-26 use MARC::File::XML; Link Here
21
use List::MoreUtils qw(uniq);
21
use List::MoreUtils qw(uniq);
22
use Getopt::Long;
22
use Getopt::Long;
23
use Pod::Usage;
23
use Pod::Usage;
24
use Carp;
24
25
25
use Koha::Script;
26
use Koha::Script;
26
use C4::Auth;
27
use C4::Auth;
Lines 56-61 my ( Link Here
56
    $start_accession,
57
    $start_accession,
57
    $end_accession,
58
    $end_accession,
58
    $marc_conditions,
59
    $marc_conditions,
60
    $deleted_marc_conditions,
59
    $help
61
    $help
60
);
62
);
61
63
Lines 82-87 GetOptions( Link Here
82
    'start_accession=s'       => \$start_accession,
84
    'start_accession=s'       => \$start_accession,
83
    'end_accession=s'         => \$end_accession,
85
    'end_accession=s'         => \$end_accession,
84
    'marc_conditions=s'       => \$marc_conditions,
86
    'marc_conditions=s'       => \$marc_conditions,
87
    'deleted_marc_conditions=s' => \$deleted_marc_conditions,
85
    'h|help|?'                => \$help
88
    'h|help|?'                => \$help
86
) || pod2usage(1);
89
) || pod2usage(1);
87
90
Lines 131-139 if ( $deleted_barcodes and $record_type ne 'bibs' ) { Link Here
131
$start_accession = dt_from_string( $start_accession ) if $start_accession;
134
$start_accession = dt_from_string( $start_accession ) if $start_accession;
132
$end_accession   = dt_from_string( $end_accession )   if $end_accession;
135
$end_accession   = dt_from_string( $end_accession )   if $end_accession;
133
136
134
# Parse marc conditions
137
135
my @marc_conditions;
138
sub _parse_marc_conditions {
136
if ($marc_conditions) {
139
    my ($marc_conditions) = @_;
140
    my @marc_conditions;
137
    foreach my $condition (split(/,\s*/, $marc_conditions)) {
141
    foreach my $condition (split(/,\s*/, $marc_conditions)) {
138
        if ($condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/) {
142
        if ($condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/) {
139
            push @marc_conditions, [$1, $2, $3, $4];
143
            push @marc_conditions, [$1, $2, $3, $4];
Lines 142-150 if ($marc_conditions) { Link Here
142
            push @marc_conditions, [$2, $3, $1 eq 'exists' ? '?' : '!?'];
146
            push @marc_conditions, [$2, $3, $1 eq 'exists' ? '?' : '!?'];
143
        }
147
        }
144
        else {
148
        else {
145
            die("Invalid condititon: $condition");
149
            croak "Invalid condititon: $condition";
146
        }
150
        }
147
    }
151
    }
152
    return @marc_conditions;
153
}
154
155
# Parse marc conditions
156
my @marc_conditions;
157
if ($marc_conditions) {
158
    @marc_conditions = _parse_marc_conditions($marc_conditions);
159
}
160
161
my @deleted_marc_conditions;
162
if ($deleted_marc_conditions) {
163
    @deleted_marc_conditions = _parse_marc_conditions($deleted_marc_conditions);
148
}
164
}
149
165
150
my $dbh = C4::Context->dbh;
166
my $dbh = C4::Context->dbh;
Lines 280-285 else { Link Here
280
        {   record_type        => $record_type,
296
        {   record_type        => $record_type,
281
            record_ids         => \@record_ids,
297
            record_ids         => \@record_ids,
282
            record_conditions  => @marc_conditions ? \@marc_conditions : undef,
298
            record_conditions  => @marc_conditions ? \@marc_conditions : undef,
299
            deleted_record_conditions  => @deleted_marc_conditions ? \@deleted_marc_conditions : undef,
283
            deleted_record_ids => \@deleted_record_ids,
300
            deleted_record_ids => \@deleted_record_ids,
284
            format             => $output_format,
301
            format             => $output_format,
285
            csv_profile_id     => $csv_profile_id,
302
            csv_profile_id     => $csv_profile_id,
Lines 423-428 Print a brief help message. Link Here
423
                                <marc_target> exists regardless of target value, and
440
                                <marc_target> exists regardless of target value, and
424
                                "exists(<marc_target>)" will include marc records where
441
                                "exists(<marc_target>)" will include marc records where
425
                                no <marc_target> exists.
442
                                no <marc_target> exists.
443
=item B<--deleted_marc_conditions>
444
445
 --deleted_marc_conditions=CONDITIONS Set record deleted flag for biblios with MARC
446
                                data matching CONDITIONS.Only include biblios with MARC data matching CONDITIONS.
447
                                See --marc_conditions for more information about the CONDITIONS format.
426
448
427
=back
449
=back
428
450
(-)a/t/db_dependent/Exporter/Record.t (-2 / +30 lines)
Lines 301-307 subtest '_get_biblio_for_export' => sub { Link Here
301
};
301
};
302
302
303
subtest '_get_record_for_export MARC field conditions' => sub {
303
subtest '_get_record_for_export MARC field conditions' => sub {
304
    plan tests => 11;
304
    plan tests => 13;
305
305
306
    my $biblio = MARC::Record->new();
306
    my $biblio = MARC::Record->new();
307
    $biblio->leader('00266nam a22001097a 4500');
307
    $biblio->leader('00266nam a22001097a 4500');
Lines 423-428 subtest '_get_record_for_export MARC field conditions' => sub { Link Here
423
        }
423
        }
424
    );
424
    );
425
    is( $record, undef, "Record condition \"not_exists(035a)\" should not match" );
425
    is( $record, undef, "Record condition \"not_exists(035a)\" should not match" );
426
427
428
    ## Deleted conditions
429
430
    $record = Koha::Exporter::Record::_get_record_for_export(
431
        {
432
            record_id => $biblionumber,
433
            deleted_record_conditions => [['080', 'a', '=', '12345']],
434
            record_type => 'bibs',
435
        }
436
    );
437
    is(
438
        substr($record->leader, 5, 1),
439
        'd',
440
        "Record deleted condition \"080a=12345\" should match and deleted flag should be set"
441
    );
442
443
    $record = Koha::Exporter::Record::_get_record_for_export(
444
        {
445
            record_id => $biblionumber,
446
            deleted_record_conditions => [['080', 'a', '!=', '12345']],
447
            record_type => 'bibs',
448
        }
449
    );
450
    is(
451
        substr($record->leader, 5, 1),
452
        'n',
453
        "Record deleted condition \"080a!=12345\" should not match and deleted flag should not be set"
454
    );
426
};
455
};
427
456
428
$schema->storage->txn_rollback;
457
$schema->storage->txn_rollback;
429
- 

Return to bug 23009