1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
#!/usr/local/bin/perl -w
$|++;
use strict;
BEGIN { unshift @INC, '/htdocs/a/my_lib' }
my @formats = qw(CSV Pipe Tab Fixed Paragraph ARRAY);
eval {
require AnyData;
};
die "Use must download and install AnyData before you can install DBD::AnyData!" if $@;
=pod
undef $@;
eval {
require XML::Parser;
require XML::Twig;
};
unshift @formats,'XML' unless $@;
undef $@;
eval {
require HTML::Parser;
require HTML::TableExtract;
require CGI;
};
push @formats,'HTMLtable' unless $@;
=cut
for my $driver('DBD::AnyData') {
print "\n$driver\n";
for my $format(@formats) {
printf " %10s ... ", $format;
printf "%s!\n" , test($driver,$format);
}
}
sub test {
my($driver,$format)=@_;
return $driver =~ /dbd/i
? test_dbd($format)
: test_ad($format);
}
sub test_ad {}
sub test_dbd {
my $format = shift;
use DBI;
my $dbh=DBI->connect("dbi:AnyData:(RaiseError=>1):");
my $file = 'AnyData_test_db';
unlink $file if -e $file;
my $flags = {pattern=>'A5 A8 A3'};
$dbh->func('test',$format,$file,$flags,'ad_catalog')
unless $format =~ /XML|HTMLtable|ARRAY/;
# CREATE A TEMPORARY TABLE FROM DBI/SQL COMMANDS
# INSERT, UPDATE, and DELETE ROWS
#
$dbh->do("CREATE TABLE test (name TEXT, country TEXT,sex TEXT)");
$dbh->do("INSERT INTO test VALUES ('Sue','fr','f')");
$dbh->do("INSERT INTO test VALUES ('Tom','fr','f')");
$dbh->do("INSERT INTO test VALUES ('Bev','en','f')");
$dbh->do("UPDATE test SET sex='m' WHERE name = 'Tom'");
$dbh->do("DELETE FROM test WHERE name = 'Bev'");
# print $dbh->func('SELECT * FROM test','ad_dump');
if ($format ne 'ARRAY') {
if ($format =~ /XML|HTMLtable/) {
$dbh->func('test',$format,$file,$flags,'ad_export'); # save to disk
}
$dbh->func('test','ad_clear'); # clear from memory
$dbh->func('test',$format,$file,$flags,'ad_import'); # read from disk
}
my %val;
$val{single_select} =
$dbh->selectrow_array( # display single value
qq/SELECT sex FROM test WHERE name = 'Sue'/
);
return "Failed single select" unless 'f' eq $val{single_select};
my $sth = $dbh->prepare( # display multiple rows
qq/SELECT name FROM test WHERE country = ?/
);
$sth->execute('fr');
while (my ($name)=$sth->fetchrow) {
$val{select_multiple} .= $name;
}
return "Failed multiple select" unless "SueTom" eq $val{select_multiple};
$sth = $dbh->prepare('SELECT * FROM test'); # display column names
$sth->execute();
$val{names} = join ',',@{$sth->{NAME_lc}};
return "Failed names" unless "name,country,sex" eq $val{names};
$val{rows} = $sth->rows; # display number of rows
return "Failed rows" unless 2 == $val{rows};
if ($format ne 'ARRAY') {
my $str = $dbh->func( # convert to
'ARRAY',[["a","b"],[1,2]],$format,undef,undef,$flags,'ad_convert'
);
$str =~ s/\s+/,/ if $format eq 'Fixed';
my $ary = $dbh->func( # convert from
$format,[$str],'ARRAY',undef,$flags,'ad_convert');
return "Failed converting" unless 'a' eq $ary->[0]->[0];
}
return "ok";
}
__END__
|
