1#!perl -w
2$| = 1;
3
4use strict;
5
6use Cwd;
7use File::Path;
8use File::Spec;
9use Test::More;
10
11my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || "" ) =~ /^dbi:Gofer.*transport=/i;
12
13my @formats = qw(CSV Pipe Tab Fixed Paragraph ARRAY);
14eval { require AnyData; };
15plan skip_all => "Use must download and install AnyData before you can install DBD::AnyData!" if $@;
16
17my $dir = File::Spec->catdir( getcwd(), 'test_output' );
18
19rmtree $dir;
20END { rmtree $dir }
21mkpath $dir;
22
23use_ok("DBI");
24use_ok("DBD::AnyData");
25
26for my $driver ('DBD::AnyData')
27{
28    note "$driver";
29    for my $format (@formats)
30    {
31        note sprintf "  %10s ... ", $format;
32        test( $driver, $format );
33    }
34}
35
36done_testing();
37
38sub test
39{
40    my ( $driver, $format ) = @_;
41    return $driver =~ /dbd/i
42      ? test_dbd($format)
43      : test_ad($format);
44}
45
46sub test_ad { }
47
48sub test_dbd
49{
50    my $format = shift;
51    my $dbh = DBI->connect( "dbi:AnyData:(RaiseError=>1):", undef, undef, { f_dir => $dir } );
52    ok( $dbh, "connect" );
53    my $tbl = "test_" . $format;
54    my $file = File::Spec->catfile( $dir, $tbl );
55    unlink $file if -e $file;
56    my $flags = { pattern => 'A5 A8 A3' };
57
58    $dbh->func( $tbl, $format, $file, $flags, 'ad_catalog' )
59      unless $format =~ /XML|HTMLtable|ARRAY/;
60
61    # CREATE A TEMPORARY TABLE FROM DBI/SQL COMMANDS
62    # INSERT, UPDATE, and DELETE ROWS
63    #
64
65    ok( $dbh->do("CREATE TABLE $tbl (name TEXT, country TEXT,sex TEXT)"), "CREATE $tbl" );
66    ok( $dbh->do("INSERT INTO $tbl VALUES ('Sue','fr','f')"),             "INSERT 1. row into $tbl" );
67    ok( $dbh->do("INSERT INTO $tbl VALUES ('Tom','fr','f')"),             "INSERT 2. row into $tbl" );
68    ok( $dbh->do("INSERT INTO $tbl VALUES ('Bev','en','f')"),             "INSERT 3. row into $tbl" );
69    ok( $dbh->do("UPDATE $tbl SET sex='m' WHERE name = 'Tom'"),           "UPDATE $tbl" );
70    ok( $dbh->do("DELETE FROM $tbl WHERE name = 'Bev'"),                  "DELETE FROM $tbl" );
71    #  print $dbh->func('SELECT * FROM test','ad_dump');
72    if ( $format ne 'ARRAY' )
73    {
74        if ( $format =~ /XML|HTMLtable/ )
75        {
76            $dbh->func( $tbl, $format, $file, $flags, 'ad_export' );    # save to disk
77        }
78        $dbh->func( $tbl, 'ad_clear' );                                 # clear from memory
79        $dbh->func( $tbl, $format, $file, $flags, 'ad_import' );        # read from disk
80    }
81    my %val;
82    $val{single_select} = $dbh->selectrow_array(                        # display single value
83                                                 qq/SELECT sex FROM $tbl WHERE name = 'Sue'/
84                                               );
85    is( 'f', $val{single_select}, "Single select" );
86    my $sth = $dbh->prepare(                                            # display multiple rows
87                             qq/SELECT name FROM $tbl WHERE country = ?/
88                           );
89    $sth->execute('fr');
90    while ( my ($name) = $sth->fetchrow )
91    {
92        $val{select_multiple} .= $name;
93    }
94    is( "SueTom", $val{select_multiple}, "Multiple select" );
95    $sth = $dbh->prepare("SELECT * FROM $tbl");                         # display column names
96    $sth->execute();
97    $val{names} = join ',', @{ $sth->{NAME_lc} };
98    is( "name,country,sex", $val{names}, "Names" );
99    $val{rows} = $sth->rows;                                            # display number of rows
100    is( 2, $val{rows}, "rows" );
101
102    if ( $format ne 'ARRAY' )
103    {
104        my $str = $dbh->func(                                           # convert to
105                              'ARRAY', [ [ "a", "b" ], [ 1, 2 ] ], $format, undef, undef, $flags, 'ad_convert'
106                            );
107        $str =~ s/\s+/,/ if $format eq 'Fixed';
108        my $ary = $dbh->func(                                           # convert from
109                              $format, [$str], 'ARRAY', undef, $flags, 'ad_convert'
110                            );
111        is( 'a', $ary->[0]->[0], "ad_convert" );
112    }
113    return "ok";
114}
115__END__
116