#!/usr/bin/perl -w use strict; BEGIN { $| = 1; eval 'use DBI 1.00'; if ($@ ne '') { print "1..0\n"; print "DBI couldn't be loaded, aborting test\n"; print "Error returned from eval was:\n", $@; print "ok 1\n"; exit; } print "1..9\n"; print "DBI loaded\n"; } END { print "not ok 1\n" unless $::DBIloaded; } ### DBI->trace(2); $::DBIloaded = 1; print "ok 1\n"; my $dir = ( -d './t' ? 't' : '.' ); print "Unlinking write.dbf write.dbt\n"; if (-f "$dir/write.dbf") { unlink "$dir/write.dbf" or print "Error unlinking $dir/write.dbf: $!\n"; } print "We will make a copy of database files rooms.dbf\n"; eval "use File::Copy;"; if ($@) { print "Look's like you do not have File::Copy, we will do cp\n"; system("cp", "$dir/rooms.dbf", "$dir/write.dbf"); } else { print "Will use File::Copy\n"; copy("$dir/rooms.dbf", "$dir/write.dbf"); } unless (-f "$dir/write.dbf") { print "not ok 2\n"; exit; } # Does not make sense to continue print "ok 2\n"; print "Connect to dbi:XBase:$dir\n"; my $dbh = DBI->connect("dbi:XBase:$dir") or do { print $DBI::errstr; print "not ok 3\n"; exit; }; print "ok 3\n"; my $command = 'insert into write values ("new room", "new facility")'; print "Prepare command `$command'\n"; my $sth = $dbh->prepare($command) or do { print $dbh->errstr(); print "not ok 4\n"; exit; }; print "ok 4\n"; print "Execute it\n"; $sth->execute() or do { print $sth->errstr(); print "not ok 5\n"; exit; }; print "ok 5\n"; $command = 'insert into write ( facility ) values ("Lights")'; print "Prepare command `$command'\n"; $sth = $dbh->prepare($command) or do { print $dbh->errstr(); print "not ok 6\n"; exit; }; print "ok 6\n"; print "Execute it\n"; $sth->execute() or do { print $sth->errstr(); print "not ok 7\n"; exit; }; print "ok 7\n"; print "And now we should check if it worked\n"; my $selcom = 'select * from write'; print "Prepare and execute '$selcom'\n"; my $select = $dbh->prepare($selcom) or do { print $dbh->errstr(); print "not ok 8\n"; exit; }; $select->execute() or do { print $select->errstr(); print "not ok 8\n"; exit; }; print "ok 8\n"; my $result = ''; my @data; while (@data = $select->fetchrow_array()) { $result .= "@data\n"; } my $expected_result = join '', ; if ($result ne $expected_result) { print "Expected:\n$expected_result"; print "Got:\n$result"; print "not "; } print "ok 9\n"; $sth->finish(); $command = 'insert into write(facility,roomname) values (?,?)'; print "Preparing $command\n"; $sth = $dbh->prepare($command) or do { print $dbh->errstr(); print "not ok 10\n"; exit; }; $sth->execute('krtek', 'jezek') or do { print $sth->errstr(); print "not ok 11\n"; exit; }; my @row = $dbh->selectrow_array("select roomname,facility from write where facility = 'krtek'"); if ("@row" ne 'jezek krtek') { print "Expected 'jezek krtek', got '@row'\nnot ok 12\n"; } $dbh->disconnect(); 1; __DATA__ None Bay 1 Main Bay 14 Main Bay 2 Main Bay 5 Main Bay 11 Main Bay 6 Main Bay 3 Main Bay 4 Main Bay 10 Main Bay 8 Main Gigapix Main Bay 12 Main Bay 15 Main Bay 16 Main Bay 17 Main Bay 18 Main Mix A Audio Mix B Audio Mix C Audio Mix D Audio Mix E Audio ADR-Foley Audio Mach Rm Audio Transfer Audio Bay 19 Main Dub Main Flambe Audio FILM 1 Film FILM 2 Film FILM 3 Film SCANNING Film Mix F Audio Mix G Audio Mix H Audio BullPen Film Celco Film MacGrfx Main Mix J Audio AVID Main BAY 7 Main new room new facili Lights