This is an automated email from the git hooks/post-receive script. js pushed a commit to annotated tag upstream/1.19 in repository libcatmandu-marc-perl.
commit c1328bbb341fc25bc84f614d8ea523337d9a026a Author: Patrick Hochstenbach <[email protected]> Date: Wed Jul 13 11:22:33 2016 +0200 Deleting the 'record' option for all fixes --- lib/Catmandu/Fix/marc_decode_dollar_subfields.pm | 5 +- lib/Catmandu/Fix/marc_in_json.pm | 13 +---- lib/Catmandu/Fix/marc_map.pm | 26 ++++------ lib/Catmandu/Fix/marc_remove.pm | 12 +---- lib/Catmandu/Fix/marc_set.pm | 10 +--- lib/Catmandu/MARC.pm | 66 +++++++++++------------- 6 files changed, 44 insertions(+), 88 deletions(-) diff --git a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm index 290fca1..d85e3ff 100644 --- a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm +++ b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm @@ -9,12 +9,9 @@ with 'Catmandu::Fix::Inlineable'; our $VERSION = '0.219'; -has record => (fix_opt => 1); - sub fix { my ($self,$data) = @_; - my $record_key = $self->record // 'record'; - return Catmandu::MARC->instance->marc_decode_dollar_subfields($data, record => $record_key); + return Catmandu::MARC->instance->marc_decode_dollar_subfields($data); } =head1 NAME diff --git a/lib/Catmandu/Fix/marc_in_json.pm b/lib/Catmandu/Fix/marc_in_json.pm index 2b8701a..239b7e0 100644 --- a/lib/Catmandu/Fix/marc_in_json.pm +++ b/lib/Catmandu/Fix/marc_in_json.pm @@ -9,7 +9,6 @@ with 'Catmandu::Fix::Inlineable'; our $VERSION = '0.219'; -has record => (fix_opt => 1); has reverse => (fix_opt => 1); # Transform a raw MARC array into MARC-in-JSON @@ -17,13 +16,12 @@ has reverse => (fix_opt => 1); # http://dilettantes.code4lib.org/blog/2010/09/a-proposal-to-serialize-marc-in-json/ sub fix { my ($self, $data) = @_; - my $record_key = $self->record // 'record'; if ($self->reverse) { - return Catmandu::MARC->instance->marc_json_to_record($data, record => $record_key); + return Catmandu::MARC->instance->marc_json_to_record($data); } else { - return Catmandu::MARC->instance->marc_record_to_json($data, record => $record_key); + return Catmandu::MARC->instance->marc_record_to_json($data); } } @@ -36,9 +34,6 @@ Catmandu::Fix::marc_in_json - transform a Catmandu MARC record into MARC-in-JSON # Transform a Catmandu MARC 'record' into a MARC-in-JSON record marc_in_json() - # Optionally provide a pointer to the marc record - marc_in_json(record:record) - # Reverse, transform a MARC-in-JSON record into a Catmandu MARC record marc_in_json(reverse:1) @@ -58,10 +53,6 @@ Convert a Catmandu MARC record into the MARC-in-JSON format. Convert a MARC-in-JSON record back into the Catmandu MARC format. -=head2 record: STR - -Specify the JSON_PATH where the MARC record can be found (default: record). - =head1 INLINE This Fix can be used inline in a Perl script: diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm index 295f96c..d425362 100644 --- a/lib/Catmandu/Fix/marc_map.pm +++ b/lib/Catmandu/Fix/marc_map.pm @@ -11,7 +11,6 @@ our $VERSION = '0.219'; has marc_path => (fix_arg => 1); has path => (fix_arg => 1); -has record => (fix_opt => 1); has split => (fix_opt => 1); has join => (fix_opt => 1); has value => (fix_opt => 1); @@ -20,20 +19,22 @@ has nested_arrays => (fix_opt => 1); sub emit { my ($self,$fixer) = @_; - my $path = $fixer->split_path($self->path); - - my $marc = $fixer->capture(Catmandu::MARC->instance); - my $marc_path = $fixer->emit_string($self->marc_path); - my $marc_opt = $fixer->capture({ - '-record' => $self->record // 'record' , + my $path = $fixer->split_path($self->path); + my $marc_obj = Catmandu::MARC->instance; + + # Precompile the marc_path to gain some speed + my $marc_context = $marc_obj->compile_marc_path($self->marc_path,subfield_wildcard => 1); + my $marc = $fixer->capture($marc_obj); + my $marc_path = $fixer->capture($marc_context); + my $marc_opt = $fixer->capture({ '-join' => $self->join // '' , '-split' => $self->split // 0 , '-pluck' => $self->pluck // 0 , '-nested_arrays' => $self->nested_arrays // 0 , '-value' => $self->value }); - my $var = $fixer->var; - my $result = $fixer->generate_var; + my $var = $fixer->var; + my $result = $fixer->generate_var; my $perl =<<EOF; if (my ${result} = ${marc}->marc_map( @@ -97,9 +98,6 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field # When 260c field exists create the my.has260c hash with value 'found' marc_map('260c','my.has260c', value:found) - # Do the same examples now with the marc fields in 'record2' - marc_map('245','my.title', record:record2) - # Copy all 100 subfields except the digits to the 'author' field marc_map('100^0123456789','author') @@ -204,10 +202,6 @@ array of strings (one string for each subfield found). Using the nested_array option the output will be an array of array of strings (one array item for each matched field, one array of strings for each matched subfield). -=head2 record: STR - -Specify the JSON_PATH where the MARC record can be found (default: record). - =head1 INLINE This Fix can be used inline in a Perl script: diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm index 633ef43..2411be7 100644 --- a/lib/Catmandu/Fix/marc_remove.pm +++ b/lib/Catmandu/Fix/marc_remove.pm @@ -10,13 +10,11 @@ with 'Catmandu::Fix::Inlineable'; our $VERSION = '0.219'; has marc_path => (fix_arg => 1); -has record => (fix_opt => 1); sub fix { my ($self,$data) = @_; my $marc_path = $self->marc_path; - my $record_key = $self->record // 'record'; - return Catmandu::MARC->instance->marc_remove($data, $marc_path, record => $record_key); + return Catmandu::MARC->instance->marc_remove($data, $marc_path); } =head1 NAME @@ -31,8 +29,6 @@ Catmandu::Fix::marc_remove - remove marc (sub)fields # remove the 245-a subfield marc_remove('245a') - # the same with the marc fields in 'record2' - marc_remove('600', record:record2) =head1 DESCRIPTION @@ -44,12 +40,6 @@ Remove (sub)fields in a MARC record Delete the (sub)fields from the MARC record as indicated by the MARC_PATH. -=head1 OPTIONS - -=head2 record: STR - -Specify the JSON_PATH where the MARC record can be found (default: record). - =head1 INLINE This Fix can be used inline in a Perl script: diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm index 7eb30cc..be0ccd5 100644 --- a/lib/Catmandu/Fix/marc_set.pm +++ b/lib/Catmandu/Fix/marc_set.pm @@ -11,14 +11,12 @@ our $VERSION = '0.219'; has marc_path => (fix_arg => 1); has value => (fix_arg => 1); -has record => (fix_opt => 1); sub fix { my ($self,$data) = @_; my $marc_path = $self->marc_path; my $value = $self->value; - my $record_key = $self->record; - return Catmandu::MARC->instance->marc_set($data,$marc_path,$value, record => $record_key); + return Catmandu::MARC->instance->marc_set($data,$marc_path,$value); } =head1 NAME @@ -52,12 +50,6 @@ Set the value of a MARC subfield to a new value. Set a MARC subfield to a particular new value. This valeu can be a literal or reference an existing field in the record using the dollar JSON_PATH syntax. -=head1 OPTIONS - -=head2 record: STR - -Specify the JSON_PATH where the MARC record can be found (default: record). - =head1 INLINE This Fix can be used inline in a Perl script: diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm index ab2af8a..d74ae2d 100644 --- a/lib/Catmandu/MARC.pm +++ b/lib/Catmandu/MARC.pm @@ -8,7 +8,7 @@ use Carp; use Moo; with 'MooX::Singleton'; -memoize('_compile_marc_path'); +memoize('compile_marc_path'); our $VERSION = '0.219'; @@ -18,29 +18,30 @@ sub marc_map { my $marc_path = $_[2]; my $opts = $_[3]; - my $record_key = $opts->{'-record'} // 'record'; + my $context = ref($marc_path) ? + $marc_path : + $self->compile_marc_path($marc_path, subfield_wildcard => 1); - return wantarray ? () : undef - unless (defined $data->{$record_key} && ref $data->{$record_key} eq 'ARRAY'); + confess "invalid marc path" unless $context; + + my $record = $data->{'record'}; + + return wantarray ? () : undef unless (defined $record && ref($record) eq 'ARRAY'); my $split = $opts->{'-split'} // 0; - my $join_char = $opts->{'-join'} // ''; + my $join_char = $opts->{'-join'} // ''; my $pluck = $opts->{'-pluck'} // 0; my $value_set = $opts->{'-value'}; my $nested_arrays = $opts->{'-nested_arrays'} // 0; - my $context = _compile_marc_path($marc_path, subfield_wildcard => 1); - - confess "invalid marc path" unless $context; - my $vals; - for my $field (@{$data->{$record_key}}) { + for my $field (@$record) { next if ( - ($context->{is_regex_field} == 1 && $field->[0] !~ $context->{field_regex} ) - || ($context->{is_regex_field} == 0 && $field->[0] ne $context->{field} ) || + ($context->{is_regex_field} == 1 && $field->[0] !~ $context->{field_regex} ) + || (defined $context->{ind1} && (!defined $field->[1] || $field->[1] ne $context->{ind1})) || (defined $context->{ind2} && (!defined $field->[2] || $field->[2] ne $context->{ind2})) @@ -135,14 +136,11 @@ sub marc_map { } } - if (!defined $vals) { - return undef; - } - elsif (wantarray) { - return defined($vals) && ref($vals) eq 'ARRAY' ? @$vals : ($vals); + if (wantarray) { + defined($vals) && ref($vals) eq 'ARRAY' ? @$vals : ($vals); } else { - return $vals; + $vals; } } @@ -150,8 +148,7 @@ sub marc_add { my ($self,$data,$marc_path,@subfields) = @_; my %subfields = @subfields; - my $record_key = $subfields{'-record'} // 'record'; - my $marc = $data->{$record_key} // []; + my $marc = $data->{'record'} // []; if ($marc_path =~ /^\w{3}$/) { my @field = (); @@ -191,15 +188,14 @@ sub marc_add { push @{ $marc } , \@field if @field > 3; } - $data->{$record_key} = $marc; + $data->{'record'} = $marc; $data; } sub marc_set { my ($self,$data,$marc_path,$value,%opts) = @_; - my $record_key = $opts{record} // 'record'; - my $record = $data->{$record_key}; + my $record = $data->{'record'}; return $data unless defined $record; @@ -219,7 +215,7 @@ sub marc_set { $value = $last; } - my $context = _compile_marc_path($marc_path, subfield_default => 1); + my $context = $self->compile_marc_path($marc_path, subfield_default => 1); confess "invalid marc path" unless $context; @@ -267,12 +263,11 @@ sub marc_set { sub marc_remove { my ($self,$data, $marc_path,%opts) = @_; - my $record_key = $opts{record} // 'record'; - my $record = $data->{$record_key}; + my $record = $data->{'record'}; my $new_record; - my $context = _compile_marc_path($marc_path); + my $context = $self->compile_marc_path($marc_path); confess "invalid marc path" unless $context; @@ -315,7 +310,7 @@ sub marc_remove { push @$new_record , $field; } - $data->{$record_key} = $new_record; + $data->{'record'} = $new_record; return $data; } @@ -333,9 +328,8 @@ sub marc_xml { sub marc_record_to_json { my ($self,$data,%opts) = @_; - my $record_key = $opts{record} // 'record'; - if (my $marc = delete $data->{$record_key}) { + if (my $marc = delete $data->{'record'}) { for my $field (@$marc) { my ($tag, $ind1, $ind2, @subfields) = @$field; @@ -366,7 +360,6 @@ sub marc_record_to_json { sub marc_json_to_record { my ($self,$data,%opts) = @_; - my $record_key = $opts{record} // 'record'; my $record = []; @@ -407,7 +400,7 @@ sub marc_json_to_record { if (@$record > 0) { delete $data->{fields}; delete $data->{leader}; - $data->{$record_key} = $record; + $data->{'record'} = $record; } $data; @@ -415,8 +408,7 @@ sub marc_json_to_record { sub marc_decode_dollar_subfields { my ($self,$data,%opts) = @_; - my $record_key = $opts{record} // 'record'; - my $old_record = $data->{$record_key}; + my $old_record = $data->{'record'}; my $new_record = []; for my $field (@$old_record) { @@ -444,13 +436,13 @@ sub marc_decode_dollar_subfields { push @$new_record , $fixed_field; } - $data->{$record_key} = $new_record; + $data->{'record'} = $new_record; $data; } -sub _compile_marc_path { - my ($marc_path,%opts) = @_; +sub compile_marc_path { + my ($self,$marc_path,%opts) = @_; my ($field,$field_regex,$ind1,$ind2, $subfield,$subfield_regex,$from,$to,$len,$is_regex_field); -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
