--- trunk/lib/WebPAC/Input.pm	2006/10/25 17:10:08	761
+++ trunk/lib/WebPAC/Input.pm	2006/12/06 23:43:45	784
@@ -7,7 +7,7 @@
 
 use WebPAC::Common;
 use base qw/WebPAC::Common/;
-use Data::Dumper;
+use Data::Dump qw/dump/;
 use Encode qw/from_to/;
 
 =head1 NAME
@@ -16,11 +16,11 @@
 
 =head1 VERSION
 
-Version 0.14
+Version 0.16
 
 =cut
 
-our $VERSION = '0.14';
+our $VERSION = '0.16';
 
 =head1 SYNOPSIS
 
@@ -102,11 +102,6 @@
 
 	require $module_path;
 
-	# check if required subclasses are implemented
-	foreach my $subclass (qw/open_db fetch_rec init dump_rec/) {
-		# FIXME
-	}
-
 	$self->{'encoding'} ||= 'ISO-8859-2';
 
 	$self ? return $self : return undef;
@@ -229,10 +224,10 @@
 		$log->debug("using modify_file $p");
 		$rec_regex = $self->modify_file_regexps( $p );
 	} elsif (my $h = $arg->{modify_records}) {
-		$log->debug("using modify_records ", Dumper( $h ));
+		$log->debug("using modify_records ", sub { dump( $h ) });
 		$rec_regex = $self->modify_record_regexps(%{ $h });
 	}
-	$log->debug("rec_regex: ", Dumper($rec_regex)) if ($rec_regex);
+	$log->debug("rec_regex: ", sub { dump($rec_regex) }) if ($rec_regex);
 
 	my $class = $self->{module} || $log->logconfess("can't get low-level module name!");
 
@@ -315,7 +310,7 @@
 				return $l;
 		});
 
-		$log->debug(sub { Dumper($rec) });
+		$log->debug(sub { dump($rec) });
 
 		if (! $rec) {
 			$log->warn("record $pos empty? skipping...");
@@ -535,22 +530,27 @@
 		} sort { $a cmp $b } keys %{ $s->{fld} }
 	);
 
-	$log->debug( sub { Dumper($s) } );
+	$log->debug( sub { dump($s) } );
 
 	return $out;
 }
 
-=head2 dump
+=head2 dump_ascii
 
 Display humanly readable dump of record
 
 =cut
 
-sub dump {
+sub dump_ascii {
 	my $self = shift;
 
-	return $self->{ll_db}->dump_rec( $self->{pos} );
+	return unless $self->{ll_db};
 
+	if ($self->{ll_db}->can('dump_rec')) {
+		return $self->{ll_db}->dump_ascii( $self->{pos} );
+	} else {
+		return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );
+	}
 }
 
 =head2 modify_record_regexps
@@ -566,12 +566,17 @@
 
 sub _get_regex {
 	my ($sf,$from,$to) = @_;
+	if ($from =~ m/^regex:(.+)$/) {
+		$from = $1;
+	} else {
+		$from = '\Q' . $from . '\E';
+	}
 	if ($sf =~ /^\^/) {
 		return
-			's/\Q'. $sf .'\E([^\^]*?)\Q'. $from .'\E([^\^]*?)/'. $sf .'$1'. $to .'$2/';
+			's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';
 	} else {
 		return
-			's/\Q'. $from .'\E/'. $to .'/g';
+			's/'. $from .'/'. $to .'/g';
 	}
 }