beginning of unit testing and various fixes
authorDobrica Pavlinusic <dpavlin@rot13.org>
Sun, 17 Jul 2005 22:48:25 +0000 (22:48 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Sun, 17 Jul 2005 22:48:25 +0000 (22:48 +0000)
git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@22 07558da8-63fa-0310-ba24-9fe276d99e06

lib/WebPAC/DB.pm
lib/WebPAC/Normalize.pm
t/4-db.t
t/6-unit.t [new file with mode: 0755]

index bb9a41a..0a10dfc 100644 (file)
@@ -102,11 +102,11 @@ sub path {
        }
 }
 
-=head2 load_gs
+=head2 load_ds
 
 Retrive from disk one data_structure records using field 000 as key
 
-  my @ds = $db->load_gs($rec);
+  my @ds = $db->load_ds($rec);
 
 This function will also perform basic sanity checking on returned
 data and disable caching if data is corrupted (or changed since last
@@ -116,7 +116,7 @@ Returns array or undef if cacheing is disabled or unavailable.
 
 =cut
 
-sub load_gs {
+sub load_ds {
        my $self = shift;
 
        return unless $self->{'path'};
@@ -161,11 +161,11 @@ sub load_gs {
        return undef;
 }
 
-=head2 save_gs
+=head2 save_ds
 
 Store data_structure on disk.
 
-  $db->save_gs(
+  $db->save_ds(
        ds => \@ds,
        current_filename => $self->{'current_filename'},
        headline => $self->{'headline'},
@@ -173,11 +173,11 @@ Store data_structure on disk.
 
 B<Totally broken, but fast.>
 
-Depends on filename generated by C<load_gs>.
+Depends on filename generated by C<load_ds>.
 
 =cut
 
-sub save_gs {
+sub save_ds {
        my $self = shift;
 
        return unless($self->{'path'});
@@ -187,7 +187,7 @@ sub save_gs {
 
        my $log = $self->_get_logger;
 
-       $log->logdie("save_gs without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
+       $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
 
        foreach my $e (qw/ds current_filename headline/) {
                $log->logdie("missing $e") unless $arg->{$e};
index 44d2144..fc17a75 100644 (file)
@@ -127,7 +127,7 @@ sub data_structure {
        my $cache_file;
 
        if ($self->{'db'}) {
-               my @ds = $self->{'db'}->get_ds($rec);
+               my @ds = $self->{'db'}->load_ds($rec);
                return @ds if (@ds);
        }
 
@@ -236,7 +236,7 @@ sub data_structure {
 
        }
 
-       $self->{'db'}->put_gs(
+       $self->{'db'}->save_ds(
                ds => \@ds,
                current_filename => $self->{'current_filename'},
                headline => $self->{'headline'},
index 2804a68..afec0d9 100755 (executable)
--- a/t/4-db.t
+++ b/t/4-db.t
@@ -24,15 +24,15 @@ ok($db = new WebPAC::DB( debug => $debug ), "new");
 
 ok(! $db->path, "path");
 
-ok(! $db->load_gs(), 'load_gs');
-ok(! $db->load_gs({ '000' => '000' }), 'load_gs');
+ok(! $db->load_ds(), 'load_ds');
+ok(! $db->load_ds({ '000' => '000' }), 'load_ds');
 
-ok(! $db->save_gs(), "save_gs");
-ok(! $db->save_gs({ '000' => '000' }), 'save_gs');
+ok(! $db->save_ds(), "save_ds");
+ok(! $db->save_ds({ '000' => '000' }), 'save_ds');
 
 undef $db;
 
-ok(my $path = tempdir(), "path");
+ok(my $path = tempdir( CLEANUP => 1 ), "path");
 
 diag "DB path: $path";
 
@@ -48,10 +48,10 @@ ok($db->path( $path ), "path($path)");
 
 cmp_ok($db->{'path'}, 'eq', $path, "path");
 
-ok(! $db->load_gs(), 'load_gs');
-ok(! $db->load_gs({ '000' => '000' }), 'load_gs');
+ok(! $db->load_ds(), 'load_ds');
+ok(! $db->load_ds({ '000' => '000' }), 'load_ds');
 
-ok(! $db->save_gs(), "save_gs");
+ok(! $db->save_ds(), "save_ds");
 
 my @ds = [ {
        'name' => 'Izvor: ',
@@ -69,14 +69,14 @@ my @ds = [ {
        },
 ];
 
-ok(! $db->save_gs(), "empty save_gs");
-throws_ok { $db->save_gs( foo => 1 ) } qr/ds/, "save_gs - ds";
-throws_ok { $db->save_gs( ds => \@ds ) } qr/current_filename/, "save_gs - current_filename";
-throws_ok { $db->save_gs( ds => \@ds, 'current_filename' => 'foo' ) } qr/headline/, "save_gs - headline";
+ok(! $db->save_ds(), "empty save_ds");
+throws_ok { $db->save_ds( foo => 1 ) } qr/ds/, "save_ds - ds";
+throws_ok { $db->save_ds( ds => \@ds ) } qr/current_filename/, "save_ds - current_filename";
+throws_ok { $db->save_ds( ds => \@ds, 'current_filename' => 'foo' ) } qr/headline/, "save_ds - headline";
 
-ok($db->save_gs( ds => \@ds, 'current_filename' => 'foo', 'headline' => 'bar' ), "save_gs");
+ok($db->save_ds( ds => \@ds, 'current_filename' => 'foo', 'headline' => 'bar' ), "save_ds");
 
-ok(my @ds2 = $db->load_gs({ '000' => '000' }), "load_gs");
+ok(my @ds2 = $db->load_ds({ '000' => '000' }), "load_ds");
 
 is_deeply(\@ds, \@ds2, "loaded data");
 
diff --git a/t/6-unit.t b/t/6-unit.t
new file mode 100755 (executable)
index 0000000..429af8c
--- /dev/null
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 23;
+use Test::Exception;
+use Cwd qw/abs_path/;
+use File::Temp qw/tempdir/;
+use blib;
+
+BEGIN {
+use_ok( 'WebPAC::Lookup' );
+use_ok( 'WebPAC::Input::ISIS' );
+use_ok( 'WebPAC::DB' );
+use_ok( 'WebPAC::Normalize::XML' );
+use_ok( 'WebPAC::Output::TT' );
+}
+
+ok(my $abs_path = abs_path($0), "abs_path");
+$abs_path =~ s#/[^/]*$#/#;
+diag "abs_path: $abs_path";
+
+my $isis_file = "$abs_path../t/winisis/BIBL";
+
+diag "isis_file: $isis_file";
+
+ok(my $lookup = new WebPAC::Lookup(
+       lookup_file => "$abs_path../conf/lookup/isis.pm",
+), "new Lookup");
+
+ok(my $isis = new WebPAC::Input::ISIS(
+       code_page => 'ISO-8859-2',      # application encoding
+), "new Input::ISIS");
+
+ok(my $maxmfn = $isis->open(
+       filename => $isis_file,
+       code_page => '852',             # database encoding
+), "Input::ISIS->open");
+
+ok(my $path = tempdir( CLEANUP => 1 ), "path");
+
+ok(my $db = new WebPAC::DB(
+       path => $path,
+), "new DB");
+
+ok(my $n = new WebPAC::Normalize::XML(
+#      filter => { 'foo' => sub { shift } },
+       db => $db,
+       lookup_regex => $lookup->regex,
+       debug => 1,
+), "new Normalize::XML");
+
+ok($n->open(
+       tag => 'isis',
+       xml_file => "$abs_path../conf/normalize/isis.xml",
+), "Normalize::XML->open");
+
+ok(my $out = new WebPAC::Output::TT(
+       include_path => "$abs_path../conf/output/tt",
+       filters => { foo => sub { shift } },
+), "new Output::TT");
+
+while (my $row = $isis->fetch) {
+       
+       ok(my @ds = $n->data_structure($row), "data_structure");
+
+use Data::Dumper;
+print Dumper(\@ds);
+
+       ok($out->apply(
+               template => 'html.tt',
+               data => @ds,
+       ), "apply");
+
+};