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

(-)a/Koha/Exporter/Record.pm (-50 / +71 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 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 $set_deleted_conditions = $params->{set_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 39-92 sub _get_record_for_export { Link Here
39
        return;
95
        return;
40
    }
96
    }
41
97
42
    # If multiple conditions all are required to match (and)
98
    return if $conditions && !_record_match_conditions($record, $conditions);
43
    # For matching against multiple marc targets all are also required to match
99
44
    my %operators = (
100
    if (
45
        '=' => sub {
101
        $record_type ne 'deleted_bibs' &&
46
            return $_[0] eq $_[1];
102
        $set_deleted_conditions &&
47
        },
103
        _record_match_conditions($record, $set_deleted_conditions)
48
        '!=' => sub {
104
    ) {
49
            return $_[0] ne $_[1];
105
        _record_set_deleted($record)
50
        },
51
        '>' => sub {
52
            return $_[0] gt $_[1];
53
        },
54
        '<' => sub {
55
            return $_[0] lt $_[1];
56
        },
57
    );
58
    if ($conditions) {
59
        foreach my $condition (@{$conditions}) {
60
            my ($field_tag, $subfield, $operator, $match_value) = @{$condition};
61
            my @fields = $record->field($field_tag);
62
            my $no_target = 0;
63
64
            if (!@fields) {
65
                $no_target = 1;
66
            }
67
            else {
68
                if ($operator eq '?') {
69
                    return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
70
                } elsif ($operator eq '!?') {
71
                    return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields;
72
                } else {
73
                    my $op;
74
                    if (exists $operators{$operator}) {
75
                        $op = $operators{$operator};
76
                    } else {
77
                        die("Invalid operator: $op");
78
                    }
79
                    my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields;
80
                    if (!@target_values) {
81
                        $no_target = 1;
82
                    }
83
                    else {
84
                        return unless all { $op->($_, $match_value) } @target_values;
85
                    }
86
                }
87
            }
88
            return if $no_target && $operator ne '!=';
89
        }
90
    }
106
    }
91
107
92
    if ($dont_export_fields) {
108
    if ($dont_export_fields) {
Lines 138-148 sub _get_deleted_biblio_for_export { Link Here
138
        );
154
        );
139
        return;
155
        return;
140
    }
156
    }
141
    # Set deleted flag (record status, position 05)
157
    _record_set_deleted($record);
158
    return $record;
159
}
160
161
sub _record_set_deleted {
162
    my ($record) = @_;
142
    my $leader = $record->leader;
163
    my $leader = $record->leader;
164
    # Set deleted flag (record status, position 05)
143
    substr $leader, 5, 1, 'd';
165
    substr $leader, 5, 1, 'd';
144
    $record->leader($leader);
166
    $record->leader($leader);
145
    return $record;
146
}
167
}
147
168
148
sub _get_authority_for_export {
169
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 qw( GetOptions );
22
use Getopt::Long qw( GetOptions );
23
use Pod::Usage qw( pod2usage );
23
use Pod::Usage qw( pod2usage );
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
    $set_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
    'set_deleted_marc_conditions=s' => \$set_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 @set_deleted_marc_conditions;
162
if ($set_deleted_marc_conditions) {
163
    @set_deleted_marc_conditions = _parse_marc_conditions($set_deleted_marc_conditions);
148
}
164
}
149
165
150
my $dbh = C4::Context->dbh;
166
my $dbh = C4::Context->dbh;
Lines 283-288 else { Link Here
283
        {   record_type        => $record_type,
299
        {   record_type        => $record_type,
284
            record_ids         => \@record_ids,
300
            record_ids         => \@record_ids,
285
            record_conditions  => @marc_conditions ? \@marc_conditions : undef,
301
            record_conditions  => @marc_conditions ? \@marc_conditions : undef,
302
            deleted_record_conditions  => @set_deleted_marc_conditions ? \@set_deleted_marc_conditions : undef,
286
            deleted_record_ids => \@deleted_record_ids,
303
            deleted_record_ids => \@deleted_record_ids,
287
            format             => $output_format,
304
            format             => $output_format,
288
            csv_profile_id     => $csv_profile_id,
305
            csv_profile_id     => $csv_profile_id,
Lines 428-433 Print a brief help message. Link Here
428
                                <marc_target> exists regardless of target value, and
445
                                <marc_target> exists regardless of target value, and
429
                                "exists(<marc_target>)" will include marc records where
446
                                "exists(<marc_target>)" will include marc records where
430
                                no <marc_target> exists.
447
                                no <marc_target> exists.
448
=item B<--set_deleted_marc_conditions>
449
450
 --set_deleted_marc_conditions=CONDITIONS Set record deleted flag for biblios with MARC
451
                                data matching CONDITIONS.Only include biblios with MARC data matching CONDITIONS.
452
                                See --marc_conditions for more information about the CONDITIONS format.
431
453
432
=back
454
=back
433
455
(-)a/t/db_dependent/Exporter/Record.t (-2 / +30 lines)
Lines 289-295 subtest '_get_biblio_for_export' => sub { Link Here
289
};
289
};
290
290
291
subtest '_get_record_for_export MARC field conditions' => sub {
291
subtest '_get_record_for_export MARC field conditions' => sub {
292
    plan tests => 11;
292
    plan tests => 13;
293
293
294
    my $biblio = MARC::Record->new();
294
    my $biblio = MARC::Record->new();
295
    $biblio->leader('00266nam a22001097a 4500');
295
    $biblio->leader('00266nam a22001097a 4500');
Lines 411-416 subtest '_get_record_for_export MARC field conditions' => sub { Link Here
411
        }
411
        }
412
    );
412
    );
413
    is( $record, undef, "Record condition \"not_exists(035a)\" should not match" );
413
    is( $record, undef, "Record condition \"not_exists(035a)\" should not match" );
414
415
416
    ## Deleted conditions
417
418
    $record = Koha::Exporter::Record::_get_record_for_export(
419
        {
420
            record_id => $biblionumber,
421
            set_deleted_record_conditions => [['080', 'a', '=', '12345']],
422
            record_type => 'bibs',
423
        }
424
    );
425
    is(
426
        substr($record->leader, 5, 1),
427
        'd',
428
        "Record deleted condition \"080a=12345\" should match and deleted flag should be set"
429
    );
430
431
    $record = Koha::Exporter::Record::_get_record_for_export(
432
        {
433
            record_id => $biblionumber,
434
            set_deleted_record_conditions => [['080', 'a', '!=', '12345']],
435
            record_type => 'bibs',
436
        }
437
    );
438
    is(
439
        substr($record->leader, 5, 1),
440
        'n',
441
        "Record deleted condition \"080a!=12345\" should not match and deleted flag should not be set"
442
    );
414
};
443
};
415
444
416
$schema->storage->txn_rollback;
445
$schema->storage->txn_rollback;
417
- 

Return to bug 23009