/[webpac2]/trunk/t/2-input-dbf.t
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/t/2-input-dbf.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 869 - (show annotations)
Thu Jun 21 21:26:19 2007 UTC (16 years, 10 months ago) by dpavlin
File MIME type: application/x-troff
File size: 1123 byte(s)
 r1290@llin:  dpavlin | 2007-06-21 23:26:25 +0200
 experimental (still unfinished) dbf input

1 #!/usr/bin/perl -w
2
3 use Test::More tests => 1179;
4 use Test::Exception;
5 use Cwd qw/abs_path/;
6 use blib;
7 use strict;
8
9 use Data::Dump qw/dump/;
10
11 my $debug = shift @ARGV;
12
13 BEGIN {
14 use_ok( 'WebPAC::Input' );
15 }
16
17 ok(my $abs_path = abs_path($0), "abs_path");
18 $abs_path =~ s#/[^/]*$#/#;
19
20 my $module = 'WebPAC::Input::DBF';
21 diag "testing with $module", $debug ? ' with debug' : '';
22
23 ok(my $input = new WebPAC::Input(
24 module => $module,
25 no_log => $debug ? 0 : 1,
26 no_progress_bar => 1,
27 debug => $debug,
28 ), "new");
29
30 ok(my $db = $input->open(
31 path => "$abs_path/data/cas2000.dbf",
32 input_config => {
33 xmapping => [
34 { 'foobar' => [ '200', 'a' ] },
35 ],
36 },
37 ), "open");
38 ok(my $size = $input->size, "size");
39
40 diag "size: $size" if ($debug);
41
42 ok(defined($input->{ll_db}->{_rows}), 'have ll_db->rows');
43
44 foreach my $mfn ( 1 ... $size ) {
45
46 ok(defined($input->{ll_db}->{_rows}->{$mfn}), "have ll_db->_rows->$mfn");
47
48 diag "row: ", dump( $input->{ll_db}->{_rows}->{$mfn} ) if ($debug);
49
50 my $rec = $input->fetch;
51
52 ok($rec, "fetch $mfn");
53
54 cmp_ok($input->pos, '==', $mfn, "pos $mfn");
55
56 diag "rec: ", dump($rec), "\n" if ($debug);
57 }
58

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26