+Display humanly readable dump of record
+
+=cut
+
+sub dump_ascii {
+ my $self = shift;
+
+ return unless $self->{ll_db};
+
+ if ($self->{ll_db}->can('dump_ascii')) {
+ return $self->{ll_db}->dump_ascii( $self->{pos} );
+ } else {
+ return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );
+ }
+}
+
+=head2 _get_regex
+
+Helper function called which create regexps to be execute on code.
+
+ _get_regex( 900, 'regex:[0-9]+' ,'numbers' );
+ _get_regex( 900, '^b', ' : ^b' );
+
+It supports perl regexps with C<regex:> prefix to from value and has
+additional logic to skip empty subfields.
+
+=cut
+
+sub _get_regex {
+ my ($sf,$from,$to) = @_;
+
+ # protect /
+ $from =~ s!/!\\/!gs;
+ $to =~ s!/!\\/!gs;
+
+ if ($from =~ m/^regex:(.+)$/) {
+ $from = $1;
+ } else {
+ $from = '\Q' . $from . '\E';
+ }
+ if ($sf =~ /^\^/) {
+ my $need_subfield_data = '*'; # no
+ # if from is also subfield, require some data in between
+ # to correctly skip empty subfields
+ $need_subfield_data = '+' if ($from =~ m/^\\Q\^/);
+ return
+ 's/\Q'. $sf .'\E([^\^]' . $need_subfield_data . '?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';
+ } else {
+ return
+ 's/'. $from .'/'. $to .'/g';
+ }
+}
+
+
+=head2 modify_record_regexps
+
+Generate hash with regexpes to be applied using L<filter>.
+
+ my $regexpes = $input->modify_record_regexps(
+ 900 => { '^a' => { ' : ' => '^b' } },
+ 901 => { '*' => { '^b' => ' ; ' } },
+ );
+
+=cut
+
+sub modify_record_regexps {
+ my $self = shift;
+ my $modify_record = {@_};
+
+ my $regexpes;
+
+ my $log = $self->_get_logger();
+
+ foreach my $f (keys %$modify_record) {
+ $log->debug("field: $f");
+
+ foreach my $sf (keys %{ $modify_record->{$f} }) {
+ $log->debug("subfield: $sf");
+
+ foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {
+ my $to = $modify_record->{$f}->{$sf}->{$from};
+ #die "no field?" unless defined($to);
+ my $d = "|$from| -> |$to|";
+ $log->debug("transform: $d");
+
+ my $regex = _get_regex($sf,$from,$to);
+ push @{ $regexpes->{$f} }, { regex => $regex, debug => $d };
+ $log->debug("regex: $regex");
+ }
+ }
+ }
+
+ return $regexpes;
+}
+
+=head2 modify_file_regexps
+
+Generate hash with regexpes to be applied using L<filter> from
+pseudo hash/yaml format for regex mappings.
+
+It should be obvious:
+
+ 200
+ '^a'
+ ' : ' => '^e'
+ ' = ' => '^d'
+
+In field I<200> find C<'^a'> and then C<' : '>, and replace it with C<'^e'>.
+In field I<200> find C<'^a'> and then C<' = '>, and replace it with C<'^d'>.
+
+ my $regexpes = $input->modify_file_regexps( 'conf/modify/common.pl' );
+
+On undef path it will just return.
+
+=cut
+
+sub modify_file_regexps {
+ my $self = shift;
+
+ my $modify_path = shift || return;
+
+ my $log = $self->_get_logger();
+
+ my $regexpes;
+
+ CORE::open(my $fh, $modify_path) || $log->logdie("can't open modify file $modify_path: $!");
+
+ my ($f,$sf);
+
+ while(<$fh>) {
+ chomp;
+ next if (/^#/ || /^\s*$/);
+
+ if (/^\s*(\d+)\s*$/) {
+ $f = $1;
+ $log->debug("field: $f");
+ next;
+ } elsif (/^\s*'([^']*)'\s*$/) {
+ $sf = $1;
+ $log->die("can't define subfiled before field in: $_") unless ($f);
+ $log->debug("subfield: $sf");
+ } elsif (/^\s*'([^']*)'\s*=>\s*'([^']*)'\s*$/) {
+ my ($from,$to) = ($1, $2);
+
+ $log->debug("transform: |$from| -> |$to|");
+
+ my $regex = _get_regex($sf,$from,$to);
+ push @{ $regexpes->{$f} }, {
+ regex => $regex,
+ file => $modify_path,
+ line => $.,
+ };
+ $log->debug("regex: $regex");
+ }
+ }
+
+ return $regexpes;
+}