From e4f6652b97b2f9733f17e02963cd6dddc1d5c30b Mon Sep 17 00:00:00 2001 From: David Gustafsson Date: Wed, 29 May 2019 16:12:55 +0200 Subject: [PATCH] Bug 23009: Add -deleted_marc_conditions to export_records Add -deleted_marc_conditions argument to export_records script for setting deleted flag on records if condition matches. --- Koha/Exporter/Record.pm | 117 ++++++++++++++++++++++----------------- misc/export_records.pl | 30 ++++++++-- t/db_dependent/Exporter/Record.t | 31 ++++++++++- 3 files changed, 123 insertions(+), 55 deletions(-) diff --git a/Koha/Exporter/Record.pm b/Koha/Exporter/Record.pm index 10ddd8ce68..59f75c995c 100644 --- a/Koha/Exporter/Record.pm +++ b/Koha/Exporter/Record.pm @@ -3,6 +3,7 @@ package Koha::Exporter::Record; use Modern::Perl; use MARC::File::XML; use MARC::File::USMARC; +use Carp; use C4::AuthoritiesMarc; use C4::Biblio; @@ -16,11 +17,66 @@ use List::Util qw(all any); use MARC::Record; use MARC::File::XML; +my %marc_conditions_operators = ( + '=' => sub { + return $_[0] eq $_[1]; + }, + '!=' => sub { + return $_[0] ne $_[1]; + }, + '>' => sub { + return $_[0] gt $_[1]; + }, + '<' => sub { + return $_[0] lt $_[1]; + }, +); + +# If multiple conditions all are required to match (and) +# For matching against multiple marc targets all are also required to match +sub _record_match_conditions { + my ($record, $conditions) = @_; + + foreach my $condition (@{$conditions}) { + my ($field_tag, $subfield, $operator, $match_value) = @{$condition}; + my @fields = $record->field($field_tag); + my $no_target = 0; + + if (!@fields) { + $no_target = 1; + } + else { + if ($operator eq '?') { + return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields; + } elsif ($operator eq '!?') { + return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields; + } else { + my $op; + if (exists $marc_conditions_operators{$operator}) { + $op = $marc_conditions_operators{$operator}; + } else { + croak "Invalid operator: $op"; + } + my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields; + if (!@target_values) { + $no_target = 1; + } + else { + return unless all { $op->($_, $match_value) } @target_values; + } + } + } + return if $no_target && $operator ne '!='; + } + return 1; +} + sub _get_record_for_export { my ($params) = @_; my $record_type = $params->{record_type}; my $record_id = $params->{record_id}; my $conditions = $params->{record_conditions}; + my $deleted_conditions = $params->{deleted_record_conditions}; my $dont_export_fields = $params->{dont_export_fields}; my $clean = $params->{clean}; @@ -37,54 +93,10 @@ sub _get_record_for_export { return; } - # If multiple conditions all are required to match (and) - # For matching against multiple marc targets all are also required to match - my %operators = ( - '=' => sub { - return $_[0] eq $_[1]; - }, - '!=' => sub { - return $_[0] ne $_[1]; - }, - '>' => sub { - return $_[0] gt $_[1]; - }, - '<' => sub { - return $_[0] lt $_[1]; - }, - ); - if ($conditions) { - foreach my $condition (@{$conditions}) { - my ($field_tag, $subfield, $operator, $match_value) = @{$condition}; - my @fields = $record->field($field_tag); - my $no_target = 0; - - if (!@fields) { - $no_target = 1; - } - else { - if ($operator eq '?') { - return unless any { $subfield ? $_->subfield($subfield) : $_->data() } @fields; - } elsif ($operator eq '!?') { - return if any { $subfield ? $_->subfield($subfield) : $_->data() } @fields; - } else { - my $op; - if (exists $operators{$operator}) { - $op = $operators{$operator}; - } else { - die("Invalid operator: $op"); - } - my @target_values = map { $subfield ? $_->subfield($subfield) : ($_->data()) } @fields; - if (!@target_values) { - $no_target = 1; - } - else { - return unless all { $op->($_, $match_value) } @target_values; - } - } - } - return if $no_target && $operator ne '!='; - } + return if $conditions && !_record_match_conditions($record, $conditions); + + if ($deleted_conditions && _record_match_conditions($record, $deleted_conditions)) { + _record_set_deleted($record) } if ($dont_export_fields) { @@ -137,11 +149,16 @@ sub _get_deleted_biblio_for_export { ); return; } - # Set deleted flag (record status, position 05) + _record_set_deleted($record); + return $record; +} + +sub _record_set_deleted { + my ($record) = @_; my $leader = $record->leader; + # Set deleted flag (record status, position 05) substr $leader, 5, 1, 'd'; $record->leader($leader); - return $record; } sub _get_authority_for_export { diff --git a/misc/export_records.pl b/misc/export_records.pl index ca5f08275f..361bb6734c 100755 --- a/misc/export_records.pl +++ b/misc/export_records.pl @@ -21,6 +21,7 @@ use MARC::File::XML; use List::MoreUtils qw(uniq); use Getopt::Long; use Pod::Usage; +use Carp; use Koha::Script; use C4::Auth; @@ -56,6 +57,7 @@ my ( $start_accession, $end_accession, $marc_conditions, + $deleted_marc_conditions, $help ); @@ -82,6 +84,7 @@ GetOptions( 'start_accession=s' => \$start_accession, 'end_accession=s' => \$end_accession, 'marc_conditions=s' => \$marc_conditions, + 'deleted_marc_conditions=s' => \$deleted_marc_conditions, 'h|help|?' => \$help ) || pod2usage(1); @@ -131,9 +134,10 @@ if ( $deleted_barcodes and $record_type ne 'bibs' ) { $start_accession = dt_from_string( $start_accession ) if $start_accession; $end_accession = dt_from_string( $end_accession ) if $end_accession; -# Parse marc conditions -my @marc_conditions; -if ($marc_conditions) { + +sub _parse_marc_conditions { + my ($marc_conditions) = @_; + my @marc_conditions; foreach my $condition (split(/,\s*/, $marc_conditions)) { if ($condition =~ /^(\d{3})([\w\d]?)(=|(?:!=)|>|<)([^,]+)$/) { push @marc_conditions, [$1, $2, $3, $4]; @@ -142,9 +146,21 @@ if ($marc_conditions) { push @marc_conditions, [$2, $3, $1 eq 'exists' ? '?' : '!?']; } else { - die("Invalid condititon: $condition"); + croak "Invalid condititon: $condition"; } } + return @marc_conditions; +} + +# Parse marc conditions +my @marc_conditions; +if ($marc_conditions) { + @marc_conditions = _parse_marc_conditions($marc_conditions); +} + +my @deleted_marc_conditions; +if ($deleted_marc_conditions) { + @deleted_marc_conditions = _parse_marc_conditions($deleted_marc_conditions); } my $dbh = C4::Context->dbh; @@ -280,6 +296,7 @@ else { { record_type => $record_type, record_ids => \@record_ids, record_conditions => @marc_conditions ? \@marc_conditions : undef, + deleted_record_conditions => @deleted_marc_conditions ? \@deleted_marc_conditions : undef, deleted_record_ids => \@deleted_record_ids, format => $output_format, csv_profile_id => $csv_profile_id, @@ -423,6 +440,11 @@ Print a brief help message. exists regardless of target value, and "exists()" will include marc records where no exists. +=item B<--deleted_marc_conditions> + + --deleted_marc_conditions=CONDITIONS Set record deleted flag for biblios with MARC + data matching CONDITIONS.Only include biblios with MARC data matching CONDITIONS. + See --marc_conditions for more information about the CONDITIONS format. =back diff --git a/t/db_dependent/Exporter/Record.t b/t/db_dependent/Exporter/Record.t index a7031c406b..c8ff82f382 100644 --- a/t/db_dependent/Exporter/Record.t +++ b/t/db_dependent/Exporter/Record.t @@ -301,7 +301,7 @@ subtest '_get_biblio_for_export' => sub { }; subtest '_get_record_for_export MARC field conditions' => sub { - plan tests => 11; + plan tests => 13; my $biblio = MARC::Record->new(); $biblio->leader('00266nam a22001097a 4500'); @@ -423,6 +423,35 @@ subtest '_get_record_for_export MARC field conditions' => sub { } ); is( $record, undef, "Record condition \"not_exists(035a)\" should not match" ); + + + ## Deleted conditions + + $record = Koha::Exporter::Record::_get_record_for_export( + { + record_id => $biblionumber, + deleted_record_conditions => [['080', 'a', '=', '12345']], + record_type => 'bibs', + } + ); + is( + substr($record->leader, 5, 1), + 'd', + "Record deleted condition \"080a=12345\" should match and deleted flag should be set" + ); + + $record = Koha::Exporter::Record::_get_record_for_export( + { + record_id => $biblionumber, + deleted_record_conditions => [['080', 'a', '!=', '12345']], + record_type => 'bibs', + } + ); + is( + substr($record->leader, 5, 1), + 'n', + "Record deleted condition \"080a!=12345\" should not match and deleted flag should not be set" + ); }; $schema->storage->txn_rollback; -- 2.11.0