/[webpac2]/trunk/t/4-store.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

Annotation of /trunk/t/4-store.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 887 - (hide annotations)
Mon Sep 3 15:26:46 2007 UTC (16 years, 8 months ago) by dpavlin
File MIME type: application/x-troff
File size: 3279 byte(s)
 r1322@llin:  dpavlin | 2007-09-03 16:44:01 +0200
 - replace Data::Dumper usage with Data::Dump
 - rewrite WebPAC::Store to use Class::Accessor

1 dpavlin 209 #!/usr/bin/perl -w
2    
3 dpavlin 887 use Test::More tests => 37;
4 dpavlin 209 use Test::Exception;
5     use blib;
6     use File::Temp qw/tempdir/;
7     use strict;
8 dpavlin 887 use Data::Dump;
9 dpavlin 209
10     BEGIN {
11     use_ok( 'WebPAC::Store' );
12     }
13    
14     my $db;
15 dpavlin 713 my $debug = shift @ARGV;
16 dpavlin 209 my $no_log = 1; # force no log output
17 dpavlin 713 $no_log = 0 if ($debug);
18 dpavlin 209
19     diag "NULL Store";
20    
21 dpavlin 887 ok(new WebPAC::Store(), 'new without database');
22 dpavlin 209
23 dpavlin 887 ok($db = new WebPAC::Store({ database => 'foobar', debug => $debug }), "new");
24 dpavlin 218
25 dpavlin 713 throws_ok { $db->load_ds() } qr/id/, 'load_ds without id';
26 dpavlin 209 ok(! $db->load_ds( id => 000 ), 'load_ds');
27    
28 dpavlin 713 throws_ok { $db->save_ds() } qr/id/, "save_ds without id";
29     throws_ok { $db->save_ds( id => 000 ) } qr/ds/, 'save_ds without ds';
30 dpavlin 209
31     undef $db;
32    
33 dpavlin 887 ok($db = new WebPAC::Store({ database => 'webpac-test', debug => $debug, no_log => $no_log }), "new");
34 dpavlin 209
35 dpavlin 735 #
36     # test *_ds
37     #
38    
39 dpavlin 217 throws_ok { $db->load_ds() } qr/without id/, 'load_ds without arguments';
40 dpavlin 209 ok(! $db->load_ds( id => 000 ), 'load_ds');
41    
42     throws_ok { $db->save_ds() } qr/id/, "save_ds - need id";
43    
44     my $ds = {
45     'Source' => {
46     'name' => 'Izvor: ',
47     'tag' => 'Source',
48     'display' => [ 'foo' ]
49     },
50     'ID' => {
51     'name' => 'ID',
52     'tag' => 'IDths',
53     'swish' => [ 'bar' ],
54     'lookup_key' => [ 'bar' ]
55     },
56     };
57    
58     throws_ok { $db->save_ds( id => 1 ) } qr/ds/, "save_ds - need ds";
59    
60     ok($db->save_ds( id => 1, ds => $ds ), "save_ds");
61    
62     ok(my $ds2 = $db->load_ds( id => 1 ), "load_ds with id");
63    
64     is_deeply($ds, $ds2, "loaded data");
65    
66 dpavlin 217 throws_ok { $ds2 = $db->load_ds( 1 ) } qr/HASH/, "load_ds without hash";
67 dpavlin 209
68 dpavlin 217 ok($ds2 = $db->load_ds( id => 1 ), "load_ds");
69    
70 dpavlin 209 is_deeply($ds, $ds2, "loaded data");
71    
72     ok(! $db->load_ds( id => 42 ), "load_ds non-existing");
73    
74 dpavlin 887 ok($db = new WebPAC::Store({ database => 'webpac-test', debug => $debug, no_log => $no_log }), "new");
75 dpavlin 217
76 dpavlin 713 ok(! $db->load_ds( id => 1, input => 'foobar' ), "load_ds with invalid input");
77 dpavlin 217
78 dpavlin 713 ok(! $db->load_ds( id => 1, database => 'non-existant', ), "load_ds with unknown database");
79 dpavlin 217
80 dpavlin 713 ok($ds2 = $db->load_ds( id => 1, database => 'webpac-test' ), "load_ds");
81    
82 dpavlin 735 #
83     # test *_lookup
84     #
85    
86 dpavlin 713 my $l = {
87     foo => { 42 => 1 },
88     };
89    
90 dpavlin 715 ok(! $db->load_lookup( input => 'non-existant', key => 'foo' ), 'invalid load_lookup');
91    
92 dpavlin 713 ok($db->save_lookup( input => 'foo', key => 'bar', data => $l ), "save_lookup");
93    
94 dpavlin 887 ok(-e $db->var_path( 'lookup', 'webpac-test', 'foo', 'bar'), "exists");
95 dpavlin 713
96 dpavlin 715 is_deeply($db->load_lookup( input => 'foo', key => 'bar' ), $l, 'load_lookup');
97    
98 dpavlin 713 ok($db->save_lookup( database => 'baz', input => 'foo', key => 'bar', data => $l ), "save_lookup with database");
99    
100 dpavlin 887 ok(-e $db->var_path( '/lookup','baz','foo','bar'), "exists");
101 dpavlin 713
102 dpavlin 715 is_deeply($db->load_lookup( database => 'baz', input => 'foo', key => 'bar' ), $l, 'load_lookup');
103    
104 dpavlin 735 #
105     # test *_row
106     #
107    
108     my $row = {
109     '000' => [ 42 ],
110     '900' => [ qw/a foo b bar c baz/ ],
111     };
112    
113     ok(! $db->load_row( input => 'non-existant', id => 1234 ), 'invalid load_row');
114    
115     ok($db->save_row( input => 'foo', id => 1234, row => $row ), "save_row");
116    
117 dpavlin 887 ok(-e $db->var_path( 'row','webpac-test','foo',1234), "exists");
118 dpavlin 735
119     is_deeply($db->load_row( input => 'foo', id => 1234 ), $row, 'load_row');
120    
121     ok($db->save_row( database => 'baz', input => 'foo', id => 1234, row => $row ), "save_row with database");
122    
123 dpavlin 887 ok(-e $db->var_path( 'row','baz','foo',1234), "exists");
124 dpavlin 735
125     is_deeply($db->load_row( database => 'baz', input => 'foo', id => 1234 ), $row, 'load_row');
126    
127 dpavlin 209 undef $db;
128    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26