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