+=head2 stats
+
+Dump statistics about field and subfield usage
+
+ print $input->stats;
+
+=cut
+
+sub stats {
+ my $self = shift;
+
+ my $log = $self->_get_logger();
+
+ my $s = $self->{_stats};
+ if (! $s) {
+ $log->warn("called stats, but there is no statistics collected");
+ return;
+ }
+
+ my $max_fld = 0;
+
+ my $out = join("\n",
+ map {
+ my $f = $_;
+ die "no field in ", dump( $s->{fld} ) unless defined( $f );
+ my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
+ $max_fld = $v if ($v > $max_fld);
+
+ my $o = sprintf("%4s %d ~", $f, $v);
+
+ if (defined($s->{sf}->{$f})) {
+ my @subfields = keys %{ $s->{sf}->{$f} };
+ map {
+ $o .= sprintf(" %s:%d%s", $_,
+ $s->{sf}->{$f}->{$_}->{count},
+ $s->{sf}->{$f}->{$_}->{repeatable} ? '*' : '',
+ );
+ } (
+ # first indicators and other special subfields
+ sort( grep { length($_) > 1 } @subfields ),
+ # then subfileds (single char)
+ sort( grep { length($_) == 1 } @subfields ),
+ );
+ }
+
+ if (my $v_r = $s->{repeatable}->{$f}) {
+ $o .= " ($v_r)" if ($v_r != $v);
+ }
+
+ $o;
+ } sort {
+ if ( $a =~ m/^\d+$/ && $b =~ m/^\d+$/ ) {
+ $a <=> $b
+ } else {
+ $a cmp $b
+ }
+ } keys %{ $s->{fld} }
+ );
+
+ $log->debug( sub { dump($s) } );
+
+ my $path = 'var/stats.yml';
+ YAML::DumpFile( $path, $s );
+ $log->info( 'created ', $path, ' with ', -s $path, ' bytes' );
+
+ return $out;
+}
+
+=head2 dump_ascii
+
+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';
+ }
+}
+