r1123@llin: dpavlin | 2006-11-03 21:38:14 +0100

 implement fallback dump if low-level API isn't exposing dump_rec [0.15]

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@771 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index 8955cf5..65b3089 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -7,7 +7,7 @@ use blib;
 
 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 @@ WebPAC::Input - read different file formats into WebPAC
 
 =head1 VERSION
 
-Version 0.14
+Version 0.15
 
 =cut
 
-our $VERSION = '0.14';
+our $VERSION = '0.15';
 
 =head1 SYNOPSIS
 
@@ -102,11 +102,6 @@ sub new {
 
        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 @@ sub open {
                $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 @@ sub open {
                                return $l;
                });
 
-               $log->debug(sub { Dumper($rec) });
+               $log->debug(sub { dump($rec) });
 
                if (! $rec) {
                        $log->warn("record $pos empty? skipping...");
@@ -535,7 +530,7 @@ sub stats {
                } sort { $a cmp $b } keys %{ $s->{fld} }
        );
 
-       $log->debug( sub { Dumper($s) } );
+       $log->debug( sub { dump($s) } );
 
        return $out;
 }
@@ -549,8 +544,13 @@ Display humanly readable dump of record
 sub dump {
        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_rec( $self->{pos} );
+       } else {
+               return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );
+       }
 }
 
 =head2 modify_record_regexps

diff --git a/t/2-input.t b/t/2-input.t
index a228448..90e7fa6 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 89;
+use Test::More tests => 104;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -77,6 +77,8 @@ sub test_fetch($$) {
                ok(my $rec = $input->fetch, "fetch $mfn");
                cmp_ok($input->pos, '==', $mfn, "pos $mfn");
                push @db, $rec;
+               ok(my $dump = $input->dump, "dump $mfn");
+               diag $dump if ($debug);
        }
 
        return @db;