@@ -1,340 +1,187 @@
-0.43 - 2014-06-30, H.Merijn Brand
- * Updated copyright to 2014
- * Unquote schema's in test for cygwin
- * Extra guards in Makefile.PL for unmet requirements
-
-0.42 - 2013-08-14, H.Merijn Brand
- * Optionally skip tests using File::Spec->tempdir () RT#87684
- * And document the use of $TMPDIR in README
- * Make the SYNOPSIS more reflect real-world usage
- * Detect DBI::Test and use it if available
-
-0.41 - 2013-07-29, H.Merijn Brand
- * Use File::Spec->tmpdir () for universal existing folder
- Note that huge $TMP folders may cause the test to run slow
- * Use File::Spec::rel2abs () instead of abs_path and hoops
- * Guard against parallel testing, which is unsupported
- * Guard against streaming tests (they PASS on the DBI-devel)
-
-0.40 - 2013-07-23, H.Merijn Brand
- * Fix version references in doc
- * Fix tests for Windows
-
-0.39 - 2013-06-28, H.Merijn Brand
- * Use f_file in docs. file is deprecated
- * DBD::CSV's repository moved to github
- * Add test for row-completeness
- * Fix UTF-8 tests to better follow Text::CSV_XS auto-encoding
- * Require more recent versions of low level modules that fixe
- issues reported for DBD::CSV
- * Development will also do mosts tests with DBI_SQL_NANO=1
- * Added support for f_dir_search from DBD::File (in fact DBI was
- changed to feature this for DBD::CSV :)
- * Fix test relying on spell-error in DBI's error message
- * Document csv_class (still undertested)
-
-0.38 - 2013-01-09, H.Merijn Brand
- * the tar paxheaders hit again (http://www.perlmonks.org/?node_id=1004571)
-
-0.37 - 2013-01-09, H.Merijn Brand
- * Fixed RT#80078, resulting in getline calls on undef (Benjamin Booth)
- * Require latest DBI and SQL::Statement
- * Updated copyright to 2013
- * Fixes for DBI-1.623 (Jens Rehsack)
-
-0.36 - 2012-08-22, H.Merijn Brand
- * Add line/record number and position in error messages
-
-0.35 - 2012-05-24, H.Merijn Brand
- * Improved documentation (including mje's contribution)
- * Tested under 5.16.0 (installed)
-
-0.34 - 2012-05-12, H.Merijn Brand
- * Updated copyright to 2012
- * Require 5.8.1, as DBI does
- * Tested against perl-5.16.0-RC0 + DBI-1.620
-
-0.33 - 2011-09-07, H.Merijn Brand
- * NAME / DISTNAME in Makefile.PL
-
-0.32 - 2011-09-07, H.Merijn Brand
- * TYPE should be numeric
- * Added tests for return count of delete statements in do
- * Upped copyright to 2011
- * Added tests for return count of update statements (Peter Rabbitson)
- * Try to catch (more) usernames on Windows as schema names
- * More cross-checks for META data
-
-0.31 - 2010-09-18, H.Merijn Brand
- * Require 5.8.1 (effectively already doing so by requiring DBI-1.614)
- * Update tests to use warnings and done_testing ()
- requires Test::More-0.90, which is also required for DBI
- * Better diagnostics for empty files
- * Allow late setting of attributes (RT#61168) - requires DBI-1.614
-
-0.30 - 2010-07-09, H.Merijn Brand
- * Text::CSV_XS now called with auto_diag
- * Implement valid_attrs
- * Next version will require DBI-1.612 or higher
- This is a transition release
-
-0.29_03 - 2010-07-04, H.Merijn Brand
- * Remove leftover debug. Causes fails
-
-0.29_02 - 2010-07-02, H.Merijn Brand
- * More work to keep in sync with DBI development (Jens)
- * Better diagnostics for missing modules
- * More spell-check fixes
- * Tests for ChopBlanks (now fixed in DBD::File)
- * Tests changed to accept old and new DBI
- * Statement handle attributes handled in new DBD::File
-
-0.29_01 - 2010-06-11, H.Merijn Brand
- * Prepare for DBD::File-0.39 (DBI-1.612+)
- Should still work with older DBI versions
- * Documentation updates (style, consistency, spell-checking)
- * Test folder cleanup
- * More tests for insert
- * Tested RT#58039
-
-0.29 - 2010-05-03, H.Merijn Brand
- * Fix git URL in META.yml
- * Add empty CLONE method to prevent warning when cloning threads
- * Minimum perl 5.8.1
- * Minimum Text::CSV_XS 0.71
- * Support for f_encoding (requires DBI-1.611)
- * Documentation updates
-
-0.28 - 2010-03-16, H.Merijn Brand
- * Remove t/00_minimumversion.t from distribution
- * Dropped YAML spec to 1.0
- * Sync up with SQL::Statement 1.25
- NOTE: Internals of both modules changed. They will change again for
- SQL::Statement 2.0
-
-0.27 - 2010-02-17, H.Merijn Brand
- * Upped copyright to 2010
- * Doc-fix typo in link (Detlef Pilzecker)
- * Doc-fix small typo's
-
-0.26 - 2009-11-10, H.Merijn Brand
- * Adjustments for windows (RT#50544)
- * Mark all non-\w chars illegal in field and table names
- * Fix field types after execute (RT#51090, vgdoqd)
- * Fix for NULL joins. Requires SQL::Statement 1.23 (RT#43010, JBAZIK)
-
-0.25 - 2009-10-15, H.Merijn Brand
- * Raised minimum perl version to 5.005_03
- * Requires Text::CSV_XS 0.43 (needs eof () method and
- error_diag ()) (RT#33764)
- * Code cleanup (perlcritic, style, layout)
- * Implemented f_ext
- * Implemented f_schema (in DBD::File)
- * Split csv handles for input (no eol default) and
- output (default "\r\n") (RT#33767)
- * Updated info URL's
- * Cleaned up tests
- * Tests now use Test::More
- * Cut down README. No need to be a duplicate module pod
- * Added TODO to documentation
- * Added examples/ from docs
- * Add csv_null
- * Add csv_* to pass to the parser
- * Improved error handling and reporting
- * Table names case sensitiveness
- * Implemented raw_header (RT#44583)
-
-0.23 - 2005-08-10, Jeff Zucker <jzuckerATcpan.org>
- * fixed bug in automatic column generation, defining
- col_names => [] will auto generate col1, col2, etc.
- thanks for bug report, harleypig on AnnoCPAN
-
- * added support for multi-character end-of-line separators
- thanks for suggestion, harleypig on AnnoCPAN
-
-0.22 - 2005-04-01, Jeff Zucker <jzuckerATcpan.org>
-
- * removed DESTROY and disconnect - use DBD File's instead
-
- * added ignore_missing_table flag to avoid warnings with
- DROP TABLE IF EXISTS
-
-0.21 - 2004-04-18, Jeff Zucker <jzuckerATcpan.org>
-
- * added support for $dbh->{Active}, should now work
- well with Class::DBI and other caching systems
-
- * added support for DROP TABLE IF EXISTS - doesn't
- complain if table is already dropped
-
- * removed DBD::File from the distribution - it's now
- distributed with DBI 1.42 and higher
+2005-04-01 Jeff Zucker <jzuckerATcpan.org> (0.22)
-0.2002 - 2002-03-01, Jeff Zucker <jzuckerATcpan.org>
+ * removed DESTROY and disconnect - use DBD File's instead
- * added parser-caching for speedier operation,
- see File.pm prepare()
+ * added ignore_missing_table flag to avoid warnings with
+ DROP TABLE IF EXISTS
+
+2004-04-18 Jeff Zucker <jzuckerATcpan.org> (0.21)
- * further adjustments in tests including fix for
- prototypes to make it perl 5.8 compatible
+ * added support for $dbh->{Active}, should now work
+ well with Class::DBI and other caching systems
+ * added support for DROP TABLE IF EXISTS - doesn't
+ complain if table is already dropped
-0.2001 - 2002-01-21, Jeff Zucker <jzuckerATcpan.org>
+ * removed DBD::File from the distribution - it's now
+ distributed with DBI 1.42 and higher
+
+2002-03-01 Jeff Zucker <jzuckerATcpan.org> (0.2002)
- * adjusted docs to show Jeff as the new maintainer.
+ * added parser-caching for speedier operation,
+ see File.pm prepare()
- * added docs for extended SQL features (joins, etc.)
- available with SQL::Statement 1.0 and above.
+ * further adjustments in tests including fix for
+ prototypes to make it perl 5.8 compatible
- * adjusted tests blobs.t, chopblanks.t, and ak-dbd.t
- to work with all versions of SQL::Statement.
-0.1030 - 2002-12-20, Jochen Wiedmann <joe@ispsoft.de>
+2002-01-21 Jeff Zucker <jzuckerATcpan.org> (0.2001)
- * lib/DBD/File.pm: Locking is now suppressed under
- VMS. David Webb <d.webb@mdx.ac.uk>
- * lib/DBD/CSV.pm: Added a hint to the docs, that
- "f_dir=" is required for the current directory
- on VMS and not "f_dir=.". David Webb
- <d.webb@mdx.ac.uk>
+ * adjusted docs to show Jeff as the new maintainer.
-0.1029 - 2001-11-28, Jochen Wiedmann <joe@ispsoft.de>
+ * added docs for extended SQL features (joins, etc.)
+ available with SQL::Statement 1.0 and above.
- * lib/DBD/CSV.pm (fetch_row): A numeric value
- must be assigned to $!.
+ * adjusted tests blobs.t, chopblanks.t, and ak-dbd.t
+ to work with all versions of SQL::Statement.
-0.1028 - 2001-11-20, Jochen Wiedmann <joe@ispsoft.de>
+2002-12-20 Jochen Wiedmann <joe@ispsoft.de> (0.1030)
- * lib/DBD/CSV.pm (fetch_row): Changed "undef $!"
- to "$! = ''". David Arnold <arnoldd@aecl.ca>
+ * lib/DBD/File.pm: Locking is now suppressed under
+ VMS. David Webb <d.webb@mdx.ac.uk>
+ * lib/DBD/CSV.pm: Added a hint to the docs, that
+ "f_dir=" is required for the current directory
+ on VMS and not "f_dir=.". David Webb
+ <d.webb@mdx.ac.uk>
-0.1026 - 2001-05-04, Jochen Wiedmann <joe@ispsoft.de>
+2001-11-28 Jochen Wiedmann <joe@ispsoft.de> (0.1029)
- * lib/DBD/File.pm (table_info): Added closedir().
- Alex Hornby <alex@anvil.co.uk>
+ * lib/DBD/CSV.pm (fetch_row): A numeric value
+ must be assigned to $!.
-0.1025 - 2000-12-22, Jochen Wiedmann <joe@ispsoft.de>
+2001-11-20 Jochen Wiedmann <joe@ispsoft.de> (0.1028)
- * lib/DBD/CSV.pm (fetch_row): Now cleaning $! before
- calling $csv->getline(). Seems to return false errors
- otherwise in some cases. Jeremy Wadsack
- <jwadsack@wadsack-allen.com>
- * Made Makefile.PL CPAN conformant.
- * Removed unnecessary stuff in Makefile.PL which verified
- the DBI installation.
+ * lib/DBD/CSV.pm (fetch_row): Changed "undef $!"
+ to "$! = ''". David Arnold <arnoldd@aecl.ca>
-0.1023 - 2000-07-31, Jochen Wiedmann <joe@ispsoft.de>
+2001-05-04 Jochen Wiedmann <joe@ispsoft.de> (0.1026)
- * lib/DBD/File.pm (STORE): Changed croak to die.
- Guido Flohr <guido@imperia.westend.com>
+ * lib/DBD/File.pm (table_info): Added closedir().
+ Alex Hornby <alex@anvil.co.uk>
-0.1023 - 2000-07-31, Jochen Wiedmann <joe@ispsoft.de>
+2000-12-22 Jochen Wiedmann <joe@ispsoft.de> (0.1025)
- * Minor fix in the docs, thanks to Andreas Grupp,
- grupp@elektronikschule.de.
- * Minor compatibility fixes in the test suite for
- Perl 5.6.
+ * lib/DBD/CSV.pm (fetch_row): Now cleaning $! before
+ calling $csv->getline(). Seems to return false errors
+ otherwise in some cases. Jeremy Wadsack
+ <jwadsack@wadsack-allen.com>
+ * Made Makefile.PL CPAN conformant.
+ * Removed unnecessary stuff in Makefile.PL which verified
+ the DBI installation.
-0.1022 - 1999-10-07, Jochen Wiedmann <joe@ispsoft.de>
+2000-07-31 Jochen Wiedmann <joe@ispsoft.de> (0.1023)
- * lib/DBD/File.pm (connect): In the DSN, \ was removed in
- all cases. It is now possible to use \\ for a DSN
- containing a backslash, for example f_dir=C:\\tmp.
- Suggested by Giuliano Cioffi <g.cioffi@piemme.it>.
- * lib/DBD/CSV.pm: Lots os minor POD patches, thanks to
- Adam Di Carlo <adam@onshore.com>.
- * lib/DBD/CSV.pm: More POD patches, thanks to
- Timothy F Armbruster <tfarmbruster@notes.west.raytheon.com>.
+ * lib/DBD/File.pm (STORE): Changed croak to die.
+ Guido Flohr <guido@imperia.westend.com>
-0.1021 - 1999-05-10, Jochen Wiedmann <joe@ispsoft.de>
+2000-07-31 Jochen Wiedmann <joe@ispsoft.de> (0.1023)
- * lib/DBD/CSV.pm (push_row): Fixed typo in docs where DBI:File:
- was used instead of DBI:CSV: (Mitra <mitra@earth.path.net>)
- * lib/DBD/CSV.pm (fetch_row): An undef result from $csv->getline()
- was sometimes handled incorrectly. Thanks to Syed Muhammad Nayeem
- <smnayeem@dhaka.agni.com>.
- * lib/DBD/File.pm: Removed use of flock under Win95.
+ * Minor fix in the docs, thanks to Andreas Grupp,
+ grupp@elektronikschule.de.
+ * Minor compatibility fixes in the test suite for
+ Perl 5.6.
-0.1020 - 1999-03-17, Jochen Wiedmann <joe@ispsoft.de>
+1999-10-07 Jochen Wiedmann <joe@ispsoft.de> (0.1022)
- * lib/DBD/File.pm (FETCH): Simplified handling of $sth->{'NAME'}
- due to a change in SQL::Statement 0.1011. (Teun Burgers,
- Teun Burgers <burgers@ecn.nl>)
+ * lib/DBD/File.pm (connect): In the DSN, \ was removed in
+ all cases. It is now possible to use \\ for a DSN
+ containing a backslash, for example f_dir=C:\\tmp.
+ Suggested by Giuliano Cioffi <g.cioffi@piemme.it>.
+ * lib/DBD/CSV.pm: Lots os minor POD patches, thanks to
+ Adam Di Carlo <adam@onshore.com>.
+ * lib/DBD/CSV.pm: More POD patches, thanks to
+ Timothy F Armbruster <tfarmbruster@notes.west.raytheon.com>.
-0.1019 - 1999-02-11, Jochen Wiedmann <joe@ispsoft.de>
+1999-05-10 Jochen Wiedmann <joe@ispsoft.de> (0.1021)
- * Makefile.PL (CheckModule): Now requires Text::CSV_XS 0.16, due
- to an imcompatible change.
+ * lib/DBD/CSV.pm (push_row): Fixed typo in docs where DBI:File:
+ was used instead of DBI:CSV: (Mitra <mitra@earth.path.net>)
+ * lib/DBD/CSV.pm (fetch_row): An undef result from $csv->getline()
+ was sometimes handled incorrectly. Thanks to Syed Muhammad Nayeem
+ <smnayeem@dhaka.agni.com>.
+ * lib/DBD/File.pm: Removed use of flock under Win95.
-0.1018 - 1998-12-30, Jochen Wiedmann <joe@ispsoft.de>
+1999-03-17 Jochen Wiedmann <joe@ispsoft.de> (0.1020)
- * t/lib.pl: Fixed a bug in the test suite. (File::Spec wasn't
- loaded)
+ * lib/DBD/File.pm (FETCH): Simplified handling of $sth->{'NAME'}
+ due to a change in SQL::Statement 0.1011. (Teun Burgers,
+ Teun Burgers <burgers@ecn.nl>)
-0.1017 - 1998-10-26, Jochen Wiedmann <joe@ispsoft.de>
+1999-02-11 Jochen Wiedmann <joe@ispsoft.de> (0.1019)
- * lib/DBD/CSV.pm: Fixed some examples in the docs. (Brian
- Millett, bpm@ec-group.com)
- * Now using File::Spec, if available, for Mac portability.
- (Chris Nandor, pudge@pobox.com)
+ * Makefile.PL (CheckModule): Now requires Text::CSV_XS 0.16, due
+ to an imcompatible change.
-0.1016 - 1998-10-20, Jochen Wiedmann <joe@ispsoft.de>
+1998-12-30 Jochen Wiedmann <joe@ispsoft.de> (0.1018)
- * lib/Bundle/DBD/CSV.pm: Added lib/Bundle/DBD/CSV.pm
- * lib/DBD/File.pm: Added $dbh->table_info(). Added
- $dbh->type_info_all(). Added $dbh->quote($str, $type).
+ * t/lib.pl: Fixed a bug in the test suite. (File::Spec wasn't
+ loaded)
-0.1015 - 1998-09-17, Jochen Wiedmann <joe@ispsoft.de>
+1998-10-26 Jochen Wiedmann <joe@ispsoft.de> (0.1017)
- * lib/DBD/CSV.pm: Fixed bug in the docs, the "undef" argument
- was missing in conjunction with parameters,
- Honza Pazdziora <adelton@fi.muni.cz>.
- * lib/DBD/CSV.pm: Added csv_eol, csv_sep_char, csv_quote_char
- and csv_escape_char to DSN.
+ * lib/DBD/CSV.pm: Fixed some examples in the docs. (Brian
+ Millett, bpm@ec-group.com)
+ * Now using File::Spec, if available, for Mac portability.
+ (Chris Nandor, pudge@pobox.com)
-0.1014 - 1998-08-31, Jochen Wiedmann <joe@ispsoft.de>
+1998-10-20 Jochen Wiedmann <joe@ispsoft.de> (0.1016)
- * Makefile.PL: Added AUTHOR, ABSTRACT_FROM and PREREQ_PM.
- * Makefile.PL: Fixed error handling by using DBI::set_err.
+ * lib/Bundle/DBD/CSV.pm: Added lib/Bundle/DBD/CSV.pm
+ * lib/DBD/File.pm: Added $dbh->table_info(). Added
+ $dbh->type_info_all(). Added $dbh->quote($str, $type).
-0.1013 - 1998-08-17, Jochen Wiedmann <joe@ispsoft.de>
+1998-09-17 Jochen Wiedmann <joe@ispsoft.de> (0.1015)
- * lib/DBD/File.pm (drop): $self->{'fh'} is now closed before
- unlinking it. This makes DROP TABLE work under Win32 and
- other Non-Unixes.
+ * lib/DBD/CSV.pm: Fixed bug in the docs, the "undef" argument
+ was missing in conjunction with parameters,
+ Honza Pazdziora <adelton@fi.muni.cz>.
+ * lib/DBD/CSV.pm: Added csv_eol, csv_sep_char, csv_quote_char
+ and csv_escape_char to DSN.
-0.1012 - 1998-08-17, Jochen Wiedmann <joe@ispsoft.de>
+1998-08-31 Jochen Wiedmann <joe@ispsoft.de> (0.1014)
- * lib/DBD/File.pm (open_table): Added binmode.
- * Added Gerald Richter's modifications for DBD::ConfFile to the
- test suite.
- * DBD-File/File.pm: Removed DBD::File::SetError and SetWarning.
- Replaced $sth->func('get_fbav') with $sth->get_fbav() (Requires
- DBI 0.94). DBD::File is now a Perl-Only driver.
- * DBD-File/File.pm (fetch): Fixed a DBD::CSV::SetError to
- DBD::File::SetError; thanks to Gerald Richter
- (richter@ecos.de)
- * DBD-File/File.pm: Fixed some $sth->{attr}'s to $sth->FETCH|STORE,
- my thanks to Gerald Richter.
+ * Makefile.PL: Added AUTHOR, ABSTRACT_FROM and PREREQ_PM.
+ * Makefile.PL: Fixed error handling by using DBI::set_err.
-0.1011 - 1998-06-25, Jochen Wiedmann <joe@ispsoft.de>
+1998-08-17 Jochen Wiedmann <joe@ispsoft.de> (0.1013)
- * DBD-File/File.pm (execute): Added missing eval around
- $stmt->execute();
- * DBD-File/File.pm (FETCH): $sth->{TYPE} is now returning
- undef (workaround for a bug in DBI 0.93).
+ * lib/DBD/File.pm (drop): $self->{'fh'} is now closed before
+ unlinking it. This makes DROP TABLE work under Win32 and
+ other Non-Unixes.
-0.1010 - 1998-06-11, Jochen Wiedmann <joe@ispsoft.de>
+1998-08-17 Jochen Wiedmann <joe@ispsoft.de> (0.1012)
- * Added DBD::File, DBD::CSV is derived from it.
+ * lib/DBD/File.pm (open_table): Added binmode.
+ * Added Gerald Richter's modifications for DBD::ConfFile to the
+ test suite.
+ * DBD-File/File.pm: Removed DBD::File::SetError and SetWarning.
+ Replaced $sth->func('get_fbav') with $sth->get_fbav() (Requires
+ DBI 0.94). DBD::File is now a Perl-Only driver.
+ * DBD-File/File.pm (fetch): Fixed a DBD::CSV::SetError to
+ DBD::File::SetError; thanks to Gerald Richter
+ (richter@ecos.de)
+ * DBD-File/File.pm: Fixed some $sth->{attr}'s to $sth->FETCH|STORE,
+ my thanks to Gerald Richter.
- * CSV.pm (open_table): Added $dbh->{tables}->{$table}->{file}.
+1998-06-25 Jochen Wiedmann <joe@ispsoft.de> (0.1011)
-0.1002 - 1998-05-21, Jochen Wiedmann <joe@ispsoft.de>
+ * DBD-File/File.pm (execute): Added missing eval around
+ $stmt->execute();
+ * DBD-File/File.pm (FETCH): $sth->{TYPE} is now returning
+ undef (workaround for a bug in DBI 0.93).
- * CSV.pm: Now using the misc.files_as_tables feature
- of SQL::Statement
+1998-06-11 Jochen Wiedmann <joe@ispsoft.de> (0.1010)
-0.1000 - 1998-05-05, Jochen Wiedmann <joe@ispsoft.de>
+ * Added DBD::File, DBD::CSV is derived from it.
+
+ * CSV.pm (open_table): Added $dbh->{tables}->{$table}->{file}.
+
+1998-05-21 Jochen Wiedmann <joe@ispsoft.de> (0.1002)
+
+ * CSV.pm: Now using the misc.files_as_tables feature
+ of SQL::Statement
+
+1998-05-05 Jochen Wiedmann <joe@ispsoft.de> (0.1000)
+
+ * Initial version
- * Initial version
@@ -5,42 +5,33 @@ Makefile.PL
README
lib/Bundle/DBD/CSV.pm
lib/DBD/CSV.pm
-lib/DBD/CSV/TypeInfo.pm
-lib/DBD/CSV/GetInfo.pm
-lib/DBI/Test/Case/DBD/CSV/t10_base.pm
-lib/DBI/Test/Case/DBD/CSV/t11_dsnlist.pm
-lib/DBI/Test/Case/DBD/CSV/t20_createdrop.pm
-lib/DBI/Test/Case/DBD/CSV/t85_error.pm
-lib/DBI/Test/DBD/CSV/Conf.pm
-lib/DBI/Test/DBD/CSV/List.pm
-t/00_meta.t
-t/00_pod_cov.t
-t/00_pod.t
-t/10_base.t
-t/11_dsnlist.t
-t/20_createdrop.t
-t/30_insertfetch.t
-t/31_delete.t
-t/32_update.t
-t/40_numrows.t
-t/41_nulls.t
-t/42_bindparam.t
-t/43_blobs.t
-t/44_listfields.t
-t/48_utf8.t
-t/50_chopblanks.t
-t/51_commit.t
-t/55_dir_search.t
-t/60_misc.t
-t/61_meta.t
-t/70_csv.t
-t/71_csv-ext.t
-t/72_csv-schema.t
-t/73_csv-case.t
-t/80_rt.t
-t/85_error.t
+t/00base.t
+t/10dsnlist.t
+t/20createdrop.t
+t/30insertfetch.t
+t/40bindparam.t
+t/40blobs.t
+t/40listfields.t
+t/40nulls.t
+t/40numrows.t
+t/50chopblanks.t
+t/50commit.t
+t/Adabas.dbtest
+t/Adabas.mtest
+t/CSV.dbtest
+t/CSV.mtest
+t/README
+t/ak-dbd.t
+t/csv.t
+t/dbdadmin.t
t/lib.pl
-t/tmp.csv
-examples/passwd.pl
-META.yml Module YAML meta-data (added by MakeMaker)
-META.json Module JSON meta-data (added by MakeMaker)
+t/mSQL.dbtest
+t/mSQL.mtest
+t/mSQL1.dbtest
+t/mSQL1.mtest
+t/mysql.dbtest
+t/mysql.mtest
+t/pNET.dbtest
+t/pNET.mtest
+t/skeleton.test
+META.yml Module meta-data (added by MakeMaker)
@@ -1,25 +1,5 @@
-\.aspell\.local.pws
-\.dbi-git
+^blib/
\bCVS\b
~$
-\.tgz$
-\.tar\.gz$
-\.git
-blib/
-cover_db/
-genMETA.pl
-Makefile
-MANIFEST.SKIP
-pm_to_blib
-sandbox/
-tmp/
-.releaserc
-^xx
-META.yml
-valgrind.log
-tests.skip
-xt/
-t/basic/
-t/DBI/
-t/DBD/
-t/SQL/
+^Makefile$
+^pm_to_blib$
@@ -1,76 +0,0 @@
-{
- "abstract" : "DBI driver for CSV files",
- "generated_by" : "Author",
- "provides" : {
- "DBD::CSV" : {
- "file" : "lib/DBD/CSV.pm",
- "version" : "0.43"
- }
- },
- "name" : "DBD-CSV",
- "meta-spec" : {
- "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
- },
- "dynamic_config" : 1,
- "release_status" : "stable",
- "resources" : {
- "license" : [
- "http://dev.perl.org/licenses/"
- ],
- "repository" : {
- "url" : "https://github.com/perl5-dbi/DBD-CSV.git",
- "web" : "https://github.com/perl5-dbi/DBD-CSV.git",
- "type" : "git"
- }
- },
- "author" : [
- "Jochen Wiedmann",
- "Jeff Zucker",
- "H.Merijn Brand <h.m.brand@xs4all.nl>",
- "Jens Rehsack <rehsack@cpan.org>"
- ],
- "x_installdirs" : "site",
- "version" : "0.43",
- "prereqs" : {
- "build" : {
- "requires" : {
- "Config" : "0"
- }
- },
- "test" : {
- "recommends" : {
- "Test::More" : "1.001003"
- },
- "requires" : {
- "Cwd" : "0",
- "Test::More" : "0.90",
- "charnames" : "0",
- "Encode" : "0",
- "Test::Harness" : "0"
- }
- },
- "configure" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "runtime" : {
- "requires" : {
- "SQL::Statement" : "1.405",
- "DBI" : "1.628",
- "Text::CSV_XS" : "1.01",
- "DBD::File" : "0.42",
- "perl" : "5.008001"
- },
- "recommends" : {
- "perl" : "5.018002",
- "Text::CSV_XS" : "1.09",
- "DBI" : "1.631"
- }
- }
- },
- "license" : [
- "perl_5"
- ]
-}
@@ -1,43 +1,14 @@
----
-abstract: DBI driver for CSV files
-author:
- - Jochen Wiedmann
- - Jeff Zucker
- - H.Merijn Brand <h.m.brand@xs4all.nl>
- - Jens Rehsack <rehsack@cpan.org>
-build_requires:
- Config: 0
-configure_requires:
- ExtUtils::MakeMaker: 0
-dynamic_config: 1
-generated_by: Author, CPAN::Meta::Converter version 2.141520
-license: perl
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: '1.4'
-name: DBD-CSV
-provides:
- DBD::CSV:
- file: lib/DBD/CSV.pm
- version: '0.43'
-recommends:
- DBI: '1.631'
- Test::More: '1.001003'
- Text::CSV_XS: '1.09'
- perl: '5.018002'
-requires:
- Cwd: 0
- DBD::File: '0.42'
- DBI: '1.628'
- Encode: 0
- SQL::Statement: '1.405'
- Test::Harness: 0
- Test::More: '0.90'
- Text::CSV_XS: '1.01'
- charnames: 0
- perl: '5.008001'
-resources:
- license: http://dev.perl.org/licenses/
- repository: https://github.com/perl5-dbi/DBD-CSV.git
-version: '0.43'
-x_installdirs: site
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: DBD-CSV
+version: 0.22
+version_from: lib/DBD/CSV.pm
+installdirs: site
+requires:
+ DBD::File: 0.30
+ DBI: 1.00
+ SQL::Statement: 0.1011
+ Text::CSV_XS: 0.16
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
@@ -1,145 +1,60 @@
# -*- perl -*-
-# Copyright (c) 2009-2014 H.Merijn Brand
-
-require 5.008001;
-
+require 5.004;
use strict;
+use vars qw($DBI_INC_DIR);
+
+require ExtUtils::MakeMaker;
+
+eval {
+ require DBD::CSV;
+ if ($DBD::CSV::VERSION < 0.1010) {
+ print <<END_OF_WARNING;
+
+WARNING! You seem to have installed a recent version of the DBD::CSV module.
+Note that the API (in particular attribute names) has changed, to conform
+to the DBI specifications. For example \$dbh->{directory} has been renamed
+to \$dbh->{f_dir} and \$dbh->{eol}, \$dbh->{quote_char}, ... are gone in
+favour of \$dbh->{tables}->{\$table}->{csv}, which is used for storing
+meta information. You might need to modify existing sources before doing a
+"make install". See the README for details.
+
+END_OF_WARNING
+ }
+};
+
+
+my %opts =
+ ( 'NAME' => 'DBD::CSV',
+ 'VERSION_FROM' => 'lib/DBD/CSV.pm',
+ 'dist' => { 'SUFFIX' => ".gz",
+ 'DIST_DEFAULT' => 'all tardist',
+ 'COMPRESS' => "gzip -9vf" }
+ );
+
+if ($ExtUtils::MakeMaker::VERSION >= 5.43) {
+ $opts{'ABSTRACT_FROM'} = 'lib/DBD/CSV.pm';
+ $opts{'AUTHOR'} = 'Jeff Zucker (jeff@vpservices.com)';
+ $opts{'PREREQ_PM'} =
+ { 'DBI' => '1.00',
+ 'Text::CSV_XS' => '0.16',
+ 'SQL::Statement' => '0.1011',
+ 'DBD::File' => '0.30',
+ };
+}
+
+ExtUtils::MakeMaker::WriteMakefile(%opts);
-use ExtUtils::MakeMaker;
-use File::Spec;
-
-eval { require DBI; };
-if ($@) {
- print <<"MSG";
-
-DBD::CSV requires DBI and it cannot be loaded:
-$@
-
-MSG
- exit 1;
- }
-if ($DBI::VERSION < 1.628) {
- print <<"MSG";
-
-Trying to use DBD::CSV with DBI-$DBI::VERSION is heading for failure.
-DBD::CSV is relying on DBD::File, bundled in the DBI release and does
-require features not present in this version of DBI.
-
-MSG
- exit 0;
- }
-eval { require DBD::CSV; };
-if (!$@ && $DBD::CSV::VERSION < 0.1010) {
- print <<'MSG';
-
-WARNING! You seem to have installed a recent version of the DBD::CSV module.
-Note that the API (in particular attribute names) has changed, to conform to
-the DBI specifications. For example $dbh->{directory} has been renamed to
-$dbh->{f_dir} and $dbh->{eol}, $dbh->{quote_char}, ... are gone in favour of
-$dbh->{tables}{$table}{csv}, which is used for storing meta information. You
-might need to modify existing sources before doing a "make install". See the
-README for details.
-
-MSG
- sleep 5;
- }
-
-use vars qw( $DBI_INC_DIR );
-
-{ my $tmp_dir = File::Spec->tmpdir ();
- my $default = $ENV{AUTOMATED_TESTING} ? "n" : "y";
- if (prompt ("Enable the use of $tmp_dir for tests?", $default) =~ m/[Yy]/) {
- unlink "tests.skip";
- }
- else {
- open my $fh, ">", "tests.skip";
- print $fh "tmpdir\n";
- close $fh;
- }
- }
-my %wm = (
- NAME => "DBD::CSV",
- DISTNAME => "DBD-CSV",
- ABSTRACT => "DBI driver for CSV and similar structured files",
- AUTHOR => "H.Merijn Brand <h.m.brand\@xs4all.nl>",
- VERSION_FROM => "lib/DBD/CSV.pm",
- PREREQ_PM => {
- "DBI" => 1.628,
- "DBD::File" => 0.42,
- "Text::CSV_XS" => 1.01,
- "SQL::Statement" => 1.405,
- "Test::More" => 0.90,
- "Encode" => 0,
- "charnames" => 0,
- },
- clean => {
- FILES => join " ", qw(
- output
- cover_db
- valgrind.log
- )
- },
- macro => {
- TARFLAGS => "--format=ustar -c -v -f",
- },
- );
-$ExtUtils::MakeMaker::VERSION > 6.30 and $wm{LICENSE} = "perl";
-
-# Windows is case-insensitive! Do not remove lib.pl and tmp.csv
-$File::Path::VERSION > 2.06 and File::Path::remove_tree (glob "t/[bA-KM-SU-Z]*");
-
-eval "use DBI::Test::Conf ();";
-if ($@) {
- warn "******\n",
- "******\tDBI::Test is not installed.\n",
- "******\tIt will be required in one of the upcoming releases.\n",
- "******\n";
- }
-else {
- use lib "lib";
-
- local $" = " ";
- $wm{PREREQ_PM}{"DBI::Test"} = "0.001";
- my @nt = DBI::Test::Conf->setup (CONTAINED_DBDS => [qw( CSV )]);
- $wm{test} = { TESTS => join " " => (sort glob "t/*.t"), @nt };
- $wm{clean}{FILES} .= " @nt";
- }
-
-my $rv = WriteMakefile (%wm);
-
-1;
package MY;
-sub postamble
-{
- my $min_vsn = ($] >= 5.010 && -d "xt" && ($ENV{AUTOMATED_TESTING} || 0) != 1)
- ? join "\n" =>
- 'test ::',
- ' -@env DBI_SQL_NANO=1 make -e test_dynamic TEST_FILES=t/[1-9]*.t',
- '',
- 'test ::',
- ' -@env TEST_FILES="xt/*.t" make -e test_dynamic',
- ''
- : "";
- join "\n" =>
- 'cover test_cover:',
- ' cover -test',
- '',
- 'spellcheck:',
- ' pod-spell-check --aspell --ispell',
- '',
- 'checkmeta: spellcheck',
- ' perl sandbox/genMETA.pl -c',
- '',
- 'fixmeta: distmeta',
- ' perl sandbox/genMETA.pl',
- '',
- 'tgzdist: checkmeta fixmeta $(DISTVNAME).tar.gz distcheck',
- ' -@mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz',
- ' -@cpants_lint.pl $(DISTVNAME).tgz',
- ' -@rm -f Debian_CPANTS.txt',
- '',
- $min_vsn;
- } # postamble
+#sub postamble {
+# "\npm_to_blib: README\n" .
+# "\nREADME: lib/DBD/CSV.pm" .
+# "\n\tperldoc -t lib/DBD/CSV.pm >README\n\n"
+#}
+
+sub libscan {
+ my($self, $path) = @_;
+ ($path =~ /\~$/) ? undef : $path;
+}
@@ -1,74 +1,526 @@
-Module
+NAME
DBD::CSV - DBI driver for CSV files
-Description
+SYNOPSIS
+ use DBI;
+ $dbh = DBI->connect("DBI:CSV:f_dir=/home/joe/csvdb")
+ or die "Cannot connect: " . $DBI::errstr;
+ $sth = $dbh->prepare("CREATE TABLE a (id INTEGER, name CHAR(10))")
+ or die "Cannot prepare: " . $dbh->errstr();
+ $sth->execute() or die "Cannot execute: " . $sth->errstr();
+ $sth->finish();
+ $dbh->disconnect();
+
+ # Read a CSV file with ";" as the separator, as exported by
+ # MS Excel. Note we need to escape the ";", otherwise it
+ # would be treated as an attribute separator.
+ $dbh = DBI->connect(qq{DBI:CSV:csv_sep_char=\\;});
+ $sth = $dbh->prepare("SELECT * FROM info");
+
+ # Same example, this time reading "info.csv" as a table:
+ $dbh = DBI->connect(qq{DBI:CSV:csv_sep_char=\\;});
+ $dbh->{'csv_tables'}->{'info'} = { 'file' => 'info.csv'};
+ $sth = $dbh->prepare("SELECT * FROM info");
+
+WARNING
+ THIS IS ALPHA SOFTWARE. It is *only* 'Alpha' because the
+ interface (API) is not finalized. The Alpha status does not
+ reflect code quality or stability.
+
+DESCRIPTION
The DBD::CSV module is yet another driver for the DBI (Database
independent interface for Perl). This one is based on the SQL
"engine" SQL::Statement and the abstract DBI driver DBD::File
and implements access to so-called CSV files (Comma separated
- values).
+ values). Such files are mostly used for exporting MS Access and
+ MS Excel data.
-Copying
- Copyright (C) 2009-2014 by H.Merijn Brand
- Copyright (C) 2004-2009 by Jeff Zucker
- Copyright (C) 1998-2004 by Jochen Wiedmann
-
- You may distribute this module under the terms of either the GNU
- General Public License or the Artistic License, as specified in
- the Perl README file.
+ See the DBI(3) manpage for details on DBI, the SQL::Statement(3)
+ manpage for details on SQL::Statement and the DBD::File(3)
+ manpage for details on the base class DBD::File.
+
+ Prerequisites
+
+ The only system dependent feature that DBD::File uses, is the
+ `flock()' function. Thus the module should run (in theory) on
+ any system with a working `flock()', in particular on all Unix
+ machines and on Windows NT. Under Windows 95 and MacOS the use
+ of `flock()' is disabled, thus the module should still be
+ usable,
+
+ Unlike other DBI drivers, you don't need an external SQL engine
+ or a running server. All you need are the following Perl
+ modules, available from any CPAN mirror, for example
+
+ ftp://ftp.funet.fi/pub/languages/perl/CPAN/modules/by-module
+
+ DBI the DBI (Database independent interface for Perl), version 1.00
+ or a later release
+
+ SQL::Statement
+ a simple SQL engine
+
+ Text::CSV_XS
+ this module is used for writing rows to or reading rows from
+ CSV files.
+
+ Installation
+
+ Installing this module (and the prerequisites from above) is
+ quite simple. You just fetch the archive, extract it with
+
+ gzip -cd DBD-CSV-0.1000.tar.gz | tar xf -
+
+ (this is for Unix users, Windows users would prefer WinZip or
+ something similar) and then enter the following:
+
+ cd DBD-CSV-0.1000
+ perl Makefile.PL
+ make
+ make test
+
+ If any tests fail, let me know. Otherwise go on with
+
+ make install
+
+ Note that you almost definitely need root or administrator
+ permissions. If you don't have them, read the
+ ExtUtils::MakeMaker man page for details on installing in your
+ own directories. the ExtUtils::MakeMaker manpage.
+
+ Supported SQL
+
+ The level of SQL support available depends on the version of
+ SQL::Statement installed. Any version will support *basic*
+ CREATE, INSERT, DELETE, UPDATE, and SELECT statements. Only
+ versions of SQL::Statement 1.0 and above support additional
+ features such as table joins, string functions, etc. See the
+ documentation of the latest version of SQL::Statement for details.
+
+ Creating a database handle
+
+ Creating a database handle usually implies connecting to a
+ database server. Thus this command reads
+
+ use DBI;
+ my $dbh = DBI->connect("DBI:CSV:f_dir=$dir");
+
+ The directory tells the driver where it should create or open
+ tables (a.k.a. files). It defaults to the current directory,
+ thus the following are equivalent:
+
+ $dbh = DBI->connect("DBI:CSV:");
+ $dbh = DBI->connect("DBI:CSV:f_dir=.");
+
+ You may set other attributes in the DSN string, separated by
+ semicolons.
+
+ Creating and dropping tables
+
+ You can create and drop tables with commands like the following:
+
+ $dbh->do("CREATE TABLE $table (id INTEGER, name CHAR(64))");
+ $dbh->do("DROP TABLE $table");
+
+ Note that currently only the column names will be stored and no
+ other data. Thus all other information including column type
+ (INTEGER or CHAR(x), for example), column attributes (NOT NULL,
+ PRIMARY KEY, ...) will silently be discarded. This may change in
+ a later release.
+
+ A drop just removes the file without any warning.
+
+ See the DBI(3) manpage for more details.
+
+ Table names cannot be arbitrary, due to restrictions of the SQL
+ syntax. I recommend that table names are valid SQL identifiers:
+ The first character is alphabetic, followed by an arbitrary
+ number of alphanumeric characters. If you want to use other
+ files, the file names must start with '/', './' or '../' and
+ they must not contain white space.
+
+ Inserting, fetching and modifying data
+
+ The following examples insert some data in a table and fetch it
+ back: First all data in the string:
+
+ $dbh->do("INSERT INTO $table VALUES (1, "
+ . $dbh->quote("foobar") . ")");
+
+ Note the use of the quote method for escaping the word 'foobar'.
+ Any string must be escaped, even if it doesn't contain binary
+ data.
+
+ Next an example using parameters:
+
+ $dbh->do("INSERT INTO $table VALUES (?, ?)", undef,
+ 2, "It's a string!");
+
+ Note that you don't need to use the quote method here, this is
+ done automatically for you. This version is particularly well
+ designed for loops. Whenever performance is an issue, I
+ recommend using this method.
+
+ You might wonder about the `undef'. Don't wonder, just take it
+ as it is. :-) It's an attribute argument that I have never ever
+ used and will be parsed to the prepare method as a second
+ argument.
+
+ To retrieve data, you can use the following:
+
+ my($query) = "SELECT * FROM $table WHERE id > 1 ORDER BY id";
+ my($sth) = $dbh->prepare($query);
+ $sth->execute();
+ while (my $row = $sth->fetchrow_hashref) {
+ print("Found result row: id = ", $row->{'id'},
+ ", name = ", $row->{'name'});
+ }
+ $sth->finish();
+
+ Again, column binding works: The same example again.
+
+ my($query) = "SELECT * FROM $table WHERE id > 1 ORDER BY id";
+ my($sth) = $dbh->prepare($query);
+ $sth->execute();
+ my($id, $name);
+ $sth->bind_columns(undef, \$id, \$name);
+ while ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ $sth->finish();
+
+ Of course you can even use input parameters. Here's the same
+ example for the third time:
+
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query);
+ $sth->bind_columns(undef, \$id, \$name);
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id);
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ $sth->finish();
+ }
+
+ See the DBI(3) manpage for details on these methods. See the
+ SQL::Statement(3) manpage for details on the WHERE clause.
+
+ Data rows are modified with the UPDATE statement:
+
+ $dbh->do("UPDATE $table SET id = 3 WHERE id = 1");
+
+ Likewise you use the DELETE statement for removing rows:
+
+ $dbh->do("DELETE FROM $table WHERE id > 1");
- Recent changes can be (re)viewed in the public GIT repository at
- https://github.com/perl5-dbi/DBD-CSV.git
- Feel free to clone your own copy:
+ Error handling
- $ git clone https://github.com/perl5-dbi/DBD-CSV.git DBD-CSV
+ In the above examples we have never cared about return codes. Of
+ course, this cannot be recommended. Instead we should have
+ written (for example):
- or get it as a tgz:
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query)
+ or die "prepare: " . $dbh->errstr();
+ $sth->bind_columns(undef, \$id, \$name)
+ or die "bind_columns: " . $dbh->errstr();
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id)
+ or die "execute: " . $dbh->errstr();
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ }
+ $sth->finish($id)
+ or die "finish: " . $dbh->errstr();
- $ wget --output-document=DBD-CSV-git.tgz \
- 'https://github.com/perl5-dbi/DBD-CSV/archive/master.tar.gz
+ Obviously this is tedious. Fortunately we have DBI's
+ *RaiseError* attribute:
- which will unpack to DBD-CSV-master
+ $dbh->{'RaiseError'} = 1;
+ $@ = '';
+ eval {
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query);
+ $sth->bind_columns(undef, \$id, \$name);
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id);
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ }
+ $sth->finish($id);
+ };
+ if ($@) { die "SQL database error: $@"; }
-Prerequisites:
- DBI - the DBI (Database independent interface for Perl).
+ This is not only shorter, it even works when using DBI methods
+ within subroutines.
- SQL::Statement - a simple SQL engine.
+ Metadata
- Text::CSV_XS - this module is used for writing rows to or reading
- rows from CSV files.
+ The following attributes are handled by DBI itself and not by
+ DBD::File, thus they all work as expected:
-Build/Installation:
- Use CPAN:
- cpan DBD::CSV
+ Active
+ ActiveKids
+ CachedKids
+ CompatMode (Not used)
+ InactiveDestroy
+ Kids
+ PrintError
+ RaiseError
+ Warn (Not used)
+
+ The following DBI attributes are handled by DBD::File:
+
+ AutoCommit
+ Always on
+
+ ChopBlanks
+ Works
+
+ NUM_OF_FIELDS
+ Valid after `$sth->execute'
+
+ NUM_OF_PARAMS
+ Valid after `$sth->prepare'
+
+ NAME
+ Valid after `$sth->execute'; undef for Non-Select
+ statements.
+
+ NULLABLE
+ Not really working. Always returns an array ref of one's, as
+ DBD::CSV doesn't verify input data. Valid after `$sth-
+ >execute'; undef for non-Select statements.
+
+ These attributes and methods are not supported:
+
+ bind_param_inout
+ CursorName
+ LongReadLen
+ LongTruncOk
+
+ In addition to the DBI attributes, you can use the following dbh
+ attributes:
+
+ f_dir This attribute is used for setting the directory where CSV
+ files are opened. Usually you set it in the dbh, it
+ defaults to the current directory ("."). However, it is
+ overwritable in the statement handles.
+
+ csv_eol
+ csv_sep_char
+ csv_quote_char
+ csv_escape_char
+ csv_class
+ csv_csv The attributes *csv_eol*, *csv_sep_char*, *csv_quote_char*
+ and *csv_escape_char* are corresponding to the
+ respective attributes of the Text::CSV_XS object. You
+ want to set these attributes if you have unusual CSV
+ files like /etc/passwd or MS Excel generated CSV files
+ with a semicolon as separator. Defaults are "\015\012",
+ ';', '"' and '"', respectively.
+
+ The attributes are used to create an instance of the
+ class *csv_class*, by default Text::CSV_XS.
+ Alternatively you may pass an instance as *csv_csv*, the
+ latter takes precedence. Note that the *binary*
+ attribute *must* be set to a true value in that case.
+
+ Additionally you may overwrite these attributes on a
+ per-table base in the *csv_tables* attribute.
+
+ csv_tables
+ This hash ref is used for storing table dependent
+ metadata. For any table it contains an element with the
+ table name as key and another hash ref with the
+ following attributes:
+
+ file The tables file name; defaults to
+
+ "$dbh->{f_dir}/$table"
+
+ eol
+ sep_char
+ quote_char
+ escape_char
+ class
+ csv These correspond to the attributes *csv_eol*,
+ *csv_sep_char*, *csv_quote_char*,
+ *csv_escape_char*, *csv_class* and
+ *csv_csv*. The difference is that they work
+ on a per-table base.
+
+ col_names
+ skip_first_row By default DBD::CSV assumes that column names
+ are stored in the first row of the CSV file.
+ If this is not the case, you can supply an
+ array ref of table names with the
+ *col_names* attribute. In that case the
+ attribute *skip_first_row* will be set to
+ FALSE.
+
+ If you supply an empty array ref, the driver
+ will read the first row for you, count the
+ number of columns and create column names
+ like `col0', `col1', ...
+
+ Example: Suggest you want to use /etc/passwd as a CSV file. :-)
+ There simplest way is:
+
+ require DBI;
+ my $dbh = DBI->connect("DBI:CSV:f_dir=/etc;csv_eol=\n;"
+ . "csv_sep_char=:;csv_quote_char=;"
+ . "csv_escape_char=");
+ $dbh->{'csv_tables'}->{'passwd'} = {
+ 'col_names' => ["login", "password", "uid", "gid", "realname",
+ "directory", "shell"]
+ };
+ $sth = $dbh->prepare("SELECT * FROM passwd");
+
+ Another possibility where you leave all the defaults as they are
+ and overwrite them on a per table base:
+
+ require DBI;
+ my $dbh = DBI->connect("DBI:CSV:");
+ $dbh->{'csv_tables'}->{'passwd'} = {
+ 'eol' => "\n",
+ 'sep_char' => ":",
+ 'quote_char' => undef,
+ 'escape_char' => undef,
+ 'file' => '/etc/passwd',
+ 'col_names' => ["login", "password", "uid", "gid", "realname",
+ "directory", "shell"]
+ };
+ $sth = $dbh->prepare("SELECT * FROM passwd");
+
+ Driver private methods
+
+ These methods are inherited from DBD::File:
+
+ data_sources
+ The `data_sources' method returns a list of subdirectories
+ of the current directory in the form
+ "DBI:CSV:directory=$dirname".
+
+ If you want to read the subdirectories of another directory,
+ use
+
+ my($drh) = DBI->install_driver("CSV");
+ my(@list) = $drh->data_sources('f_dir' => '/usr/local/csv_data' );
+
+ list_tables
+ This method returns a list of file names inside $dbh-
+ >{'directory'}. Example:
+
+ my($dbh) = DBI->connect("DBI:CSV:directory=/usr/local/csv_data");
+ my(@list) = $dbh->func('list_tables');
+
+ Note that the list includes all files contained in the
+ directory, even those that have non-valid table names, from
+ the view of SQL. See the section on "Creating and dropping
+ tables" above.
+
+ Data restrictions
+
+ When inserting and fetching data, you will sometimes be
+ surprised: DBD::CSV doesn't correctly handle data types, in
+ particular NULLs. If you insert integers, it might happen, that
+ fetch returns a string. Of course, a string containing the
+ integer, so that's perhaps not a real problem. But the following
+ will never work:
+
+ $dbh->do("INSERT INTO $table (id, name) VALUES (?, ?)",
+ undef, "foo bar");
+ $sth = $dbh->prepare("SELECT * FROM $table WHERE id IS NULL");
+ $sth->execute();
+ my($id, $name);
+ $sth->bind_columns(undef, \$id, \$name);
+ while ($sth->fetch) {
+ printf("Found result row: id = %s, name = %s\n",
+ defined($id) ? $id : "NULL",
+ defined($name) ? $name : "NULL");
+ }
+ $sth->finish();
+
+ The row we have just inserted, will never be returned! The
+ reason is obvious, if you examine the CSV file: The
+ corresponding row looks like
+
+ "","foo bar"
+
+ In other words, not a NULL is stored, but an empty string. CSV
+ files don't have a concept of NULL values. Surprisingly the
+ above example works, if you insert a NULL value for the name!
+ Again, you find the explanation by examining the CSV file:
+
+ ""
+
+ In other words, DBD::CSV has "emulated" a NULL value by writing
+ a row with less columns. Of course this works only if the
+ rightmost column is NULL, the two rightmost columns are NULL,
+ ..., but the leftmost column will never be NULL!
+
+ See the section on "Creating and dropping tables" above for
+ table name restrictions.
+
+TODO
+ Extensions of DBD::CSV:
+
+ CSV file scanner
+ Write a simple CSV file scanner that reads a CSV file and
+ attempts to guess sep_char, quote_char, escape_char and eol
+ automatically.
+
+ These are merely restrictions of the DBD::File or SQL::Statement
+ modules:
+
+ Table name mapping
+ Currently it is not possible to use files with names like
+ `names.csv'. Instead you have to use soft links or rename
+ files. As an alternative one might use, for example a dbh
+ attribute 'table_map'. It might be a hash ref, the keys
+ being the table names and the values being the file names.
+
+ Column name mapping
+ Currently the module assumes that column names are stored in
+ the first row. While this is fine in most cases, there
+ should be a possibility of setting column names and column
+ number from the programmer: For example MS Access doesn't
+ export column names by default.
+
+KNOWN BUGS
+ * The module is using flock() internally. However, this
+ function is not available on platforms. Using flock() is
+ disabled on MacOS and Windows 95: There's no locking at
+ all (perhaps not so important on these operating
+ systems, as they are for single users anyways).
+
+AUTHOR AND COPYRIGHT
+
+ This module is currently maintained by Jeff Zucker <jeff@vpservices.com>.
+
+ The original module was written by Jochen Wiedmann.
+
+ This module is Copyright (C) 1998 by and Jochen Wiedmann
+
+ All rights reserved.
+
+ You may distribute this module under the terms of either the GNU
+ General Public License or the Artistic License, as specified in
+ the Perl README file.
- Or standard build/installation:
- gzip -cd DBD-CSV-0.43.tar.gz | tar xf -
- cd DBD-CSV-0.43
- perl Makefile.PL
- make test
- make install
+SEE ALSO
+ the DBI(3) manpage, the Text::CSV_XS(3) manpage, the
+ SQL::Statement(3) manpage
- (this is for Unix users, Windows users would prefer PowerArchiver,
- WinZip or something similar).
+ For help on the use of DBD::CSV, see the DBI users mailing list:
- The test suite contains extensive tests for all features provided
- by DBD::CSV. Some of them include the use of what is set to be the
- default temporary directory on the system. Even though the tests
- do not use the folder to read or modify data, using the folder will
- imply the scanning of that folder to see if files would qualify for
- use in DBD::CSV. When the folder contains many files, the scanning
- will seriously slow down the testing duration. The configure phase
- therefor asks the user if using the folder is allowed. The default
- answer is yes unless $AUTOMATED_TESTING is set.
- As File::Spec->tmpdir () honors the environment, you can enable
- these tests using another folder by setting $TMPDIR or whatever
- controls tmpdir () or your OS.
+ http://www.isc.org/dbi-lists.html
-Author:
- This module is currently maintained by
+ For general information on DBI see
- H.Merijn Brand < h.m.brand at xs4all.nl >
+ http://www.symbolstone.org/technology/perl/DBI
- The original author is Jochen Wiedmann.
- Previous maintainer was Jeff Zucker
@@ -1,24 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use DBI;
-
-my $dbh = DBI->connect ("DBI:CSV:");
- $dbh->{csv_tables}{passwd} = {
- sep_char => ":",
- quote_char => undef,
- escape_char => undef,
- file => "/etc/passwd",
- col_names => [qw( login password uid gid realname directory shell )],
- };
-my $sth = $dbh->prepare ("SELECT * FROM passwd");
- $sth->execute;
-my %fld;
-my @fld = @{$sth->{NAME_lc}};
-$sth->bind_columns (\@fld{@fld});
-while ($sth->fetch) {
- printf "%-14s %5d %5d %-25.25s %-14.14s %s\n",
- @fld{qw( login uid gid realname shell directory )};
- }
@@ -1,11 +1,8 @@
-#/usr/bin/perl
+# -*- perl -*-
package Bundle::DBD::CSV;
-use strict;
-use warnings;
-
-our $VERSION = "1.12";
+$VERSION = '0.1016';
1;
@@ -17,41 +14,23 @@ Bundle::DBD::CSV - A bundle to install the DBD::CSV driver
=head1 SYNOPSIS
- perl -MCPAN -e 'install Bundle::DBD::CSV'
+C<perl -MCPAN -e 'install Bundle::DBD::CSV'>
=head1 CONTENTS
-DBI 1.631
+DBI 1.02
-Text::CSV_XS 1.09
+Text::CSV_XS 0.14
-SQL::Statement 1.405
+SQL::Statement 0.1006
-DBD::File 0.42
+DBD::File
-DBD::CSV 0.43
+DBD::CSV
=head1 DESCRIPTION
This bundle includes all that's needed to access so-called CSV (Comma
Separated Values) files via a pseudo SQL engine (SQL::Statement) and DBI.
-=head1 AUTHOR
-
-This module is currently maintained by
-
- H.Merijn Brand <h.m.brand@xs4all.nl>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2009-2014 by H.Merijn Brand
-Copyright (C) 2004-2009 by Jeff Zucker
-Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may distribute this module under the terms of either the GNU
-General Public License or the Artistic License, as specified in
-the Perl README file.
-
=cut
@@ -1,257 +0,0 @@
-#!/usr/bin/perl
-
-# The %info hash was automatically generated by
-# DBI::DBD::Metadata::write_getinfo_pm v2.014214.
-
-package DBD::CSV::GetInfo;
-
-use strict;
-use DBD::CSV;
-
-# Beware: not officially documented interfaces...
-# use DBI::Const::GetInfoType qw(%GetInfoType);
-# use DBI::Const::GetInfoReturn qw(%GetInfoReturnTypes %GetInfoReturnValues);
-
-my $sql_driver = "CSV"; # DBD::CSV uses tw-partr version string
-my $sql_ver_fmt = "%02d.%02d.0000"; # ODBC version string: ##.##.#####
-my $sql_driver_ver = sprintf $sql_ver_fmt, split /\./ => $DBD::CSV::VERSION;
-
-sub sql_data_source_name
-{
- my $dbh = shift;
- return "dbi:$sql_driver:" . $dbh->{Name};
- } # sql_data_source_name
-
-sub sql_user_name
-{
- my $dbh = shift;
- # CURRENT_USER is a non-standard attribute, probably undef
- # Username is a standard DBI attribute
- return $dbh->{CURRENT_USER} || $dbh->{Username};
- } # sql_user_name
-
-our %info = (
-# 20 => undef, # SQL_ACCESSIBLE_PROCEDURES
-# 19 => undef, # SQL_ACCESSIBLE_TABLES
-# 0 => undef, # SQL_ACTIVE_CONNECTIONS
-# 116 => undef, # SQL_ACTIVE_ENVIRONMENTS
-# 1 => undef, # SQL_ACTIVE_STATEMENTS
-# 169 => undef, # SQL_AGGREGATE_FUNCTIONS
-# 117 => undef, # SQL_ALTER_DOMAIN
-# 86 => undef, # SQL_ALTER_TABLE
-# 10021 => undef, # SQL_ASYNC_MODE
-# 120 => undef, # SQL_BATCH_ROW_COUNT
-# 121 => undef, # SQL_BATCH_SUPPORT
-# 82 => undef, # SQL_BOOKMARK_PERSISTENCE
-# 114 => undef, # SQL_CATALOG_LOCATION
-# 10003 => undef, # SQL_CATALOG_NAME
-# 41 => undef, # SQL_CATALOG_NAME_SEPARATOR
-# 42 => undef, # SQL_CATALOG_TERM
-# 92 => undef, # SQL_CATALOG_USAGE
-# 10004 => undef, # SQL_COLLATING_SEQUENCE
-# 10004 => undef, # SQL_COLLATION_SEQ
-# 87 => undef, # SQL_COLUMN_ALIAS
-# 22 => undef, # SQL_CONCAT_NULL_BEHAVIOR
-# 53 => undef, # SQL_CONVERT_BIGINT
-# 54 => undef, # SQL_CONVERT_BINARY
-# 55 => undef, # SQL_CONVERT_BIT
-# 56 => undef, # SQL_CONVERT_CHAR
-# 57 => undef, # SQL_CONVERT_DATE
-# 58 => undef, # SQL_CONVERT_DECIMAL
-# 59 => undef, # SQL_CONVERT_DOUBLE
-# 60 => undef, # SQL_CONVERT_FLOAT
-# 48 => undef, # SQL_CONVERT_FUNCTIONS
-# 173 => undef, # SQL_CONVERT_GUID
-# 61 => undef, # SQL_CONVERT_INTEGER
-# 123 => undef, # SQL_CONVERT_INTERVAL_DAY_TIME
-# 124 => undef, # SQL_CONVERT_INTERVAL_YEAR_MONTH
-# 71 => undef, # SQL_CONVERT_LONGVARBINARY
-# 62 => undef, # SQL_CONVERT_LONGVARCHAR
-# 63 => undef, # SQL_CONVERT_NUMERIC
-# 64 => undef, # SQL_CONVERT_REAL
-# 65 => undef, # SQL_CONVERT_SMALLINT
-# 66 => undef, # SQL_CONVERT_TIME
-# 67 => undef, # SQL_CONVERT_TIMESTAMP
-# 68 => undef, # SQL_CONVERT_TINYINT
-# 69 => undef, # SQL_CONVERT_VARBINARY
-# 70 => undef, # SQL_CONVERT_VARCHAR
-# 122 => undef, # SQL_CONVERT_WCHAR
-# 125 => undef, # SQL_CONVERT_WLONGVARCHAR
-# 126 => undef, # SQL_CONVERT_WVARCHAR
-# 74 => undef, # SQL_CORRELATION_NAME
-# 127 => undef, # SQL_CREATE_ASSERTION
-# 128 => undef, # SQL_CREATE_CHARACTER_SET
-# 129 => undef, # SQL_CREATE_COLLATION
-# 130 => undef, # SQL_CREATE_DOMAIN
-# 131 => undef, # SQL_CREATE_SCHEMA
-# 132 => undef, # SQL_CREATE_TABLE
-# 133 => undef, # SQL_CREATE_TRANSLATION
-# 134 => undef, # SQL_CREATE_VIEW
-# 23 => undef, # SQL_CURSOR_COMMIT_BEHAVIOR
-# 24 => undef, # SQL_CURSOR_ROLLBACK_BEHAVIOR
-# 10001 => undef, # SQL_CURSOR_SENSITIVITY
-# 16 => undef, # SQL_DATABASE_NAME
- 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME
-# 25 => undef, # SQL_DATA_SOURCE_READ_ONLY
-# 119 => undef, # SQL_DATETIME_LITERALS
-# 17 => undef, # SQL_DBMS_NAME
-# 18 => undef, # SQL_DBMS_VER
-# 18 => undef, # SQL_DBMS_VERSION
-# 170 => undef, # SQL_DDL_INDEX
-# 26 => undef, # SQL_DEFAULT_TRANSACTION_ISOLATION
-# 26 => undef, # SQL_DEFAULT_TXN_ISOLATION
-# 10002 => undef, # SQL_DESCRIBE_PARAMETER
-# 171 => undef, # SQL_DM_VER
-# 3 => undef, # SQL_DRIVER_HDBC
-# 135 => undef, # SQL_DRIVER_HDESC
-# 4 => undef, # SQL_DRIVER_HENV
-# 76 => undef, # SQL_DRIVER_HLIB
-# 5 => undef, # SQL_DRIVER_HSTMT
- 6 => $INC{"DBD/CSV.pm"}, # SQL_DRIVER_NAME
-# 77 => undef, # SQL_DRIVER_ODBC_VER
- 7 => $sql_driver_ver, # SQL_DRIVER_VER
-# 136 => undef, # SQL_DROP_ASSERTION
-# 137 => undef, # SQL_DROP_CHARACTER_SET
-# 138 => undef, # SQL_DROP_COLLATION
-# 139 => undef, # SQL_DROP_DOMAIN
-# 140 => undef, # SQL_DROP_SCHEMA
-# 141 => undef, # SQL_DROP_TABLE
-# 142 => undef, # SQL_DROP_TRANSLATION
-# 143 => undef, # SQL_DROP_VIEW
-# 144 => undef, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1
-# 145 => undef, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2
-# 27 => undef, # SQL_EXPRESSIONS_IN_ORDERBY
-# 8 => undef, # SQL_FETCH_DIRECTION
-# 84 => undef, # SQL_FILE_USAGE
-# 146 => undef, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1
-# 147 => undef, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2
-# 81 => undef, # SQL_GETDATA_EXTENSIONS
-# 88 => undef, # SQL_GROUP_BY
-# 28 => undef, # SQL_IDENTIFIER_CASE
-# 29 => undef, # SQL_IDENTIFIER_QUOTE_CHAR
-# 148 => undef, # SQL_INDEX_KEYWORDS
-# 149 => undef, # SQL_INFO_SCHEMA_VIEWS
-# 172 => undef, # SQL_INSERT_STATEMENT
-# 73 => undef, # SQL_INTEGRITY
-# 150 => undef, # SQL_KEYSET_CURSOR_ATTRIBUTES1
-# 151 => undef, # SQL_KEYSET_CURSOR_ATTRIBUTES2
-# 89 => undef, # SQL_KEYWORDS
-# 113 => undef, # SQL_LIKE_ESCAPE_CLAUSE
-# 78 => undef, # SQL_LOCK_TYPES
-# 34 => undef, # SQL_MAXIMUM_CATALOG_NAME_LENGTH
-# 97 => undef, # SQL_MAXIMUM_COLUMNS_IN_GROUP_BY
-# 98 => undef, # SQL_MAXIMUM_COLUMNS_IN_INDEX
-# 99 => undef, # SQL_MAXIMUM_COLUMNS_IN_ORDER_BY
-# 100 => undef, # SQL_MAXIMUM_COLUMNS_IN_SELECT
-# 101 => undef, # SQL_MAXIMUM_COLUMNS_IN_TABLE
-# 30 => undef, # SQL_MAXIMUM_COLUMN_NAME_LENGTH
-# 1 => undef, # SQL_MAXIMUM_CONCURRENT_ACTIVITIES
-# 31 => undef, # SQL_MAXIMUM_CURSOR_NAME_LENGTH
-# 0 => undef, # SQL_MAXIMUM_DRIVER_CONNECTIONS
-# 10005 => undef, # SQL_MAXIMUM_IDENTIFIER_LENGTH
-# 102 => undef, # SQL_MAXIMUM_INDEX_SIZE
-# 104 => undef, # SQL_MAXIMUM_ROW_SIZE
-# 32 => undef, # SQL_MAXIMUM_SCHEMA_NAME_LENGTH
-# 105 => undef, # SQL_MAXIMUM_STATEMENT_LENGTH
-# 20000 => undef, # SQL_MAXIMUM_STMT_OCTETS
-# 20001 => undef, # SQL_MAXIMUM_STMT_OCTETS_DATA
-# 20002 => undef, # SQL_MAXIMUM_STMT_OCTETS_SCHEMA
-# 106 => undef, # SQL_MAXIMUM_TABLES_IN_SELECT
-# 35 => undef, # SQL_MAXIMUM_TABLE_NAME_LENGTH
-# 107 => undef, # SQL_MAXIMUM_USER_NAME_LENGTH
-# 10022 => undef, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS
-# 112 => undef, # SQL_MAX_BINARY_LITERAL_LEN
-# 34 => undef, # SQL_MAX_CATALOG_NAME_LEN
-# 108 => undef, # SQL_MAX_CHAR_LITERAL_LEN
-# 97 => undef, # SQL_MAX_COLUMNS_IN_GROUP_BY
-# 98 => undef, # SQL_MAX_COLUMNS_IN_INDEX
-# 99 => undef, # SQL_MAX_COLUMNS_IN_ORDER_BY
-# 100 => undef, # SQL_MAX_COLUMNS_IN_SELECT
-# 101 => undef, # SQL_MAX_COLUMNS_IN_TABLE
-# 30 => undef, # SQL_MAX_COLUMN_NAME_LEN
-# 1 => undef, # SQL_MAX_CONCURRENT_ACTIVITIES
-# 31 => undef, # SQL_MAX_CURSOR_NAME_LEN
-# 0 => undef, # SQL_MAX_DRIVER_CONNECTIONS
-# 10005 => undef, # SQL_MAX_IDENTIFIER_LEN
-# 102 => undef, # SQL_MAX_INDEX_SIZE
-# 32 => undef, # SQL_MAX_OWNER_NAME_LEN
-# 33 => undef, # SQL_MAX_PROCEDURE_NAME_LEN
-# 34 => undef, # SQL_MAX_QUALIFIER_NAME_LEN
-# 104 => undef, # SQL_MAX_ROW_SIZE
-# 103 => undef, # SQL_MAX_ROW_SIZE_INCLUDES_LONG
-# 32 => undef, # SQL_MAX_SCHEMA_NAME_LEN
-# 105 => undef, # SQL_MAX_STATEMENT_LEN
-# 106 => undef, # SQL_MAX_TABLES_IN_SELECT
-# 35 => undef, # SQL_MAX_TABLE_NAME_LEN
-# 107 => undef, # SQL_MAX_USER_NAME_LEN
-# 37 => undef, # SQL_MULTIPLE_ACTIVE_TXN
-# 36 => undef, # SQL_MULT_RESULT_SETS
-# 111 => undef, # SQL_NEED_LONG_DATA_LEN
-# 75 => undef, # SQL_NON_NULLABLE_COLUMNS
-# 85 => undef, # SQL_NULL_COLLATION
-# 49 => undef, # SQL_NUMERIC_FUNCTIONS
-# 9 => undef, # SQL_ODBC_API_CONFORMANCE
-# 152 => undef, # SQL_ODBC_INTERFACE_CONFORMANCE
-# 12 => undef, # SQL_ODBC_SAG_CLI_CONFORMANCE
-# 15 => undef, # SQL_ODBC_SQL_CONFORMANCE
-# 73 => undef, # SQL_ODBC_SQL_OPT_IEF
-# 10 => undef, # SQL_ODBC_VER
-# 115 => undef, # SQL_OJ_CAPABILITIES
-# 90 => undef, # SQL_ORDER_BY_COLUMNS_IN_SELECT
-# 38 => undef, # SQL_OUTER_JOINS
-# 115 => undef, # SQL_OUTER_JOIN_CAPABILITIES
-# 39 => undef, # SQL_OWNER_TERM
-# 91 => undef, # SQL_OWNER_USAGE
-# 153 => undef, # SQL_PARAM_ARRAY_ROW_COUNTS
-# 154 => undef, # SQL_PARAM_ARRAY_SELECTS
-# 80 => undef, # SQL_POSITIONED_STATEMENTS
-# 79 => undef, # SQL_POS_OPERATIONS
-# 21 => undef, # SQL_PROCEDURES
-# 40 => undef, # SQL_PROCEDURE_TERM
-# 114 => undef, # SQL_QUALIFIER_LOCATION
-# 41 => undef, # SQL_QUALIFIER_NAME_SEPARATOR
-# 42 => undef, # SQL_QUALIFIER_TERM
-# 92 => undef, # SQL_QUALIFIER_USAGE
-# 93 => undef, # SQL_QUOTED_IDENTIFIER_CASE
-# 11 => undef, # SQL_ROW_UPDATES
-# 39 => undef, # SQL_SCHEMA_TERM
-# 91 => undef, # SQL_SCHEMA_USAGE
-# 43 => undef, # SQL_SCROLL_CONCURRENCY
-# 44 => undef, # SQL_SCROLL_OPTIONS
-# 14 => undef, # SQL_SEARCH_PATTERN_ESCAPE
-# 13 => undef, # SQL_SERVER_NAME
-# 94 => undef, # SQL_SPECIAL_CHARACTERS
-# 155 => undef, # SQL_SQL92_DATETIME_FUNCTIONS
-# 156 => undef, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE
-# 157 => undef, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE
-# 158 => undef, # SQL_SQL92_GRANT
-# 159 => undef, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS
-# 160 => undef, # SQL_SQL92_PREDICATES
-# 161 => undef, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS
-# 162 => undef, # SQL_SQL92_REVOKE
-# 163 => undef, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR
-# 164 => undef, # SQL_SQL92_STRING_FUNCTIONS
-# 165 => undef, # SQL_SQL92_VALUE_EXPRESSIONS
-# 118 => undef, # SQL_SQL_CONFORMANCE
-# 166 => undef, # SQL_STANDARD_CLI_CONFORMANCE
-# 167 => undef, # SQL_STATIC_CURSOR_ATTRIBUTES1
-# 168 => undef, # SQL_STATIC_CURSOR_ATTRIBUTES2
-# 83 => undef, # SQL_STATIC_SENSITIVITY
-# 50 => undef, # SQL_STRING_FUNCTIONS
-# 95 => undef, # SQL_SUBQUERIES
-# 51 => undef, # SQL_SYSTEM_FUNCTIONS
-# 45 => undef, # SQL_TABLE_TERM
-# 109 => undef, # SQL_TIMEDATE_ADD_INTERVALS
-# 110 => undef, # SQL_TIMEDATE_DIFF_INTERVALS
-# 52 => undef, # SQL_TIMEDATE_FUNCTIONS
-# 46 => undef, # SQL_TRANSACTION_CAPABLE
-# 72 => undef, # SQL_TRANSACTION_ISOLATION_OPTION
-# 46 => undef, # SQL_TXN_CAPABLE
-# 72 => undef, # SQL_TXN_ISOLATION_OPTION
-# 96 => undef, # SQL_UNION
-# 96 => undef, # SQL_UNION_STATEMENT
- 47 => \&sql_user_name, # SQL_USER_NAME
-# 10000 => undef, # SQL_XOPEN_CLI_YEAR
- );
-
-1;
@@ -1,64 +0,0 @@
-#!/usr/bin/perl
-
-# Don't forget to add version and intellectual property control information.
-
-# The %type_info_all hash was automatically generated by
-# DBI::DBD::Metadata::write_typeinfo_pm v2.014214.
-
-package DBD::CSV::TypeInfo;
-
-{
- require Exporter;
- require DynaLoader;
- @ISA = qw(Exporter DynaLoader);
- @EXPORT = qw(type_info_all);
- use DBI qw(:sql_types);
-
- $type_info_all = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- FIXED_PREC_SCALE => 10,
- AUTO_UNIQUE_VALUE => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- SQL_DATA_TYPE => 15,
- SQL_DATETIME_SUB => 16,
- NUM_PREC_RADIX => 17,
- INTERVAL_PRECISION => 18,
- },
- [ "VARCHAR", SQL_VARCHAR, undef, "'", "'", undef, 0, 1, 1, 0, undef,
- undef, undef, 1, 999999, undef, undef, undef, undef,
- ],
- [ "CHAR", DBIstcf_DISCARD_STRING, undef, "'", "'", undef, 0, 1, 1, 0,
- undef, undef, undef, 1, 999999, undef, undef, undef, undef,
- ],
- [ "INTEGER", SQL_INTEGER, undef, "", "", undef, 0, 0, 1, 0, undef,
- undef, undef, 0, 0, undef, undef, undef, undef,
- ],
- [ "REAL", SQL_REAL, undef, "", "", undef,
- 0, 0, 1, 0, undef, undef,
- undef, 0, 0, undef, undef, undef,
- undef,
- ],
- [ "BLOB", SQL_LONGVARBINARY, undef, "'", "'", undef, 0, 1, 1, 0,
- undef, undef, undef, 1, 999999, undef, undef, undef, undef,
- ],
- [ "BLOB", SQL_LONGVARBINARY, undef, "'", "'", undef, 0, 1, 1, 0,
- undef, undef, undef, 1, 999999, undef, undef, undef, undef,
- ],
- [ "TEXT", SQL_LONGVARCHAR, undef, "'", "'", undef, 0, 1, 1, 0, undef,
- undef, undef, 1, 999999, undef, undef, undef, undef,
- ],
- ];
-
- 1;
- }
@@ -1,1207 +1,830 @@
-#!/usr/bin/perl
-#
-# DBD::CSV - A DBI driver for CSV and similar structured files
-#
-# This module is currently maintained by
-#
-# H.Merijn Brand <h.m.brand@xs4all.nl>
-#
-# See for full acknowledgements the last two pod sections in this file
-
-use strict;
-use warnings;
-
-require DynaLoader;
-require DBD::File;
-require IO::File;
-
-package DBD::CSV;
-
-use strict;
-
-use vars qw( @ISA $VERSION $ATTRIBUTION $drh $err $errstr $sqlstate );
-
-@ISA = qw( DBD::File );
-
-$VERSION = "0.43";
-$ATTRIBUTION = "DBD::CSV $DBD::CSV::VERSION by H.Merijn Brand";
-
-$err = 0; # holds error code for DBI::err
-$errstr = ""; # holds error string for DBI::errstr
-$sqlstate = ""; # holds error state for DBI::state
-$drh = undef; # holds driver handle once initialized
-
-sub CLONE # empty method: prevent warnings when threads are cloned
-{
- } # CLONE
-
-# --- DRIVER -------------------------------------------------------------------
-
-package DBD::CSV::dr;
-
-use strict;
-
-use Text::CSV_XS ();
-use vars qw( @ISA @CSV_TYPES );
-
-@CSV_TYPES = (
- Text::CSV_XS::IV (), # SQL_TINYINT
- Text::CSV_XS::IV (), # SQL_BIGINT
- Text::CSV_XS::PV (), # SQL_LONGVARBINARY
- Text::CSV_XS::PV (), # SQL_VARBINARY
- Text::CSV_XS::PV (), # SQL_BINARY
- Text::CSV_XS::PV (), # SQL_LONGVARCHAR
- Text::CSV_XS::PV (), # SQL_ALL_TYPES
- Text::CSV_XS::PV (), # SQL_CHAR
- Text::CSV_XS::NV (), # SQL_NUMERIC
- Text::CSV_XS::NV (), # SQL_DECIMAL
- Text::CSV_XS::IV (), # SQL_INTEGER
- Text::CSV_XS::IV (), # SQL_SMALLINT
- Text::CSV_XS::NV (), # SQL_FLOAT
- Text::CSV_XS::NV (), # SQL_REAL
- Text::CSV_XS::NV (), # SQL_DOUBLE
- );
-
-our @ISA = qw( DBD::File::dr );
-
-our $imp_data_size = 0;
-our $data_sources_attr = undef;
-
-sub connect
-{
- my ($drh, $dbname, $user, $auth, $attr) = @_;
- my $dbh = $drh->DBD::File::dr::connect ($dbname, $user, $auth, $attr);
- $dbh->{Active} = 1;
- $dbh;
- } # connect
-
-# --- DATABASE -----------------------------------------------------------------
-
-package DBD::CSV::db;
-
-use strict;
-
-our $imp_data_size = 0;
-our @ISA = qw( DBD::File::db );
-
-sub set_versions
-{
- my $this = shift;
- $this->{csv_version} = $DBD::CSV::VERSION;
- return $this->SUPER::set_versions ();
- } # set_versions
-
-my %csv_xs_attr;
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- my @xs_attr = qw(
- allow_loose_escapes allow_loose_quotes allow_whitespace
- always_quote auto_diag binary blank_is_undef empty_is_undef
- eol escape_char keep_meta_info quote_char quote_null
- quote_space sep_char types verbatim );
- @csv_xs_attr{@xs_attr} = ();
-
- $dbh->{csv_xs_valid_attrs} = [ @xs_attr ];
-
- $dbh->{csv_valid_attrs} = { map {("csv_$_" => 1 )} @xs_attr, qw(
-
- class tables in csv_in out csv_out skip_first_row
-
- null sep quote escape
- )};
-
- $dbh->{csv_readonly_attrs} = { };
-
- $dbh->{csv_meta} = "csv_tables";
-
- return $dbh->SUPER::init_valid_attributes ();
- } # init_valid_attributes
-
-sub get_csv_versions
-{
- my ($dbh, $table) = @_;
- $table ||= "";
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- my $meta;
- $table and (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
- unless ($meta) {
- $meta = {};
- $class->bootstrap_table_meta ($dbh, $meta, $table);
- }
- my $dvsn = eval { $meta->{csv_class}->VERSION (); };
- my $dtype = $meta->{csv_class};
- $dvsn and $dtype .= " ($dvsn)";
- return sprintf "%s using %s", $dbh->{csv_version}, $dtype;
- } # get_csv_versions
-
-sub get_info
-{
- my ($dbh, $info_type) = @_;
- require DBD::CSV::GetInfo;
- my $v = $DBD::CSV::GetInfo::info{int ($info_type)};
- ref $v eq "CODE" and $v = $v->($dbh);
- return $v;
- } # get_info
-
-sub type_info_all
-{
- my $dbh = shift;
- require DBD::CSV::TypeInfo;
- return [@$DBD::CSV::TypeInfo::type_info_all];
- } # type_info_all
-
-# --- STATEMENT ----------------------------------------------------------------
-
-package DBD::CSV::st;
-
-use strict;
-
-our $imp_data_size = 0;
-our @ISA = qw(DBD::File::st);
-
-package DBD::CSV::Statement;
-
-use strict;
-use Carp;
-
-our @ISA = qw(DBD::File::Statement);
-
-package DBD::CSV::Table;
-
-use strict;
-use Carp;
-
-our @ISA = qw(DBD::File::Table);
-
-sub bootstrap_table_meta
-{
- my ($self, $dbh, $meta, $table) = @_;
- $meta->{csv_class} ||= $dbh->{csv_class} || "Text::CSV_XS";
- $meta->{csv_eol} ||= $dbh->{csv_eol} || "\r\n";
- exists $meta->{csv_skip_first_row} or
- $meta->{csv_skip_first_row} = $dbh->{csv_skip_first_row};
- $self->SUPER::bootstrap_table_meta ($dbh, $meta, $table);
- } # bootstrap_table_meta
-
-sub init_table_meta
-{
- my ($self, $dbh, $meta, $table) = @_;
-
- $self->SUPER::init_table_meta ($dbh, $table, $meta);
-
- my $csv_in = $meta->{csv_in} || $dbh->{csv_csv_in};
- unless ($csv_in) {
- my %opts = ( binary => 1, auto_diag => 1 );
-
- # Allow specific Text::CSV_XS options
- foreach my $attr (@{$dbh->{csv_xs_valid_attrs}}) {
- $attr eq "eol" and next; # Handles below
- exists $dbh->{"csv_$attr"} and $opts{$attr} = $dbh->{"csv_$attr"};
- }
- $dbh->{csv_null} || $meta->{csv_null} and
- $opts{blank_is_undef} = $opts{always_quote} = 1;
-
- my $class = $meta->{csv_class};
- my $eol = $meta->{csv_eol};
- $eol =~ m/^\A(?:[\r\n]|\r\n)\Z/ or $opts{eol} = $eol;
- for ([ "sep", ',' ],
- [ "quote", '"' ],
- [ "escape", '"' ],
- ) {
- my ($attr, $def) = ($_->[0]."_char", $_->[1]);
- $opts{$attr} =
- exists $meta->{$attr} ? $meta->{$attr} :
- exists $dbh->{"csv_$attr"} ? $dbh->{"csv_$attr"} : $def;
- }
- $meta->{csv_in} = $class->new (\%opts) or
- $class->error_diag;
- $opts{eol} = $eol;
- $meta->{csv_out} = $class->new (\%opts) or
- $class->error_diag;
- }
- } # init_table_meta
-
-my %compat_map = map { $_ => "csv_$_" }
- qw( class eof eol quote_char sep_char escape_char );
-
-__PACKAGE__->register_compat_map (\%compat_map);
-
-sub table_meta_attr_changed
-{
- my ($class, $meta, $attr, $value) = @_;
-
- (my $csv_attr = $attr) =~ s/^csv_//;
- if (exists $csv_xs_attr{$csv_attr}) {
- for ("csv_in", "csv_out") {
- exists $meta->{$_} && exists $meta->{$_}{$csv_attr} and
- $meta->{$_}{$csv_attr} = $value;
- }
- }
-
- $class->SUPER::table_meta_attr_changed ($meta, $attr, $value);
- } # table_meta_attr_changed
-
-sub open_data {
- my ($self, $meta, $attrs, $flags) = @_;
- $self->SUPER::open_file ($meta, $attrs, $flags);
-
- if ($meta && $meta->{fh}) {
- $attrs->{csv_csv_in} = $meta->{csv_in};
- $attrs->{csv_csv_out} = $meta->{csv_out};
- if (my $types = $meta->{types}) {
- # XXX $meta->{types} is nowhere assigned and should better $meta->{csv_types}
- # The 'types' array contains DBI types, but we need types
- # suitable for Text::CSV_XS.
- my $t = [];
- for (@{$types}) {
- $_ = $_
- ? $DBD::CSV::dr::CSV_TYPES[$_ + 6] || Text::CSV_XS::PV ()
- : Text::CSV_XS::PV ();
- push @$t, $_;
- }
- $meta->{types} = $t;
- }
- if (!$flags->{createMode}) {
- my $array;
- my $skipRows = defined $meta->{skip_rows}
- ? $meta->{skip_rows}
- : defined $meta->{csv_skip_first_row}
- ? 1
- : exists $meta->{col_names} ? 0 : 1;
- defined $meta->{skip_rows} or
- $meta->{skip_rows} = $skipRows;
- if ($skipRows--) {
- $array = $attrs->{csv_csv_in}->getline ($meta->{fh}) or
- croak "Missing first row due to ".$attrs->{csv_csv_in}->error_diag;
- unless ($meta->{raw_header}) {
- s/\W/_/g for @$array;
- }
- defined $meta->{col_names} or
- $meta->{col_names} = $array;
- while ($skipRows--) {
- $attrs->{csv_csv_in}->getline ($meta->{fh});
- }
- }
- # lockMode is set 1 for DELETE, INSERT or UPDATE
- # no other case need seeking
- $flags->{lockMode} and # $meta->{fh}->can ("tell") and
- $meta->{first_row_pos} = $meta->{fh}->tell ();
- exists $meta->{col_names} and
- $array = $meta->{col_names};
- if (!$meta->{col_names} || !@{$meta->{col_names}}) {
- # No column names given; fetch first row and create default
- # names.
- my $ar = $meta->{cached_row} =
- $attrs->{csv_csv_in}->getline ($meta->{fh});
- $array = $meta->{col_names};
- push @$array, map { "col$_" } 0 .. $#$ar;
- }
- }
- }
- } # open_file
-
-no warnings 'once';
-$DBI::VERSION < 1.623 and
- *open_file = \&open_data;
-use warnings;
-
-sub _csv_diag
-{
- my @diag = $_[0]->error_diag;
- for (2, 3) {
- defined $diag[$_] or $diag[$_] = "?";
- }
- return @diag;
- } # _csv_diag
-
-sub fetch_row
-{
- my ($self, $data) = @_;
-
- exists $self->{cached_row} and
- return $self->{row} = delete $self->{cached_row};
-
- my $tbl = $self->{meta};
-
- my $csv = $self->{csv_csv_in} or
- return do { $data->set_err ($DBI::stderr, "Fetch from undefined handle"); undef };
-
- my $fields;
- eval { $fields = $csv->getline ($tbl->{fh}) };
- unless ($fields) {
- $csv->eof and return;
-
- my @diag = _csv_diag ($csv);
- my $file = $tbl->{f_fqfn};
- croak "Error $diag[0] while reading file $file: $diag[1] \@ line $diag[3] pos $diag[2]";
- }
- @$fields < @{$tbl->{col_names}} and
- push @$fields, (undef) x (@{$tbl->{col_names}} - @$fields);
- $self->{row} = (@$fields ? $fields : undef);
- } # fetch_row
-
-sub push_row
-{
- my ($self, $data, $fields) = @_;
- my $tbl = $self->{meta};
- my $csv = $self->{csv_csv_out};
- my $fh = $tbl->{fh};
-
- unless ($csv->print ($fh, $fields)) {
- my @diag = _csv_diag ($csv);
- my $file = $tbl->{f_fqfn};
- return do { $data->set_err ($DBI::stderr, "Error $diag[0] while writing file $file: $diag[1] \@ line $diag[3] pos $diag[2]"); undef };
- }
- 1;
- } # push_row
-
-no warnings 'once';
-*push_names = \&push_row;
-use warnings;
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::CSV - DBI driver for CSV files
-
-=head1 SYNOPSIS
-
- use DBI;
- # See "Creating database handle" below
- $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
- f_ext => ".csv/r",
- RaiseError => 1,
- }) or die "Cannot connect: $DBI::errstr";
-
- # Simple statements
- $dbh->do ("CREATE TABLE foo (id INTEGER, name CHAR (10))");
-
- # Selecting
- my $sth = $dbh->prepare ("select * from foo");
- $sth->execute;
- $sth->bind_columns (\my ($id, $name));
- while ($sth->fetch) {
- print "id: $id, name: $ame\n";
- }
-
- # Updates
- my $sth = $dbh->prepare ("UPDATE foo SET name = ? WHERE id = ?");
- $sth->execute ("DBI rocks!", 1);
- $sth->finish;
-
- $dbh->disconnect;
-
-=head1 DESCRIPTION
-
-The DBD::CSV module is yet another driver for the DBI (Database independent
-interface for Perl). This one is based on the SQL "engine" SQL::Statement
-and the abstract DBI driver DBD::File and implements access to so-called
-CSV files (Comma Separated Values). Such files are often used for exporting
-MS Access and MS Excel data.
-
-See L<DBI> for details on DBI, L<SQL::Statement> for details on
-SQL::Statement and L<DBD::File> for details on the base class DBD::File.
-
-=head2 Prerequisites
-
-The only system dependent feature that DBD::File uses, is the C<flock ()>
-function. Thus the module should run (in theory) on any system with
-a working C<flock ()>, in particular on all Unix machines and on Windows
-NT. Under Windows 95 and MacOS the use of C<flock ()> is disabled, thus
-the module should still be usable.
-
-Unlike other DBI drivers, you don't need an external SQL engine or a
-running server. All you need are the following Perl modules, available
-from any CPAN mirror, for example
-
- http://search.cpan.org/
-
-=over 4
-
-=item DBI
-X<DBI>
-
-A recent version of the L<DBI> (Database independent interface for Perl).
-See below why.
-
-=item DBD::File
-X<DBD::File>
-
-This is the base class for DBD::CSV, and it is part of the DBI
-distribution. As DBD::CSV requires a matching version of L<DBD::File>
-which is (partly) developed by the same team that maintains
-DBD::CSV. See META.json or Makefile.PL for the minimum versions.
-
-=item SQL::Statement
-X<SQL::Statement>
-
-A simple SQL engine. This module defines all of the SQL syntax for
-DBD::CSV, new SQL support is added with each release so you should
-look for updates to SQL::Statement regularly.
-
-It is possible to run C<DBD::CSV> without this module if you define
-the environment variable C<$DBI_SQL_NANO> to 1. This will reduce the
-SQL support a lot though. See L<DBI::SQL::Nano> for more details. Note
-that the test suite does only test in this mode in the development
-environment.
-
-=item Text::CSV_XS
-X<Text::CSV_XS>
-
-This module is used to read and write rows in a CSV file.
-
-=back
-
-=head2 Installation
-
-Installing this module (and the prerequisites from above) is quite simple.
-The simplest way is to install the bundle:
-
- $ cpan Bundle::CSV
-
-Alternatively, you can name them all
-
- $ cpan Text::CSV_XS DBI DBD::CSV
-
-or even trust C<cpan> to resolve all dependencies for you:
-
- $ cpan DBD::CSV
-
-If you cannot, for whatever reason, use cpan, fetch all modules from
-CPAN, and build with a sequence like:
-
- gzip -d < DBD-CSV-0.40.tgz | tar xf -
-
-(this is for Unix users, Windows users would prefer WinZip or something
-similar) and then enter the following:
-
- cd DBD-CSV-0.40
- perl Makefile.PL
- make test
-
-If any tests fail, let us know. Otherwise go on with
-
- make install UNINST=1
-
-Note that you almost definitely need root or administrator permissions.
-If you don't have them, read the ExtUtils::MakeMaker man page for details
-on installing in your own directories. L<ExtUtils::MakeMaker>.
-
-=head2 Supported SQL Syntax
-
-All SQL processing for DBD::CSV is done by SQL::Statement. See
-L<SQL::Statement> for more specific information about its feature set.
-Features include joins, aliases, built-in and user-defined functions,
-and more. See L<SQL::Statement::Syntax> for a description of the SQL
-syntax supported in DBD::CSV.
-
-Table- and column-names are case insensitive unless quoted. Column names
-will be sanitized unless L</raw_header> is true;
-
-=head1 Using DBD::CSV with DBI
-
-For most things, DBD-CSV operates the same as any DBI driver.
-See L<DBI> for detailed usage.
-
-=head2 Creating a database handle (connect)
-
-Creating a database handle usually implies connecting to a database server.
-Thus this command reads
-
- use DBI;
- my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => "/home/user/folder",
- });
-
-The directory tells the driver where it should create or open tables (a.k.a.
-files). It defaults to the current directory, so the following are equivalent:
-
- $dbh = DBI->connect ("dbi:CSV:");
- $dbh = DBI->connect ("dbi:CSV:", undef, undef, { f_dir => "." });
- $dbh = DBI->connect ("dbi:CSV:f_dir=.");
-
-We were told, that VMS might - for whatever reason - require:
-
- $dbh = DBI->connect ("dbi:CSV:f_dir=");
-
-The preferred way of passing the arguments is by driver attributes:
-
- # specify most possible flags via driver flags
- $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
- f_schema => undef,
- f_dir => "data",
- f_dir_search => [],
- f_ext => ".csv/r",
- f_lock => 2,
- f_encoding => "utf8",
-
- csv_eol => "\r\n",
- csv_sep_char => ",",
- csv_quote_char => '"',
- csv_escape_char => '"',
- csv_class => "Text::CSV_XS",
- csv_null => 1,
- csv_tables => {
- info => { f_file => "info.csv" }
- },
-
- RaiseError => 1,
- PrintError => 1,
- FetchHashKeyName => "NAME_lc",
- }) or die $DBI::errstr;
-
-but you may set these attributes in the DSN as well, separated by semicolons.
-Pay attention to the semi-colon for C<csv_sep_char> (as seen in many CSV
-exports from MS Excel) is being escaped in below example, as is would
-otherwise be seen as attribute separator:
-
- $dbh = DBI->connect (
- "dbi:CSV:f_dir=$ENV{HOME}/csvdb;f_ext=.csv;f_lock=2;" .
- "f_encoding=utf8;csv_eol=\n;csv_sep_char=\\;;" .
- "csv_quote_char=\";csv_escape_char=\\;csv_class=Text::CSV_XS;" .
- "csv_null=1") or die $DBI::errstr;
-
-Using attributes in the DSN is easier to use when the DSN is derived from an
-outside source (environment variable, database entry, or configure file),
-whereas specifying entries in the attribute hash is easier to read and to
-maintain.
-
-=head2 Creating and dropping tables
-
-You can create and drop tables with commands like the following:
-
- $dbh->do ("CREATE TABLE $table (id INTEGER, name CHAR (64))");
- $dbh->do ("DROP TABLE $table");
-
-Note that currently only the column names will be stored and no other data.
-Thus all other information including column type (INTEGER or CHAR (x), for
-example), column attributes (NOT NULL, PRIMARY KEY, ...) will silently be
-discarded. This may change in a later release.
-
-A drop just removes the file without any warning.
-
-See L<DBI> for more details.
-
-Table names cannot be arbitrary, due to restrictions of the SQL syntax.
-I recommend that table names are valid SQL identifiers: The first
-character is alphabetic, followed by an arbitrary number of alphanumeric
-characters. If you want to use other files, the file names must start
-with "/", "./" or "../" and they must not contain white space.
-
-=head2 Inserting, fetching and modifying data
-
-The following examples insert some data in a table and fetch it back:
-First, an example where the column data is concatenated in the SQL string:
-
- $dbh->do ("INSERT INTO $table VALUES (1, ".
- $dbh->quote ("foobar") . ")");
-
-Note the use of the quote method for escaping the word "foobar". Any
-string must be escaped, even if it does not contain binary data.
-
-Next, an example using parameters:
-
- $dbh->do ("INSERT INTO $table VALUES (?, ?)", undef, 2,
- "It's a string!");
-
-Note that you don't need to quote column data passed as parameters.
-This version is particularly well designed for
-loops. Whenever performance is an issue, I recommend using this method.
-
-You might wonder about the C<undef>. Don't wonder, just take it as it
-is. :-) It's an attribute argument that I have never used and will be
-passed to the prepare method as the second argument.
-
-To retrieve data, you can use the following:
-
- my $query = "SELECT * FROM $table WHERE id > 1 ORDER BY id";
- my $sth = $dbh->prepare ($query);
- $sth->execute ();
- while (my $row = $sth->fetchrow_hashref) {
- print "Found result row: id = ", $row->{id},
- ", name = ", $row->{name};
- }
- $sth->finish ();
-
-Again, column binding works: The same example again.
-
- my $sth = $dbh->prepare (qq;
- SELECT * FROM $table WHERE id > 1 ORDER BY id;
- ;);
- $sth->execute;
- my ($id, $name);
- $sth->bind_columns (undef, \$id, \$name);
- while ($sth->fetch) {
- print "Found result row: id = $id, name = $name\n";
- }
- $sth->finish;
-
-Of course you can even use input parameters. Here's the same example
-for the third time:
-
- my $sth = $dbh->prepare ("SELECT * FROM $table WHERE id = ?");
- $sth->bind_columns (undef, \$id, \$name);
- for (my $i = 1; $i <= 2; $i++) {
- $sth->execute ($id);
- if ($sth->fetch) {
- print "Found result row: id = $id, name = $name\n";
- }
- $sth->finish;
- }
-
-See L<DBI> for details on these methods. See L<SQL::Statement> for
-details on the WHERE clause.
-
-Data rows are modified with the UPDATE statement:
-
- $dbh->do ("UPDATE $table SET id = 3 WHERE id = 1");
-
-Likewise you use the DELETE statement for removing rows:
-
- $dbh->do ("DELETE FROM $table WHERE id > 1");
-
-=head2 Error handling
-
-In the above examples we have never cared about return codes. Of
-course, this is not recommended. Instead we should have written (for
-example):
-
- my $sth = $dbh->prepare ("SELECT * FROM $table WHERE id = ?") or
- die "prepare: " . $dbh->errstr ();
- $sth->bind_columns (undef, \$id, \$name) or
- die "bind_columns: " . $dbh->errstr ();
- for (my $i = 1; $i <= 2; $i++) {
- $sth->execute ($id) or
- die "execute: " . $dbh->errstr ();
- $sth->fetch and
- print "Found result row: id = $id, name = $name\n";
- }
- $sth->finish ($id) or die "finish: " . $dbh->errstr ();
-
-Obviously this is tedious. Fortunately we have DBI's I<RaiseError>
-attribute:
-
- $dbh->{RaiseError} = 1;
- $@ = "";
- eval {
- my $sth = $dbh->prepare ("SELECT * FROM $table WHERE id = ?");
- $sth->bind_columns (undef, \$id, \$name);
- for (my $i = 1; $i <= 2; $i++) {
- $sth->execute ($id);
- $sth->fetch and
- print "Found result row: id = $id, name = $name\n";
- }
- $sth->finish ($id);
- };
- $@ and die "SQL database error: $@";
-
-This is not only shorter, it even works when using DBI methods within
-subroutines.
-
-=head1 DBI database handle attributes
-
-=head2 Metadata
-
-The following attributes are handled by DBI itself and not by DBD::File,
-thus they all work as expected:
-
- Active
- ActiveKids
- CachedKids
- CompatMode (Not used)
- InactiveDestroy
- Kids
- PrintError
- RaiseError
- Warn (Not used)
-
-The following DBI attributes are handled by DBD::File:
-
-=over 4
-
-=item AutoCommit
-X<AutoCommit>
-
-Always on
-
-=item ChopBlanks
-X<ChopBlanks>
-
-Works
-
-=item NUM_OF_FIELDS
-X<NUM_OF_FIELDS>
-
-Valid after C<$sth-E<gt>execute>
-
-=item NUM_OF_PARAMS
-X<NUM_OF_PARAMS>
-
-Valid after C<$sth-E<gt>prepare>
-
-=item NAME
-X<NAME>
-
-=item NAME_lc
-X<NAME_lc>
-
-=item NAME_uc
-X<NAME_uc>
-
-Valid after C<$sth-E<gt>execute>; undef for Non-Select statements.
-
-=item NULLABLE
-X<NULLABLE>
-
-Not really working. Always returns an array ref of one's, as DBD::CSV
-does not verify input data. Valid after C<$sth-E<gt>execute>; undef for
-non-Select statements.
-
-=back
-
-These attributes and methods are not supported:
-
- bind_param_inout
- CursorName
- LongReadLen
- LongTruncOk
-
-=head1 DBD-CSV specific database handle attributes
-
-In addition to the DBI attributes, you can use the following dbh
-attributes:
-
-=head2 DBD::File attributes
-
-=over 4
-
-=item f_dir
-X<f_dir>
-
-This attribute is used for setting the directory where CSV files are
-opened. Usually you set it in the dbh and it defaults to the current
-directory ("."). However, it may be overridden in statement handles.
-
-=item f_dir_search
-X<f_dir_search>
-
-This attribute optionally defines a list of extra directories to search
-when opening existing tables. It should be an anonymous list or an array
-reference listing all folders where tables could be found.
-
- my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => "data",
- f_dir_search => [ "ref/data", "ref/old" ],
- f_ext => ".csv/r",
- }) or die $DBI::errstr;
-
-=item f_ext
-X<f_ext>
-
-This attribute is used for setting the file extension.
-
-=item f_schema
-X<f_schema>
-
-This attribute allows you to set the database schema name. The default is
-to use the owner of C<f_dir>. C<undef> is allowed, but not in the DSN part.
-
- my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_schema => undef,
- f_dir => "data",
- f_ext => ".csv/r",
- }) or die $DBI::errstr;
-
-=item f_encoding
-X<f_encoding>
-
-This attribute allows you to set the encoding of the data. With CSV, it is not
-possible to set (and remember) the encoding on a column basis, but DBD::File
-now allows the encoding to be set on the underlying file. If this attribute is
-not set, or undef is passed, the file will be seen as binary.
-
-=item f_lock
-X<f_lock>
-
-With this attribute you can specify a locking mode to be used (if locking is
-supported at all) for opening tables. By default, tables are opened with a
-shared lock for reading, and with an exclusive lock for writing. The
-supported modes are:
-
-=over 2
-
-=item 0
-X<0>
-
-Force no locking at all.
-
-=item 1
-X<1>
-
-Only shared locks will be used.
-
-=item 2
-X<2>
-
-Only exclusive locks will be used.
-
-=back
-
-=back
-
-But see L<DBD::File/"KNOWN BUGS">.
-
-=head2 DBD::CSV specific attributes
-
-=over 4
-
-=item csv_class
-
-The attribute I<csv_class> controls the CSV parsing engine. This defaults
-to C<Text::CSV_XS>, but C<Text::CSV> can be used in some cases, too.
-Please be aware that C<Text::CSV> does not care about any edge case as
-C<Text::CSV_XS> does and that C<Text::CSV> is probably about 100 times
-slower than C<Text::CSV_XS>.
-
-=back
-
-=head2 Text::CSV_XS specific attributes
-
-=over 4
-
-=item csv_eol
-X<csv_eol>
-
-=item csv_sep_char
-X<csv_sep_char>
-
-=item csv_quote_char
-X<csv_quote_char>
-
-=item csv_escape_char
-X<csv_escape_char>
-
-=item csv_csv
-X<csv_csv>
-
-The attributes I<csv_eol>, I<csv_sep_char>, I<csv_quote_char> and
-I<csv_escape_char> are corresponding to the respective attributes of the
-I<csv_class> (usually Text::CSV_CS) object. You may want to set these
-attributes if you have unusual CSV files like F</etc/passwd> or MS Excel
-generated CSV files with a semicolon as separator. Defaults are
-"\015\012", ';', '"' and '"', respectively.
-
-The I<csv_eol> attribute defines the end-of-line pattern, which is better
-known as a record separator pattern since it separates records. The default
-is windows-style end-of-lines "\015\012" for output (writing) and unset for
-input (reading), so if on unix you may want to set this to newline ("\n")
-like this:
-
- $dbh->{csv_eol} = "\n";
-
-It is also possible to use multi-character patterns as record separators.
-For example this file uses newlines as field separators (sep_char) and
-the pattern "\n__ENDREC__\n" as the record separators (eol):
-
- name
- city
- __ENDREC__
- joe
- seattle
- __ENDREC__
- sue
- portland
- __ENDREC__
-
-To handle this file, you'd do this:
-
- $dbh->{eol} = "\n__ENDREC__\n" ,
- $dbh->{sep_char} = "\n"
-
-The attributes are used to create an instance of the class I<csv_class>,
-by default Text::CSV_XS. Alternatively you may pass an instance as
-I<csv_csv>, the latter takes precedence. Note that the I<binary>
-attribute I<must> be set to a true value in that case.
-
-Additionally you may overwrite these attributes on a per-table base in
-the I<csv_tables> attribute.
-
-=item csv_null
-X<csv_null>
-
-With this option set, all new statement handles will set C<always_quote>
-and C<blank_is_undef> in the CSV parser and writer, so it knows how to
-distinguish between the empty string and C<undef> or C<NULL>. You cannot
-reset it with a false value. You can pass it to connect, or set it later:
-
- $dbh = DBI->connect ("dbi:CSV:", "", "", { csv_null => 1 });
-
- $dbh->{csv_null} = 1;
-
-=item csv_tables
-X<csv_tables>
-
-This hash ref is used for storing table dependent metadata. For any
-table it contains an element with the table name as key and another
-hash ref with the following attributes:
-
-=item csv_*
-X<csv_*>
-
-All other attributes that start with C<csv_> and are not described above
-will be passed to C<Text::CSV_XS> (without the C<csv_> prefix). These
-extra options are only likely to be useful for reading (select)
-handles. Examples:
-
- $dbh->{csv_allow_whitespace} = 1;
- $dbh->{csv_allow_loose_quotes} = 1;
- $dbh->{csv_allow_loose_escapes} = 1;
-
-See the C<Text::CSV_XS> documentation for the full list and the documentation.
-
-=back
-
-=head2 Driver specific attributes
-
-=over 4
-
-=item f_file
-X<f_file>
-
-The name of the file used for the table; defaults to
-
- "$dbh->{f_dir}/$table"
-
-=item eol
-X<eol>
-
-=item sep_char
-X<sep_char>
-
-=item quote_char
-X<quote_char>
-
-=item escape_char
-X<escape_char>
-
-=item class
-X<class>
-
-=item csv
-X<csv>
-
-These correspond to the attributes I<csv_eol>, I<csv_sep_char>,
-I<csv_quote_char>, I<csv_escape_char>, I<csv_class> and I<csv_csv>.
-The difference is that they work on a per-table basis.
-
-=item col_names
-X<col_names>
-
-=item skip_first_row
-X<skip_first_row>
-
-By default DBD::CSV assumes that column names are stored in the first row
-of the CSV file and sanitizes them (see C<raw_header> below). If this is
-not the case, you can supply an array ref of table names with the
-I<col_names> attribute. In that case the attribute I<skip_first_row> will
-be set to FALSE.
-
-If you supply an empty array ref, the driver will read the first row
-for you, count the number of columns and create column names like
-C<col0>, C<col1>, ...
-
-=item raw_header
-X<raw_header>
-
-Due to the SQL standard, field names cannot contain special characters
-like a dot (C<.>) or a space (C< >) unless the column names are quoted.
-Following the approach of mdb_tools, all these tokens are translated to an
-underscore (C<_>) when reading the first line of the CSV file, so all field
-names are 'sanitized'. If you do not want this to happen, set C<raw_header>
-to a true value and the entries in the first line of the CSV data will be
-used verbatim for column headers and field names. DBD::CSV cannot guarantee
-that any part in the toolchain will work if field names have those characters,
-and the chances are high that the SQL statements will fail.
-
-=back
-
-It's strongly recommended to check the attributes supported by
-L<DBD::File/Metadata>.
-
-Example: Suppose you want to use /etc/passwd as a CSV file. :-)
-There simplest way is:
-
- use DBI;
- my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
- f_dir => "/etc",
- csv_sep_char => ":",
- csv_quote_char => undef,
- csv_escape_char => undef,
- });
- $dbh->{csv_tables}{passwd} = {
- col_names => [qw( login password uid gid realname
- directory shell )];
- };
- $sth = $dbh->prepare ("SELECT * FROM passwd");
-
-Another possibility where you leave all the defaults as they are and
-override them on a per table basis:
-
- require DBI;
- my $dbh = DBI->connect ("dbi:CSV:");
- $dbh->{csv_tables}{passwd} = {
- eol => "\n",
- sep_char => ":",
- quote_char => undef,
- escape_char => undef,
- f_file => "/etc/passwd",
- col_names => [qw( login password uid gid
- realname directory shell )],
- };
- $sth = $dbh->prepare ("SELECT * FROM passwd");
-
-=head2 Driver private methods
-
-These methods are inherited from DBD::File:
-
-=over 4
-
-=item data_sources
-X<data_sources>
-
-The C<data_sources> method returns a list of sub-directories of the current
-directory in the form "dbi:CSV:directory=$dirname".
-
-If you want to read the sub-directories of another directory, use
-
- my $drh = DBI->install_driver ("CSV");
- my @list = $drh->data_sources (f_dir => "/usr/local/csv_data");
-
-=item list_tables
-X<list_tables>
-
-This method returns a list of file-names inside $dbh->{directory}.
-Example:
-
- my $dbh = DBI->connect ("dbi:CSV:directory=/usr/local/csv_data");
- my @list = $dbh->func ("list_tables");
-
-Note that the list includes all files contained in the directory, even
-those that have non-valid table names, from the view of SQL. See
-L<Creating and dropping tables> above.
-
-=back
-
-=head1 KNOWN ISSUES
-
-=over 4
-
-=item *
-
-The module is using flock () internally. However, this function is not
-available on some platforms. Use of flock () is disabled on MacOS and
-Windows 95: There's no locking at all (perhaps not so important on
-these operating systems, as they are for single users anyways).
-
-=back
-
-=head1 TODO
-
-=over 4
-
-=item Tests
-X<Tests>
-
-Aim for a full 100% code coverage
-
- - eol Make tests for different record separators.
- - csv_xs Test with a variety of combinations for
- sep_char, quote_char, and escape_char testing
- - quoting $dbh->do ("drop table $_") for DBI-tables ();
- - errors Make sure that all documented exceptions are tested.
- . write to write-protected file
- . read from badly formatted csv
- . pass bad arguments to csv parser while fetching
-
-Add tests that specifically test DBD::File functionality where
-that is useful.
-
-=item RT
-X<RT>
-
-Attack all open DBD::CSV bugs in RT
-
-=item CPAN::Forum
-X<CPAN::Forum>
-
-Attack all items in http://www.cpanforum.com/dist/DBD-CSV
-
-=item Documentation
-X<Documentation>
-
-Expand on error-handling, and document all possible errors.
-Use Text::CSV_XS::error_diag () wherever possible.
-
-=item Debugging
-X<Debugging>
-
-Implement and document dbd_verbose.
-
-=item Data dictionary
-X<Data dictionary>
-
-Investigate the possibility to store the data dictionary in a file like
-.sys$columns that can store the field attributes (type, key, nullable).
-
-=item Examples
-X<Examples>
-
-Make more real-life examples from the docs in examples/
-
-=back
-
-=head1 SEE ALSO
-
-L<DBI>, L<Text::CSV_XS>, L<SQL::Statement>, L<DBI::SQL::Nano>
-
-For help on the use of DBD::CSV, see the DBI users mailing list:
-
- http://lists.cpan.org/showlist.cgi?name=dbi-users
-
-For general information on DBI see
-
- http://dbi.perl.org/ and http://faq.dbi-support.com/
-
-=head1 AUTHORS and MAINTAINERS
-
-This module is currently maintained by
-
- H.Merijn Brand <h.m.brand@xs4all.nl>
-
-in close cooperation with and help from
-
- Jens Rehsack <sno@NetBSD.org>
-
-The original author is Jochen Wiedmann.
-Previous maintainer was Jeff Zucker
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2009-2014 by H.Merijn Brand
-Copyright (C) 2004-2009 by Jeff Zucker
-Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may distribute this module under the terms of either the GNU
-General Public License or the Artistic License, as specified in
-the Perl README file.
-
-=cut
+# -*- perl -*-
+#
+# DBD::CSV - A DBI driver for CSV and similar structured files
+#
+# This module is currently maintained by
+#
+# Jeff Zucker
+# <jeff@vpservices.com>
+#
+# The original author is Jochen Wiedmann.
+#
+# Copyright (C) 1998 by Jochen Wiedmann
+#
+# All rights reserved.
+#
+# You may distribute this module under the terms of either the GNU
+# General Public License or the Artistic License, as specified in
+# the Perl README file.
+#
+
+require 5.004;
+use strict;
+
+
+require DynaLoader;
+require DBD::File;
+require IO::File;
+
+
+package DBD::CSV;
+
+use vars qw(@ISA $VERSION $drh $err $errstr $sqlstate);
+
+@ISA = qw(DBD::File);
+
+$VERSION = '0.22';
+
+$err = 0; # holds error code for DBI::err
+$errstr = ""; # holds error string for DBI::errstr
+$sqlstate = ""; # holds error state for DBI::state
+$drh = undef; # holds driver handle once initialised
+
+package DBD::CSV::dr; # ====== DRIVER ======
+
+use Text::CSV_XS();
+use vars qw(@ISA @CSV_TYPES);
+
+@CSV_TYPES = (
+ Text::CSV_XS::IV(), # SQL_TINYINT
+ Text::CSV_XS::IV(), # SQL_BIGINT
+ Text::CSV_XS::PV(), # SQL_LONGVARBINARY
+ Text::CSV_XS::PV(), # SQL_VARBINARY
+ Text::CSV_XS::PV(), # SQL_BINARY
+ Text::CSV_XS::PV(), # SQL_LONGVARCHAR
+ Text::CSV_XS::PV(), # SQL_ALL_TYPES
+ Text::CSV_XS::PV(), # SQL_CHAR
+ Text::CSV_XS::NV(), # SQL_NUMERIC
+ Text::CSV_XS::NV(), # SQL_DECIMAL
+ Text::CSV_XS::IV(), # SQL_INTEGER
+ Text::CSV_XS::IV(), # SQL_SMALLINT
+ Text::CSV_XS::NV(), # SQL_FLOAT
+ Text::CSV_XS::NV(), # SQL_REAL
+ Text::CSV_XS::NV(), # SQL_DOUBLE
+);
+
+@DBD::CSV::dr::ISA = qw(DBD::File::dr);
+
+$DBD::CSV::dr::imp_data_size = 0;
+$DBD::CSV::dr::data_sources_attr = undef;
+
+sub connect ($$;$$$) {
+ my($drh, $dbname, $user, $auth, $attr) = @_;
+ my $dbh = $drh->DBD::File::dr::connect($dbname, $user, $auth, $attr);
+ $dbh->{'csv_tables'} ||= {};
+ $dbh->{Active} = 1;
+ $dbh;
+}
+
+package DBD::CSV::db; # ====== DATABASE ======
+
+$DBD::CSV::db::imp_data_size = 0;
+
+@DBD::CSV::db::ISA = qw(DBD::File::db);
+
+sub csv_cache_sql_parser_object {
+ my $dbh = shift;
+ my $parser = {
+ dialect => 'CSV',
+ RaiseError => $dbh->FETCH('RaiseError'),
+ PrintError => $dbh->FETCH('PrintError'),
+ };
+ my $sql_flags = $dbh->FETCH('csv_sql') || {};
+ %$parser = (%$parser,%$sql_flags);
+ $parser = SQL::Parser->new($parser->{dialect},$parser);
+ $dbh->{csv_sql_parser_object} = $parser;
+ return $parser;
+}
+
+package DBD::CSV::st; # ====== STATEMENT ======
+
+$DBD::CSV::st::imp_data_size = 0;
+
+@DBD::CSV::st::ISA = qw(DBD::File::st);
+
+
+package DBD::CSV::Statement;
+
+@DBD::CSV::Statement::ISA = qw(DBD::File::Statement);
+
+sub open_table ($$$$$) {
+ my($self, $data, $table, $createMode, $lockMode) = @_;
+ my $dbh = $data->{Database};
+ my $tables = $dbh->{csv_tables};
+ if (!exists($tables->{$table})) {
+ $tables->{$table} = {};
+ }
+ my $meta = $tables->{$table} || {};
+ my $csv = $meta->{csv} || $dbh->{csv_csv};
+ if (!$csv) {
+ my $class = $meta->{class} || $dbh->{'csv_class'} ||
+ 'Text::CSV_XS';
+ my %opts = ( 'binary' => 1 );
+ $opts{'eol'} = $meta->{'eol'} || $dbh->{'csv_eol'} || "\015\012";
+ $opts{'sep_char'} =
+ exists($meta->{'sep_char'}) ? $meta->{'sep_char'} :
+ exists($dbh->{'csv_sep_char'}) ? $dbh->{'csv_sep_char'} : ",";
+ $opts{'quote_char'} =
+ exists($meta->{'quote_char'}) ? $meta->{'quote_char'} :
+ exists($dbh->{'csv_quote_char'}) ? $dbh->{'csv_quote_char'} :
+ '"';
+ $opts{'escape_char'} =
+ exists($meta->{'escape_char'}) ? $meta->{'escape_char'} :
+ exists($dbh->{'csv_escape_char'}) ? $dbh->{'csv_escape_char'} :
+ '"';
+ $csv = $meta->{csv} = $class->new(\%opts);
+ }
+ my $file = $meta->{file} || $table;
+ my $tbl = $self->SUPER::open_table($data, $file, $createMode, $lockMode);
+ if ($tbl) {
+ $tbl->{'csv_csv'} = $csv;
+ my $types = $meta->{types};
+ if ($types) {
+ # The 'types' array contains DBI types, but we need types
+ # suitable for Text::CSV_XS.
+ my $t = [];
+ foreach (@{$types}) {
+ if ($_) {
+ $_ = $DBD::CSV::CSV_TYPES[$_+6] || Text::CSV_XS::PV();
+ } else {
+ $_ = Text::CSV_XS::PV();
+ }
+ push(@$t, $_);
+ }
+ $tbl->{types} = $t;
+ }
+ if (!$createMode and !$self->{ignore_missing_table} and $self->command ne 'DROP') {
+ my($array, $skipRows);
+ if (exists($meta->{skip_rows})) {
+ $skipRows = $meta->{skip_rows};
+ } else {
+ $skipRows = exists($meta->{col_names}) ? 0 : 1;
+ }
+ if ($skipRows--) {
+ if (!($array = $tbl->fetch_row($data))) {
+ die "Missing first row";
+ }
+ $tbl->{col_names} = $array;
+ while ($skipRows--) {
+ $tbl->fetch_row($data);
+ }
+ }
+ $tbl->{first_row_pos} = $tbl->{fh}->tell();
+ if (exists($meta->{col_names})) {
+ $array = $tbl->{col_names} = $meta->{col_names};
+ } elsif (!$tbl->{col_names} || !@{$tbl->{col_names}}) {
+ # No column names given; fetch first row and create default
+ # names.
+ my $a = $tbl->{cached_row} = $tbl->fetch_row($data);
+ $array = $tbl->{'col_names'};
+ for (my $i = 0; $i < @$a; $i++) {
+ push(@$array, "col$i");
+ }
+ }
+ my($col, $i);
+ my $columns = $tbl->{col_nums};
+ foreach $col (@$array) {
+ $columns->{$col} = $i++;
+ }
+ }
+ }
+ $tbl;
+}
+
+
+package DBD::CSV::Table;
+
+@DBD::CSV::Table::ISA = qw(DBD::File::Table);
+
+sub fetch_row ($$) {
+ my($self, $data) = @_;
+ my $fields;
+ if (exists($self->{cached_row})) {
+ $fields = delete($self->{cached_row});
+ } else {
+ $! = 0;
+ my $csv = $self->{csv_csv};
+ local $/ = $csv->{'eol'};
+ $fields = $csv->getline($self->{'fh'});
+ if (!$fields) {
+ die "Error while reading file " . $self->{'file'} . ": $!" if $!;
+ return undef;
+ }
+ }
+ $self->{row} = (@$fields ? $fields : undef);
+}
+
+sub push_row ($$$) {
+ my($self, $data, $fields) = @_;
+ my($csv) = $self->{csv_csv};
+ my($fh) = $self->{'fh'};
+ #
+ # Remove undef from the right end of the fields, so that at least
+ # in these cases undef is returned from FetchRow
+ #
+ while (@$fields && !defined($fields->[$#$fields])) {
+ pop @$fields;
+ }
+ if (!$csv->print($fh, $fields)) {
+ die "Error while writing file " . $self->{'file'} . ": $!";
+ }
+ 1;
+}
+*push_names = \&push_row;
+
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+DBD::CSV - DBI driver for CSV files
+
+=head1 SYNOPSIS
+
+ use DBI;
+ $dbh = DBI->connect("DBI:CSV:f_dir=/home/joe/csvdb")
+ or die "Cannot connect: " . $DBI::errstr;
+ $sth = $dbh->prepare("CREATE TABLE a (id INTEGER, name CHAR(10))")
+ or die "Cannot prepare: " . $dbh->errstr();
+ $sth->execute() or die "Cannot execute: " . $sth->errstr();
+ $sth->finish();
+ $dbh->disconnect();
+
+
+ # Read a CSV file with ";" as the separator, as exported by
+ # MS Excel. Note we need to escape the ";", otherwise it
+ # would be treated as an attribute separator.
+ $dbh = DBI->connect(qq{DBI:CSV:csv_sep_char=\\;});
+ $sth = $dbh->prepare("SELECT * FROM info");
+
+ # Same example, this time reading "info.csv" as a table:
+ $dbh = DBI->connect(qq{DBI:CSV:csv_sep_char=\\;});
+ $dbh->{'csv_tables'}->{'info'} = { 'file' => 'info.csv'};
+ $sth = $dbh->prepare("SELECT * FROM info");
+
+
+=head1 DESCRIPTION
+
+The DBD::CSV module is yet another driver for the DBI (Database independent
+interface for Perl). This one is based on the SQL "engine" SQL::Statement
+and the abstract DBI driver DBD::File and implements access to
+so-called CSV files (Comma separated values). Such files are mostly used for
+exporting MS Access and MS Excel data.
+
+See L<DBI(3)> for details on DBI, L<SQL::Statement(3)> for details on
+SQL::Statement and L<DBD::File(3)> for details on the base class
+DBD::File.
+
+
+=head2 Prerequisites
+
+The only system dependent feature that DBD::File uses, is the C<flock()>
+function. Thus the module should run (in theory) on any system with
+a working C<flock()>, in particular on all Unix machines and on Windows
+NT. Under Windows 95 and MacOS the use of C<flock()> is disabled, thus
+the module should still be usable,
+
+Unlike other DBI drivers, you don't need an external SQL engine
+or a running server. All you need are the following Perl modules,
+available from any CPAN mirror, for example
+
+ ftp://ftp.funet.fi/pub/languages/perl/CPAN/modules/by-module
+
+=over 4
+
+=item DBI
+
+the DBI (Database independent interface for Perl), version 1.00 or
+a later release
+
+=item SQL::Statement
+
+a simple SQL engine
+
+=item Text::CSV_XS
+
+this module is used for writing rows to or reading rows from CSV files.
+
+=back
+
+
+=head2 Installation
+
+Installing this module (and the prerequisites from above) is quite simple.
+You just fetch the archive, extract it with
+
+ gzip -cd DBD-CSV-0.1000.tar.gz | tar xf -
+
+(this is for Unix users, Windows users would prefer WinZip or something
+similar) and then enter the following:
+
+ cd DBD-CSV-0.1000
+ perl Makefile.PL
+ make
+ make test
+
+If any tests fail, let me know. Otherwise go on with
+
+ make install
+
+Note that you almost definitely need root or administrator permissions.
+If you don't have them, read the ExtUtils::MakeMaker man page for details
+on installing in your own directories. L<ExtUtils::MakeMaker>.
+
+=head2
+
+ The level of SQL support available depends on the version of
+ SQL::Statement installed. Any version will support *basic*
+ CREATE, INSERT, DELETE, UPDATE, and SELECT statements. Only
+ versions of SQL::Statement 1.0 and above support additional
+ features such as table joins, string functions, etc. See the
+ documentation of the latest version of SQL::Statement for details.
+
+=head2 Creating a database handle
+
+Creating a database handle usually implies connecting to a database server.
+Thus this command reads
+
+ use DBI;
+ my $dbh = DBI->connect("DBI:CSV:f_dir=$dir");
+
+The directory tells the driver where it should create or open tables
+(a.k.a. files). It defaults to the current directory, thus the following
+are equivalent:
+
+ $dbh = DBI->connect("DBI:CSV:");
+ $dbh = DBI->connect("DBI:CSV:f_dir=.");
+
+(I was told, that VMS requires
+
+ $dbh = DBI->connect("DBI:CSV:f_dir=");
+
+for whatever reasons.)
+
+You may set other attributes in the DSN string, separated by semicolons.
+
+
+=head2 Creating and dropping tables
+
+You can create and drop tables with commands like the following:
+
+ $dbh->do("CREATE TABLE $table (id INTEGER, name CHAR(64))");
+ $dbh->do("DROP TABLE $table");
+
+Note that currently only the column names will be stored and no other data.
+Thus all other information including column type (INTEGER or CHAR(x), for
+example), column attributes (NOT NULL, PRIMARY KEY, ...) will silently be
+discarded. This may change in a later release.
+
+A drop just removes the file without any warning.
+
+See L<DBI(3)> for more details.
+
+Table names cannot be arbitrary, due to restrictions of the SQL syntax.
+I recommend that table names are valid SQL identifiers: The first
+character is alphabetic, followed by an arbitrary number of alphanumeric
+characters. If you want to use other files, the file names must start
+with '/', './' or '../' and they must not contain white space.
+
+
+=head2 Inserting, fetching and modifying data
+
+The following examples insert some data in a table and fetch it back:
+First all data in the string:
+
+ $dbh->do("INSERT INTO $table VALUES (1, "
+ . $dbh->quote("foobar") . ")");
+
+Note the use of the quote method for escaping the word 'foobar'. Any
+string must be escaped, even if it doesn't contain binary data.
+
+Next an example using parameters:
+
+ $dbh->do("INSERT INTO $table VALUES (?, ?)", undef,
+ 2, "It's a string!");
+
+Note that you don't need to use the quote method here, this is done
+automatically for you. This version is particularly well designed for
+loops. Whenever performance is an issue, I recommend using this method.
+
+You might wonder about the C<undef>. Don't wonder, just take it as it
+is. :-) It's an attribute argument that I have never ever used and
+will be parsed to the prepare method as a second argument.
+
+
+To retrieve data, you can use the following:
+
+ my($query) = "SELECT * FROM $table WHERE id > 1 ORDER BY id";
+ my($sth) = $dbh->prepare($query);
+ $sth->execute();
+ while (my $row = $sth->fetchrow_hashref) {
+ print("Found result row: id = ", $row->{'id'},
+ ", name = ", $row->{'name'});
+ }
+ $sth->finish();
+
+Again, column binding works: The same example again.
+
+ my($query) = "SELECT * FROM $table WHERE id > 1 ORDER BY id";
+ my($sth) = $dbh->prepare($query);
+ $sth->execute();
+ my($id, $name);
+ $sth->bind_columns(undef, \$id, \$name);
+ while ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ $sth->finish();
+
+Of course you can even use input parameters. Here's the same example
+for the third time:
+
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query);
+ $sth->bind_columns(undef, \$id, \$name);
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id);
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ $sth->finish();
+ }
+
+See L<DBI(3)> for details on these methods. See L<SQL::Statement(3)> for
+details on the WHERE clause.
+
+Data rows are modified with the UPDATE statement:
+
+ $dbh->do("UPDATE $table SET id = 3 WHERE id = 1");
+
+Likewise you use the DELETE statement for removing rows:
+
+ $dbh->do("DELETE FROM $table WHERE id > 1");
+
+
+=head2 Error handling
+
+In the above examples we have never cared about return codes. Of course,
+this cannot be recommended. Instead we should have written (for example):
+
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query)
+ or die "prepare: " . $dbh->errstr();
+ $sth->bind_columns(undef, \$id, \$name)
+ or die "bind_columns: " . $dbh->errstr();
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id)
+ or die "execute: " . $dbh->errstr();
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ }
+ $sth->finish($id)
+ or die "finish: " . $dbh->errstr();
+
+Obviously this is tedious. Fortunately we have DBI's I<RaiseError>
+attribute:
+
+ $dbh->{'RaiseError'} = 1;
+ $@ = '';
+ eval {
+ my($query) = "SELECT * FROM $table WHERE id = ?";
+ my($sth) = $dbh->prepare($query);
+ $sth->bind_columns(undef, \$id, \$name);
+ for (my($i) = 1; $i <= 2; $i++) {
+ $sth->execute($id);
+ if ($sth->fetch) {
+ print("Found result row: id = $id, name = $name\n");
+ }
+ }
+ $sth->finish($id);
+ };
+ if ($@) { die "SQL database error: $@"; }
+
+This is not only shorter, it even works when using DBI methods within
+subroutines.
+
+
+=head2 Metadata
+
+The following attributes are handled by DBI itself and not by DBD::File,
+thus they all work as expected:
+
+ Active
+ ActiveKids
+ CachedKids
+ CompatMode (Not used)
+ InactiveDestroy
+ Kids
+ PrintError
+ RaiseError
+ Warn (Not used)
+
+The following DBI attributes are handled by DBD::File:
+
+=over 4
+
+=item AutoCommit
+
+Always on
+
+=item ChopBlanks
+
+Works
+
+=item NUM_OF_FIELDS
+
+Valid after C<$sth-E<gt>execute>
+
+=item NUM_OF_PARAMS
+
+Valid after C<$sth-E<gt>prepare>
+
+=item NAME
+
+Valid after C<$sth-E<gt>execute>; undef for Non-Select statements.
+
+=item NULLABLE
+
+Not really working. Always returns an array ref of one's, as DBD::CSV
+doesn't verify input data. Valid after C<$sth-E<gt>execute>; undef for
+non-Select statements.
+
+=back
+
+These attributes and methods are not supported:
+
+ bind_param_inout
+ CursorName
+ LongReadLen
+ LongTruncOk
+
+In addition to the DBI attributes, you can use the following dbh
+attributes:
+
+=over 8
+
+=item f_dir
+
+This attribute is used for setting the directory where CSV files are
+opened. Usually you set it in the dbh, it defaults to the current
+directory ("."). However, it is overwritable in the statement handles.
+
+=item csv_eol
+
+=item csv_sep_char
+
+=item csv_quote_char
+
+=item csv_escape_char
+
+=item csv_class
+
+=item csv_csv
+
+The attributes I<csv_eol>, I<csv_sep_char>, I<csv_quote_char> and
+I<csv_escape_char> are corresponding to the respective attributes of the
+Text::CSV_XS object. You want to set these attributes if you have unusual
+CSV files like F</etc/passwd> or MS Excel generated CSV files with a semicolon
+as separator. Defaults are "\015\012", ';', '"' and '"', respectively.
+
+The attributes are used to create an instance of the class I<csv_class>,
+by default Text::CSV_XS. Alternatively you may pass an instance as
+I<csv_csv>, the latter takes precedence. Note that the I<binary>
+attribute I<must> be set to a true value in that case.
+
+Additionally you may overwrite these attributes on a per-table base in
+the I<csv_tables> attribute.
+
+=item csv_tables
+
+This hash ref is used for storing table dependent metadata. For any
+table it contains an element with the table name as key and another
+hash ref with the following attributes:
+
+=over 12
+
+=item file
+
+The tables file name; defaults to
+
+ "$dbh->{f_dir}/$table"
+
+=item eol
+
+=item sep_char
+
+=item quote_char
+
+=item escape_char
+
+=item class
+
+=item csv
+
+These correspond to the attributes I<csv_eol>, I<csv_sep_char>,
+I<csv_quote_char>, I<csv_escape_char>, I<csv_class> and I<csv_csv>.
+The difference is that they work on a per-table base.
+
+=item col_names
+
+=item skip_first_row
+
+By default DBD::CSV assumes that column names are stored in the first
+row of the CSV file. If this is not the case, you can supply an array
+ref of table names with the I<col_names> attribute. In that case the
+attribute I<skip_first_row> will be set to FALSE.
+
+If you supply an empty array ref, the driver will read the first row
+for you, count the number of columns and create column names like
+C<col0>, C<col1>, ...
+
+=back
+
+=back
+
+Example: Suggest you want to use F</etc/passwd> as a CSV file. :-)
+There simplest way is:
+
+ require DBI;
+ my $dbh = DBI->connect("DBI:CSV:f_dir=/etc;csv_eol=\n;"
+ . "csv_sep_char=:;csv_quote_char=;"
+ . "csv_escape_char=");
+ $dbh->{'csv_tables'}->{'passwd'} = {
+ 'col_names' => ["login", "password", "uid", "gid", "realname",
+ "directory", "shell"]
+ };
+ $sth = $dbh->prepare("SELECT * FROM passwd");
+
+Another possibility where you leave all the defaults as they are and
+overwrite them on a per table base:
+
+ require DBI;
+ my $dbh = DBI->connect("DBI:CSV:");
+ $dbh->{'csv_tables'}->{'passwd'} = {
+ 'eol' => "\n",
+ 'sep_char' => ":",
+ 'quote_char' => undef,
+ 'escape_char' => undef,
+ 'file' => '/etc/passwd',
+ 'col_names' => ["login", "password", "uid", "gid", "realname",
+ "directory", "shell"]
+ };
+ $sth = $dbh->prepare("SELECT * FROM passwd");
+
+
+=head2 Driver private methods
+
+These methods are inherited from DBD::File:
+
+=over 4
+
+=item data_sources
+
+The C<data_sources> method returns a list of subdirectories of the current
+directory in the form "DBI:CSV:directory=$dirname".
+
+If you want to read the subdirectories of another directory, use
+
+ my($drh) = DBI->install_driver("CSV");
+ my(@list) = $drh->data_sources('f_dir' => '/usr/local/csv_data' );
+
+=item list_tables
+
+This method returns a list of file names inside $dbh->{'directory'}.
+Example:
+
+ my($dbh) = DBI->connect("DBI:CSV:directory=/usr/local/csv_data");
+ my(@list) = $dbh->func('list_tables');
+
+Note that the list includes all files contained in the directory, even
+those that have non-valid table names, from the view of SQL. See
+L<Creating and dropping tables> above.
+
+=back
+
+
+=head2 Data restrictions
+
+When inserting and fetching data, you will sometimes be surprised: DBD::CSV
+doesn't correctly handle data types, in particular NULLs. If you insert
+integers, it might happen, that fetch returns a string. Of course, a string
+containing the integer, so that's perhaps not a real problem. But the
+following will never work:
+
+ $dbh->do("INSERT INTO $table (id, name) VALUES (?, ?)",
+ undef, "foo bar");
+ $sth = $dbh->prepare("SELECT * FROM $table WHERE id IS NULL");
+ $sth->execute();
+ my($id, $name);
+ $sth->bind_columns(undef, \$id, \$name);
+ while ($sth->fetch) {
+ printf("Found result row: id = %s, name = %s\n",
+ defined($id) ? $id : "NULL",
+ defined($name) ? $name : "NULL");
+ }
+ $sth->finish();
+
+The row we have just inserted, will never be returned! The reason is
+obvious, if you examine the CSV file: The corresponding row looks
+like
+
+ "","foo bar"
+
+In other words, not a NULL is stored, but an empty string. CSV files
+don't have a concept of NULL values. Surprisingly the above example
+works, if you insert a NULL value for the name! Again, you find
+the explanation by examining the CSV file:
+
+ ""
+
+In other words, DBD::CSV has "emulated" a NULL value by writing a row
+with less columns. Of course this works only if the rightmost column
+is NULL, the two rightmost columns are NULL, ..., but the leftmost
+column will never be NULL!
+
+See L<Creating and dropping tables> above for table name restrictions.
+
+
+=head1 TODO
+
+Extensions of DBD::CSV:
+
+=over 4
+
+=item CSV file scanner
+
+Write a simple CSV file scanner that reads a CSV file and attempts
+to guess sep_char, quote_char, escape_char and eol automatically.
+
+=back
+
+These are merely restrictions of the DBD::File or SQL::Statement
+modules:
+
+=over 4
+
+=item Table name mapping
+
+Currently it is not possible to use files with names like C<names.csv>.
+Instead you have to use soft links or rename files. As an alternative
+one might use, for example a dbh attribute 'table_map'. It might be a
+hash ref, the keys being the table names and the values being the file
+names.
+
+=item Column name mapping
+
+Currently the module assumes that column names are stored in the first
+row. While this is fine in most cases, there should be a possibility
+of setting column names and column number from the programmer: For
+example MS Access doesn't export column names by default.
+
+=back
+
+
+=head1 KNOWN BUGS
+
+=over 8
+
+=item *
+
+The module is using flock() internally. However, this function is not
+available on platforms. Using flock() is disabled on MacOS and Windows
+95: There's no locking at all (perhaps not so important on these
+operating systems, as they are for single users anyways).
+
+=back
+
+
+=head1 AUTHOR AND COPYRIGHT
+
+This module is currently maintained by
+
+ Jeff Zucker
+ <jeff@vpservices.com>
+
+The original author is Jochen Wiedmann.
+
+Copyright (C) 1998 by Jochen Wiedmann
+
+All rights reserved.
+
+You may distribute this module under the terms of either the GNU
+General Public License or the Artistic License, as specified in
+the Perl README file.
+
+=head1 SEE ALSO
+
+L<DBI(3)>, L<Text::CSV_XS(3)>, L<SQL::Statement(3)>
+
+For help on the use of DBD::CSV, see the DBI users mailing list:
+
+ http://www.isc.org/dbi-lists.html
+
+For general information on DBI see
+
+ http://www.symbolstone.org/technology/perl/DBI
+
+=cut
@@ -1,56 +0,0 @@
-package DBI::Test::Case::DBD::CSV::t10_base;
-
-use strict;
-use warnings;
-
-use parent qw( DBI::Test::DBD::CSV::Case);
-
-use Test::More;
-use DBI::Test;
-use DBI;
-
-sub supported_variant
-{
- my ($self, $test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options) = @_;
-
- $self->is_test_for_mocked ($test_confs) and return;
-
- return $self->SUPER::supported_variant ($test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options);
- } # supported_variant
-
-sub run_test
-{
- my ($self, $dbc) = @_;
- my @DB_CREDS = @$dbc;
- $DB_CREDS[3]->{PrintError} = 0;
- $DB_CREDS[3]->{RaiseError} = 0;
- if ($ENV{DBI_PUREPERL}) {
- eval "use Text::CSV;";
- $@ or $DB_CREDS[3]->{csv_class} = "Text::CSV"
- }
-
- defined $ENV{DBI_SQL_NANO} or
- eval "use SQL::Statement;";
-
- ok (my $switch = DBI->internal, "DBI->internal");
- is (ref $switch, "DBI::dr", "Driver class");
-
- # This is a special case. install_driver should not normally be used.
- ok (my $drh = DBI->install_driver ("CSV"), "Install driver");
-
- is (ref $drh, "DBI::dr", "Driver class installed");
-
- ok ($drh->{Version}, "Driver version $drh->{Version}");
-
- my $dbh = connect_ok (@DB_CREDS, "Connect with dbi:CSV:");
-
- my $csv_version_info = $dbh->csv_versions ();
- ok ($csv_version_info, "csv_versions");
- diag ($csv_version_info);
-
- done_testing ();
- }
-
-1;
@@ -1,64 +0,0 @@
-package DBI::Test::Case::DBD::CSV::t11_dsnlist;
-
-use strict;
-use warnings;
-
-use parent qw( DBI::Test::DBD::CSV::Case);
-
-use Test::More;
-use DBI::Test;
-use DBI;
-
-sub supported_variant
-{
- my ($self, $test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options) = @_;
-
- $self->is_test_for_mocked ($test_confs) and return;
-
- return $self->SUPER::supported_variant ($test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options);
- } # supported_variant
-
-use vars q{$AUTOLOAD};
-sub AUTOLOAD
-{
- (my $sub = $AUTOLOAD) =~ s/.*:/DBI::Test::DBD::CSV::Case::/;
- { no strict "refs";
- $sub->(@_);
- }
- } # AUTOLOAD
-
-sub run_test
-{
- my ($self, $dbc) = @_;
- my @DB_CREDS = @$dbc;
- $DB_CREDS[3]->{PrintError} = 0;
- $DB_CREDS[3]->{RaiseError} = 0;
- if ($ENV{DBI_PUREPERL}) {
- eval "use Text::CSV;";
- $@ or $DB_CREDS[3]->{csv_class} = "Text::CSV"
- }
-
- defined $ENV{DBI_SQL_NANO} or
- eval "use SQL::Statement;";
-
- my $dbh = connect_ok (@DB_CREDS, "Connect with dbi:CSV:");
-
- ok ($dbh->ping, "ping");
-
- # This returns at least ".", "lib", and "t"
- ok (my @dsn = DBI->data_sources ("CSV"), "data_sources");
- ok (@dsn >= 2, "more than one");
- ok ($dbh->disconnect, "disconnect");
-
- # Try different DSN's
- foreach my $d (qw( . example lib t )) {
- ok (my $dns = Connect ("dbi:CSV:f_dir=$d"), "use $d as f_dir");
- ok ($dbh->disconnect, "disconnect");
- }
-
- done_testing ();
- } # run_test
-
-1;
@@ -1,68 +0,0 @@
-package DBI::Test::Case::DBD::CSV::t20_createdrop;
-
-use strict;
-use warnings;
-
-use parent qw( DBI::Test::DBD::CSV::Case );
-
-use Test::More;
-use DBI::Test;
-use DBI;
-
-sub supported_variant
-{
- my ($self, $test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options) = @_;
-
- $self->is_test_for_mocked ($test_confs) and return;
-
- return $self->SUPER::supported_variant ($test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options);
- } # supported_variant
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-use vars q{$AUTOLOAD};
-sub AUTOLOAD
-{
- (my $sub = $AUTOLOAD) =~ s/.*:/DBI::Test::DBD::CSV::Case::/;
- { no strict "refs";
- $sub->(@_);
- }
- } # AUTOLOAD
-
-sub run_test
-{
- my ($self, $dbc) = @_;
- my @DB_CREDS = @$dbc;
- $DB_CREDS[3]->{PrintError} = 0;
- $DB_CREDS[3]->{RaiseError} = 0;
- $DB_CREDS[3]->{f_dir} = DbDir ();
- if ($ENV{DBI_PUREPERL}) {
- eval "use Text::CSV;";
- $@ or $DB_CREDS[3]->{csv_class} = "Text::CSV"
- }
-
- defined $ENV{DBI_SQL_NANO} or
- eval "use SQL::Statement;";
-
- my $dbh = connect_ok (@DB_CREDS, "Connect with dbi:CSV:");
-
- ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
- like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
- do_ok ($dbh, $def, "create table");
- my $tbl_file = DbFile ($tbl);
- ok (-s $tbl_file, "file exists");
- do_ok ($dbh, "drop table $tbl", "drop table");
- ok ($dbh->disconnect, "disconnect");
- ok (!-f $tbl_file, "file removed");
-
- done_testing ();
- } # run_test
-
-1;
@@ -1,83 +0,0 @@
-package DBI::Test::Case::DBD::CSV::t85_error;
-
-use strict;
-use warnings;
-
-use parent qw( DBI::Test::DBD::CSV::Case );
-
-use Test::More;
-use DBI::Test;
-use DBI;
-
-sub supported_variant
-{
- my ($self, $test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options) = @_;
-
- $self->is_test_for_mocked ($test_confs) and return;
-
- return $self->SUPER::supported_variant ($test_case, $cfg_pfx, $test_confs,
- $dsn_pfx, $dsn_cred, $options);
- } # supported_variant
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-use vars q{$AUTOLOAD};
-sub AUTOLOAD
-{
- (my $sub = $AUTOLOAD) =~ s/.*:/DBI::Test::DBD::CSV::Case::/;
- { no strict "refs";
- $sub->(@_);
- }
- } # AUTOLOAD
-
-sub run_test
-{
- my ($self, $dbc) = @_;
- my @DB_CREDS = @$dbc;
- $DB_CREDS[3]->{PrintError} = 0;
- $DB_CREDS[3]->{RaiseError} = 0;
- $DB_CREDS[3]->{f_dir} = DbDir ();
- if ($ENV{DBI_PUREPERL}) {
- eval "use Text::CSV;";
- $@ or $DB_CREDS[3]->{csv_class} = "Text::CSV"
- }
-
- defined $ENV{DBI_SQL_NANO} or
- eval "use SQL::Statement;";
-
- my $dbh = connect_ok (@DB_CREDS, "Connect with dbi:CSV:");
-
- ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
- like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
- do_ok ($dbh, $def, "create table");
- my $tbl_file = DbFile ($tbl);
- ok (-s $tbl_file, "file exists");
- ok ($dbh->disconnect, "disconnect");
- undef $dbh;
-
- ok (-f $tbl_file, "file still there");
- open my $fh, ">>", $tbl_file;
- print $fh qq{1, "p0wnd",",""",0\n}; # Very bad content
- close $fh;
-
- ok ($dbh = connect_ok (@DB_CREDS, "Connect with dbi:CSV:"));
- { local $dbh->{PrintError} = 0;
- local $dbh->{RaiseError} = 0;
- my $sth = prepare_ok ($dbh, "select * from $tbl", "prepare");
- is ($sth->execute, undef, "execute should fail");
- # It is safe to regex on this text, as it is NOT local dependant
- like ($dbh->errstr, qr{\w+ \@ line [0-9?]+ pos [0-9?]+}, "error message");
- };
- do_ok ($dbh, "drop table $tbl", "drop");
- ok ($dbh->disconnect, "disconnect");
-
- done_testing ();
- } # run_test
-
-1;
@@ -1,9 +0,0 @@
-#!/usr/bin/perl
-
-package DBI::Test::DBD::CSV::Conf;
-
-use strict;
-use warnings;
-use parent qw( DBI::Test::Conf );
-
-1;
@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-
-package DBI::Test::DBD::CSV::List;
-
-use strict;
-use warnings;
-use parent "DBI::Test::List";
-
-sub test_cases
-{
- my @pm = glob "lib/DBI/Test/Case/DBD/CSV/*.pm";
- s{lib/DBI/Test/Case/DBD/CSV/(\S+)\.pm}{DBD::CSV::$1} for @pm;
- return @pm;
- } # test_cases
-
-1;
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-# Test that our META.yml file matches the specification
-
-use strict;
-use warnings;
-
-my @MODULES = ( "Test::CPAN::Meta 0.12" );
-
-my $has_meta = -f "META.yml";
-
-# Don't run tests during end-user installs
-use Test::More;
-$ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} || !$has_meta or
- plan skip_all => "Author tests not required for installation";
-
-# Load the testing modules
-foreach my $MODULE (@MODULES) {
- eval "use $MODULE";
- $@ or next;
- $ENV{RELEASE_TESTING}
- ? die "Failed to load required release-testing module $MODULE"
- : plan skip_all => "$MODULE not available for testing";
- }
-
-!$has_meta && -x "sandbox/genMETA.pl" and
- qx{ perl sandbox/genMETA.pl -v > META.yml };
-
-meta_yaml_ok ();
-
-$has_meta or unlink "META.yml";
-
-1;
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-# Test that the documentation syntax is correct
-
-use strict;
-use warnings;
-
-use Test::More;
-
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok ();
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-# Test that all methods are documented
-
-use strict;
-use warnings;
-
-use Test::More;
-
-eval "use Test::Pod::Coverage tests => 1";
-plan skip_all => "Test::Pod::Coverage required for testing POD Coverage" if $@;
-pod_coverage_ok ("DBD::CSV", "DBD::CSV is covered");
@@ -0,0 +1,54 @@
+#!/usr/local/bin/perl
+#
+# $Id: 00base.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is the base test, tries to install the drivers. Should be
+# executed as the very first test.
+#
+
+
+#
+# Include lib.pl
+#
+use lib '/home/jeff/data/module/SQL-Statement/SQL-Statement-1.12/lib';
+use SQL::Statement;
+warn $SQL::Statement::VERSION;
+
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+# Base DBD Driver Test
+
+print "1..$tests\n";
+
+require DBI;
+print "ok 1\n";
+
+import DBI;
+print "ok 2\n";
+
+$switch = DBI->internal;
+(ref $switch eq 'DBI::dr') ? print "ok 3\n" : print "not ok 3\n";
+
+
+
+# This is a special case. install_driver should not normally be used.
+$drh = DBI->install_driver($mdriver);
+
+(ref $drh eq 'DBI::dr') ? print "ok 4\n" : print "not ok 4\n";
+
+if ($drh->{Version}) {
+ print "ok 5\n";
+ print "Driver version is ", $drh->{Version}, "\n";
+}
+
+BEGIN { $tests = 5 }
+exit 0;
+# end.
@@ -1,41 +0,0 @@
-#!/usr/bin/perl
-
-# Test whether the driver can be installed
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN {
- use_ok ("DBI");
- use_ok ("SQL::Statement");
- }
-
-ok ($SQL::Statement::VERSION, "SQL::Statement::Version $SQL::Statement::VERSION");
-
-do "t/lib.pl";
-
-my $nano = $ENV{DBI_SQL_NANO};
-defined $nano or $nano = "not set";
-diag ("Showing relevant versions (DBI_SQL_NANO = $nano)");
-diag ("Using DBI version $DBI::VERSION");
-diag ("Using DBD::File version $DBD::File::VERSION");
-diag ("Using SQL::Statement version $SQL::Statement::VERSION");
-diag ("Using Text::CSV_XS version $Text::CSV_XS::VERSION");
-
-ok (my $switch = DBI->internal, "DBI->internal");
-is (ref $switch, "DBI::dr", "Driver class");
-
-# This is a special case. install_driver should not normally be used.
-ok (my $drh = DBI->install_driver ("CSV"), "Install driver");
-
-is (ref $drh, "DBI::dr", "Driver class installed");
-
-ok ($drh->{Version}, "Driver version $drh->{Version}");
-
-my $dbh = DBI->connect ("dbi:CSV:");
-my $csv_version_info = $dbh->csv_versions ();
-ok ($csv_version_info, "csv_versions");
-diag ($csv_version_info);
-
-done_testing ();
@@ -0,0 +1,82 @@
+#!/usr/local/bin/perl
+#
+# $Id: 10dsnlist.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This test creates a database and drops it. Should be executed
+# after listdsn.
+#
+
+
+#
+# Include lib.pl
+#
+require DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+if ($mdriver eq 'pNET' || $mdriver eq 'Adabas') {
+ print "1..0\n";
+ exit 0;
+}
+print "Driver is $mdriver\n";
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests into the loop
+#
+while (Testing()) {
+ # Check if the server is awake.
+ $dbh = undef;
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ServerError();
+
+ Test($state or (@dsn = DBI->data_sources($mdriver)) >= 0);
+ if (!$state) {
+ my $d;
+ print "List of $mdriver data sources:\n";
+ foreach $d (@dsn) {
+ print " $d\n";
+ }
+ print "List ends.\n";
+ }
+ Test($state or $dbh->disconnect());
+
+ #
+ # Try different DSN's
+ #
+ my(@dsnList);
+ if (($mdriver eq 'mysql' or $mdriver eq 'mSQL')
+ and $test_dsn eq "DBI:$mdriver:test") {
+ @dsnList = ("DBI:$mdriver:test:localhost",
+ "DBI:$mdriver:test;localhost",
+ "DBI:$mdriver:database=test;host=localhost");
+ }
+ my($dsn);
+ foreach $dsn (@dsnList) {
+ Test($state or ($dbh = DBI->connect($dsn, $test_user,
+ $test_password)))
+ or print "Cannot connect to DSN $dsn: ${DBI::errstr}\n";
+ Test($state or $dbh->disconnect());
+ }
+}
+
+exit 0;
+
+# Hate -w :-)
+$test_dsn = $test_user = $test_password = $DBI::errstr;
@@ -1,32 +0,0 @@
-#!/usr/bin/perl
-
-# Test whether data_sources () returns something useful
-
-use strict;
-use warnings;
-use Test::More;
-
-# Include lib.pl
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-ok (1, "Driver is CSV\n");
-
-ok (my $dbh = Connect (), "Connect");
-
-$dbh or BAIL_OUT "Cannot connect";
-
-ok ($dbh->ping, "ping");
-
-# This returns at least ".", "lib", and "t"
-ok (my @dsn = DBI->data_sources ("CSV"), "data_sources");
-ok (@dsn >= 2, "more than one");
-ok ($dbh->disconnect, "disconnect");
-
-# Try different DSN's
-foreach my $d (qw( . example lib t )) {
- ok (my $dns = Connect ("dbi:CSV:f_dir=$d"), "use $d as f_dir");
- ok ($dbh->disconnect, "disconnect");
- }
-
-done_testing ();
@@ -1,30 +0,0 @@
-#!/usr/bin/perl
-
-# Test if a table can be created and dropped
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-my $tbl_file = DbFile ($tbl);
-ok (-s $tbl_file, "file exists");
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-ok (!-f $tbl_file, "file removed");
-
-done_testing ();
@@ -0,0 +1,82 @@
+#!/usr/local/bin/perl
+#
+# $Id: 20createdrop.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a skeleton test. For writing new tests, take this file
+# and modify/extend it.
+#
+
+use strict;
+use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver);
+$DBI::errstr = ''; # Make -w happy
+require DBI;
+
+
+#
+# Include lib.pl
+#
+$mdriver = "";
+my $file;
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests into the loop
+#
+use vars qw($state);
+while (Testing()) {
+ #
+ # Connect to the database
+ my $dbh;
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ my $table;
+ Test($state or $table = FindNewTable($dbh))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table
+ #
+ my $def;
+ if (!$state) {
+ ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]));
+ print "Creating table:\n$def\n";
+ }
+ Test($state or $dbh->do($def))
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ #
+ # ... and drop it.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Finally disconnect.
+ #
+ Test($state or $dbh->disconnect())
+ or DbiError($dbh->err, $dbh->errstr);
+}
@@ -1,96 +0,0 @@
-#!/usr/local/bin/perl
-
-# Test row insertion and retrieval
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- [ "val", "INTEGER", 4, 0 ],
- [ "txt", "CHAR", 64, 0 ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-$tbl ||= "tmp99";
-eval {
- local $SIG{__WARN__} = sub {};
- $dbh->do ("drop table $tbl");
- };
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-
-my $sz = 0;
-ok ($dbh->do ($def), "create table");
-my $tbl_file = DbFile ($tbl);
-ok ($sz = -s $tbl_file, "file exists");
-
-ok ($dbh->do ("insert into $tbl values ".
- "(1, 'Alligator Descartes', 1111, 'Some Text')"), "insert");
-ok ($sz < -s $tbl_file, "file grew");
-$sz = -s $tbl_file;
-
-ok ($dbh->do ("insert into $tbl (id, name, val, txt) values ".
- "(2, 'Crocodile Dundee', 2222, 'Down Under')"), "insert with field names");
-ok ($sz < -s $tbl_file, "file grew");
-
-ok (my $sth = $dbh->prepare ("select * from $tbl where id = 1"), "prepare");
-is (ref $sth, "DBI::st", "handle type");
-
-ok ($sth->execute, "execute");
-
-ok (my $row = $sth->fetch, "fetch");
-is (ref $row, "ARRAY", "returned a list");
-is ($sth->errstr, undef, "no error");
-
-is_deeply ($row, [ 1, "Alligator Descartes", 1111, "Some Text" ], "content");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-# Try some other capitilization
-ok ($dbh->do ("DELETE FROM $tbl WHERE id = 1"), "delete");
-
-# Now, try SELECT'ing the row out. This should fail.
-ok ($sth = $dbh->prepare ("select * from $tbl where id = 1"), "prepare");
-is (ref $sth, "DBI::st", "handle type");
-
-ok ($sth->execute, "execute");
-is ($sth->fetch, undef, "fetch");
-is ($sth->errstr, undef, "error"); # ???
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($sth = $dbh->prepare ("insert into $tbl values (?, ?, ?, ?)"), "prepare insert");
-ok ($sth->execute (3, "Babar", 3333, "Elephant"), "insert prepared");
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($sth = $dbh->prepare ("insert into $tbl (id, name, val, txt) values (?, ?, ?, ?)"), "prepare insert with field names");
-ok ($sth->execute (4, "Vischje", 33, "in het riet"), "insert prepared");
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("delete from $tbl"), "delete all");
-ok ($dbh->do ("insert into $tbl (id) values (0)"), "insert just one field");
-{ local (@ARGV) = DbFile ($tbl);
- my @csv = <>;
- s/\r?\n\Z// for @csv;
- is (scalar @csv, 2, "Just two lines");
- is ($csv[0], "id,name,val,txt", "header");
- is ($csv[1], "0,,,", "data");
- }
-
-ok ($dbh->do ("drop table $tbl"), "drop");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -0,0 +1,142 @@
+#!/usr/local/bin/perl
+#
+# $Id: 30insertfetch.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a simple insert/fetch test.
+#
+$^W = 1;
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+use DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+
+ #
+ # Connect to the database
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
+ 'connect')
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh), 'FindNewTable')
+ or DbiError($dbh->err, $dbh->errstr);
+ $table ||= 'tmp';
+ eval {$dbh->do("DROP TABLE $table")};
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0],
+ ["val", "INTEGER", 4, 0],
+ ["txt", "CHAR", 64, 0]) and
+ $dbh->do($def)), 'create', $def)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Insert a row into the test table.......
+ #
+ Test($state or $dbh->do("INSERT INTO $table"
+ . " VALUES(1, 'Alligator Descartes', 1111,"
+ . " 'Some Text')"), 'insert')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Now, try SELECT'ing the row out.
+ #
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id = 1"),
+ 'prepare select')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute, 'execute select')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ my ($row, $errstr);
+ Test($state or (defined($row = $cursor->fetchrow_arrayref) &&
+ !($cursor->errstr)), 'fetch select')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or ($row->[0] == 1 &&
+ $row->[1] eq 'Alligator Descartes' &&
+ $row->[2] == 1111 &&
+ $row->[3] eq 'Some Text'), 'compare select')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or $cursor->finish, 'finish select')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or undef $cursor || 1, 'undef select');
+
+ #
+ # ...and delete it........
+ #
+ Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"), 'delete')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Now, try SELECT'ing the row out. This should fail.
+ #
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id = 1"),
+ 'prepare select deleted')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute, 'execute select deleted')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or (!defined($row = $cursor->fetchrow_arrayref) &&
+ (!defined($errstr = $cursor->errstr) ||
+ $cursor->errstr eq '')), 'fetch select deleted')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or $cursor->finish, 'finish select deleted')
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or undef $cursor || 1, 'undef select deleted');
+
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"), 'drop')
+ or DbiError($dbh->err, $dbh->errstr);
+
+}
+
@@ -1,63 +0,0 @@
-#!/usr/bin/perl
-
-# test if delete from shrinks table
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-my $sz = 0;
-my $tbl_file = DbFile ($tbl);
-ok ($sz = -s $tbl_file, "file exists");
-
-ok ($dbh->do ("insert into $tbl values (1, 'Foo')"), "insert");
-ok ($sz < -s $tbl_file, "file grew");
-$sz = -s $tbl_file;
-
-ok ($dbh->do ("delete from $tbl where id = 1"), "delete single");
-ok ($sz > -s $tbl_file, "file shrank");
-$sz = -s $tbl_file;
-
-ok ($dbh->do ("insert into $tbl (id) values ($_)"), "insert $_") for 1 .. 10;
-ok ($sz < -s $tbl_file, "file grew");
-
-{ local $dbh->{PrintWarn} = 0;
- local $dbh->{PrintError} = 0;
- is ($dbh->do ("delete from wxyz where id = 99"), undef, "delete non-existing tbl");
- }
-my $zero_ret = $dbh->do ("delete from $tbl where id = 99");
-ok ($zero_ret, "true non-existing delete RV (via do)");
-cmp_ok ($zero_ret, "==", 0, "delete non-existing row (via do)");
-is ($dbh->do ("delete from $tbl where id = 9"), 1, "delete single (count) (via do)");
-is ($dbh->do ("delete from $tbl where id > 7"), 2, "delete more (count) (via do)");
-
-$zero_ret = $dbh->prepare ("delete from $tbl where id = 88")->execute;
-ok ($zero_ret, "true non-existing delete RV (via prepare/execute)");
-cmp_ok ($zero_ret, "==", 0, "delete non-existing row (via prepare/execute)");
-is ($dbh->prepare ("delete from $tbl where id = 7")->execute, 1, "delete single (count) (via prepare/execute)");
-is ($dbh->prepare ("delete from $tbl where id > 4")->execute, 2, "delete more (count) (via prepare/execute)");
-
-ok ($dbh->do ("delete from $tbl"), "delete all");
-is (-s $tbl_file, $sz, "file reflects empty table");
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-ok (!-f $tbl_file, "file removed");
-
-done_testing ();
@@ -1,68 +0,0 @@
-#!/usr/bin/perl
-
-# test if update returns expected values / keeps file sizes sane
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-my $sz = 0;
-my $tbl_file = DbFile ($tbl);
-ok ($sz = -s $tbl_file, "file exists");
-
-ok ($dbh->do ("insert into $tbl (id) values ($_)"), "insert $_") for 1 .. 10;
-ok ($sz < -s $tbl_file, "file grew");
-$sz = -s $tbl_file;
-
-{ local $dbh->{PrintWarn} = 0;
- local $dbh->{PrintError} = 0;
- is ($dbh->do ("update wxyz set name = 'ick' where id = 99"), undef, "update in non-existing tbl");
- }
-my $zero_ret = $dbh->do ("update $tbl set name = 'ack' where id = 99");
-ok ($zero_ret, "true non-existing update RV (via do)");
-cmp_ok ($zero_ret, "==", 0, "update non-existing row (via do)");
-
-cmp_ok ($sz, "==", -s $tbl_file, "file size did not change on noop updates");
-
-is ($dbh->do ("update $tbl set name = 'multis' where id > 7"), 3, "update several (count) (via do)");
-cmp_ok ($sz, "<", -s $tbl_file, "file size grew on update");
-
-$sz = -s $tbl_file;
-is ($dbh->do ("update $tbl set name = 'single' where id = 9"), 1, "update single (count) (via do)");
-cmp_ok ($sz, "==", -s $tbl_file, "file size did not change on same-size update");
-
-
-$zero_ret = $dbh->prepare ("update $tbl set name = 'ack' where id = 88")->execute;
-ok ($zero_ret, "true non-existing update RV (via prepare/execute)");
-cmp_ok ($zero_ret, "==", 0, "update non-existing row (via prepare/execute)");
-cmp_ok ($sz, "==", -s $tbl_file, "file size did not change on noop update");
-
-$sz = -s $tbl_file;
-is ($dbh->prepare ("update $tbl set name = 'multis' where id < 4")->execute, 3, "update several (count) (via prepare/execute)");
-cmp_ok ($sz, "<", -s $tbl_file, "file size grew on update");
-
-$sz = -s $tbl_file;
-is ($dbh->prepare ("update $tbl set name = 'single' where id = 2")->execute, 1, "update single (count) (via prepare/execute)");
-cmp_ok ($sz, "==", -s $tbl_file, "file size did not change on same-size update");
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-ok (!-f $tbl_file, "file removed");
-
-done_testing ();
@@ -1,74 +0,0 @@
-#!/usr/bin/perl
-
-# This tests, whether the number of rows can be retrieved.
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-require "t/lib.pl";
-
-sub TrueRows
-{
- my $sth = shift;
- my $count = 0;
- $count++ while $sth->fetch;
- $count;
- } # TrueRows
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-my ($sth, $rows);
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-ok ($dbh->do ("INSERT INTO $tbl VALUES (1, 'Alligator Descartes')"), "insert");
-
-ok ($sth = $dbh->prepare ("SELECT * FROM $tbl WHERE id = 1"), "prepare");
-ok ($sth->execute, "execute");
-
-is ($sth->rows, 1, "numrows");
-is (TrueRows ($sth), 1, "true rows");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-
-ok ($dbh->do ("INSERT INTO $tbl VALUES (2, 'Jochen Wiedman')"), "insert");
-
-ok ($sth = $dbh->prepare ("SELECT * FROM $tbl WHERE id >= 1"), "prepare");
-ok ($sth->execute, "execute");
-
-$rows = $sth->rows;
-ok ($rows == 2 || $rows == -1, "rows");
-is (TrueRows ($sth), 2, "true rows");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("INSERT INTO $tbl VALUES (3, 'Tim Bunce')"), "insert");
-
-ok ($sth = $dbh->prepare ("SELECT * FROM $tbl WHERE id >= 2"), "prepare");
-ok ($sth->execute, "execute");
-
-$rows = $sth->rows;
-ok ($rows == 2 || $rows == -1, "rows");
-is (TrueRows ($sth), 2, "true rows");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("DROP TABLE $tbl"), "drop");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -0,0 +1,186 @@
+#!/usr/local/bin/perl
+#
+# $Id: 40bindparam.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a skeleton test. For writing new tests, take this file
+# and modify/extend it.
+#
+
+$^W = 1;
+
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+require DBI;
+use vars qw($COL_NULLABLE);
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+if ($mdriver eq 'pNET') {
+ print "1..0\n";
+ exit 0;
+}
+
+sub ServerError() {
+ my $err = $DBI::errstr; # Hate -w ...
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+if (!defined(&SQL_VARCHAR)) {
+ eval "sub SQL_VARCHAR { 12 }";
+}
+if (!defined(&SQL_INTEGER)) {
+ eval "sub SQL_INTEGER { 4 }";
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
+ 'connect')
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh), 'FindNewTable')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, $COL_NULLABLE]) and
+ $dbh->do($def)), 'create', $def)
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
+ . " VALUES (?, ?)"), 'prepare')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Insert some rows
+ #
+
+ # Automatic type detection
+ my $numericVal = 1;
+ my $charVal = "Alligator Descartes";
+ Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 1')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ # Does the driver remember the automatically detected type?
+ Test($state or $cursor->execute("3", "Jochen Wiedmann"),
+ 'execute insert num as string')
+ or DbiError($dbh->err, $dbh->errstr);
+ $numericVal = 2;
+ $charVal = "Tim Bunce";
+ Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 2')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ # Now try the explicit type settings
+ Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()), 'bind 1')
+ or DbiError($dbh->err, $dbh->errstr);
+ Test($state or $cursor->bind_param(2, "Andreas König"), 'bind 2')
+ or DbiError($dbh->err, $dbh->errstr);
+ Test($state or $cursor->execute, 'execute binds')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ # Works undef -> NULL?
+ Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
+ or DbiError($dbh->err, $dbh->errstr);
+ Test($state or $cursor->bind_param(2, undef))
+ or DbiError($dbh->err, $dbh->errstr);
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ Test($state or $cursor -> finish, 'finish');
+
+ Test($state or undef $cursor || 1, 'undef cursor');
+
+ Test($state or $dbh -> disconnect, 'disconnect');
+
+ Test($state or undef $dbh || 1, 'undef dbh');
+
+ #
+ # And now retreive the rows using bind_columns
+ #
+ #
+ # Connect to the database
+ #
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
+ 'connect for read')
+ or ServerError();
+
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
+ . " ORDER BY id"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->bind_columns(undef, \$id, \$name))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($ref = $cursor->fetch) && $id == 1 &&
+ $name eq 'Alligator Descartes')
+ or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
+ $id, $name, $ref, scalar(@$ref));
+
+ Test($state or (($ref = $cursor->fetch) && $id == 2 &&
+ $name eq 'Tim Bunce'))
+ or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
+ $id, $name, $ref, scalar(@$ref));
+
+ Test($state or (($ref = $cursor->fetch) && $id == 3 &&
+ $name eq 'Jochen Wiedmann'))
+ or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
+ $id, $name, $ref, scalar(@$ref));
+
+ Test($state or (($ref = $cursor->fetch) && $id == 4 &&
+ $name eq 'Andreas König'))
+ or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
+ $id, $name, $ref, scalar(@$ref));
+
+ Test($state or (($ref = $cursor->fetch) && $id == 5 &&
+ !defined($name)))
+ or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
+ $id, $name, $ref, scalar(@$ref));
+
+ Test($state or undef $cursor or 1);
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+}
+
+
@@ -0,0 +1,170 @@
+#!/usr/local/bin/perl
+#
+# $Id: 40blobs.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a test for correct handling of BLOBS; namely $dbh->quote
+# is expected to work correctly.
+#
+
+$^W = 1;
+
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+#require SQL::Statement;
+#my $SVERSION = $SQL::Statement::VERSION;
+require DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+if ($dbdriver eq 'mSQL' || $dbdriver eq 'mSQL1') {
+ print "1..0\n";
+ exit 0;
+}
+
+sub ServerError() {
+ my $err = $DBI::errstr; # Hate -w ...
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+
+sub ShowBlob($) {
+ my ($blob) = @_;
+ for($i = 0; $i < 8; $i++) {
+ if (defined($blob) && length($blob) > $i) {
+ $b = substr($blob, $i*32);
+ } else {
+ $b = "";
+ }
+ printf("%08lx %s\n", $i*32, unpack("H64", $b));
+ }
+}
+
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh))
+ or DbiError($dbh->error, $dbh->errstr);
+
+ my($def);
+ foreach $size (128) {
+ #
+ # Create a new table
+ #
+ if (!$state) {
+ $def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "BLOB", $size, 0]);
+ print "Creating table:\n$def\n";
+ }
+ Test($state or $dbh->do($def))
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ #
+ # Create a blob
+ #
+ my ($blob, $qblob) = "";
+ if (!$state) {
+ my $b = "";
+ for ($j = 0; $j < 256; $j++) {
+ $b .= chr($j);
+ }
+ for ($i = 0; $i < $size; $i++) {
+ $blob .= $b;
+ }
+ if ($mdriver eq 'pNET') {
+ # Quote manually, no remote quote
+ $qblob = eval "DBD::" . $dbdriver . "::db->quote(\$blob)";
+ } else {
+ $qblob = $dbh->quote($blob);
+ }
+ }
+
+ #
+ # Insert a row into the test table.......
+ #
+ my($query);
+ if (!$state) {
+# if ($SVERSION > 1) {
+ $query = "INSERT INTO $table VALUES(1, ?)";
+# }
+# else {
+# $query = "INSERT INTO $table VALUES(1, $qblob)";
+# }
+ if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
+ print OUT $query;
+ close(OUT);
+ }
+ }
+# if ($SVERSION > 1) {
+ Test($state or $dbh->do($query,undef,$blob))
+ or DbiError($dbh->err, $dbh->errstr);
+# }
+# else {
+# Test($state or $dbh->do($query))
+# or DbiError($dbh->err, $dbh->errstr);
+# }
+
+ #
+ # Now, try SELECT'ing the row out.
+ #
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id = 1"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or (defined($row = $cursor->fetchrow_arrayref)))
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob))
+ or (ShowBlob($blob),
+ ShowBlob(defined($$row[1]) ? $$row[1] : ""));
+
+ Test($state or $cursor->finish)
+ or DbiError($cursor->err, $cursor->errstr);
+
+ Test($state or undef $cursor || 1)
+ or DbiError($cursor->err, $cursor->errstr);
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+ }
+}
@@ -0,0 +1,125 @@
+#!/usr/local/bin/perl
+#
+# $Id: 40listfields.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a test for statement attributes being present appropriately.
+#
+
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+$COL_KEY = '';
+
+
+#
+# Include lib.pl
+#
+use DBI;
+use vars qw($verbose);
+
+$dbdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($dbdriver ne '') {
+ last;
+ }
+}
+
+
+@table_def = (
+ ["id", "INTEGER", 4, $COL_KEY],
+ ["name", "CHAR", 64, $COL_NULLABLE]
+ );
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table
+ #
+ Test($state or ($def = TableDefinition($table, @table_def),
+ $dbh->do($def)))
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($cursor->err, $cursor->errstr);
+
+ my $res;
+ Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
+ or DbiError($cursor->err, $cursor->errstr);
+ if (!$state && $verbose) {
+ printf("Number of fields: %s\n", defined($res) ? $res : "undef");
+ }
+ Test($state or ($ref = $cursor->{'NAME'}) && @$ref == @table_def
+ && (lc $$ref[0]) eq $table_def[0][0]
+ && (lc $$ref[1]) eq $table_def[1][0])
+ or DbiError($cursor->err, $cursor->errstr);
+ if (!$state && $verbose) {
+ print "Names:\n";
+ for ($i = 0; $i < @$ref; $i++) {
+ print " ", $$ref[$i], "\n";
+ }
+ }
+
+ Test($state or ($dbdriver eq 'CSV') or ($dbdriver eq 'ConfFile')
+ or ($ref = $cursor->{'NULLABLE'}) && @$ref == @table_def
+ && !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
+ && !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
+ or DbiError($cursor->err, $cursor->errstr);
+ if (!$state && $verbose) {
+ print "Nullable:\n";
+ for ($i = 0; $i < @$ref; $i++) {
+ print " ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
+ }
+ }
+
+ Test($state or undef $cursor || 1);
+
+
+ #
+ # Drop the test table
+ #
+ Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
+ or DbiError($dbh->err, $dbh->errstr);
+ Test($state or $cursor->execute)
+ or DbiError($cursor->err, $cursor->errstr);
+
+ # NUM_OF_FIELDS should be zero (Non-Select)
+ Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0))
+ or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
+ $cursor->{'NUM_OF_FIELDS'});
+ Test($state or (undef $cursor) or 1);
+}
@@ -0,0 +1,104 @@
+#!/usr/local/bin/perl
+#
+# $Id: 40nulls.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a test for correctly handling NULL values.
+#
+
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+use DBI;
+use vars qw($COL_NULLABLE);
+
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, $COL_NULLABLE],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)))
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ #
+ # Test whether or not a field containing a NULL is returned correctly
+ # as undef, or something much more bizarre
+ #
+ Test($state or $dbh->do("INSERT INTO $table VALUES"
+ . " ( NULL, 'NULL-valued id' )"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE " . IsNull("id")))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV'
+ or $dbdriver eq 'ConfFile')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or (!defined($$rv[0]) and defined($$rv[1])) or
+ $dbdriver eq 'CSV' or $dbdriver eq 'ConfFile')
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->finish)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or undef $cursor || 1);
+
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+}
@@ -0,0 +1,161 @@
+#!/usr/local/bin/perl
+#
+# $Id: 40numrows.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This tests, whether the number of rows can be retrieved.
+#
+
+$^W = 1;
+$| = 1;
+
+
+#
+# Make -w happy
+#
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+use DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+
+sub TrueRows($) {
+ my ($sth) = @_;
+ my $count = 0;
+ while ($sth->fetchrow_arrayref) {
+ ++$count;
+ }
+ $count;
+}
+
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or ($table = FindNewTable($dbh)))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)))
+ or DbiError($dbh->err, $dbh->errstr);
+
+
+ #
+ # This section should exercise the sth->rows
+ # method by preparing a statement, then finding the
+ # number of rows within it.
+ # Prior to execution, this should fail. After execution, the
+ # number of rows affected by the statement will be returned.
+ #
+ Test($state or $dbh->do("INSERT INTO $table"
+ . " VALUES( 1, 'Alligator Descartes' )"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id = 1")))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($numrows = $cursor->rows) == 1 or ($numrows == -1))
+ or ErrMsgF("Expected 1 rows, got %s.\n", $numrows);
+
+ Test($state or ($numrows = TrueRows($cursor)) == 1)
+ or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);
+
+ Test($state or $cursor->finish)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or undef $cursor or 1);
+
+ Test($state or $dbh->do("INSERT INTO $table"
+ . " VALUES( 2, 'Jochen Wiedmann' )"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id >= 1")))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($numrows = $cursor->rows) == 2 or ($numrows == -1))
+ or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
+
+ Test($state or ($numrows = TrueRows($cursor)) == 2)
+ or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
+
+ Test($state or $cursor->finish)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or undef $cursor or 1);
+
+ Test($state or $dbh->do("INSERT INTO $table"
+ . " VALUES(3, 'Tim Bunce')"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
+ . " WHERE id >= 2")))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or $cursor->execute)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or ($numrows = $cursor->rows) == 2 or ($numrows == -1))
+ or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
+
+ Test($state or ($numrows = TrueRows($cursor)) == 2)
+ or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
+
+ Test($state or $cursor->finish)
+ or DbiError($dbh->err, $dbh->errstr);
+
+ Test($state or undef $cursor or 1);
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+}
@@ -1,72 +0,0 @@
-#!/usr/bin/perl
-
-# This is a test for correctly handling NULL values.
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my $nano = $ENV{DBI_SQL_NANO};
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- [ "str", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-ok ($dbh->do ("insert into $tbl values (NULL, 'NULL-id', ' ')"), "insert");
-
-my $row;
-
-ok (my $sth = $dbh->prepare ("select * from $tbl where id is NULL"), "prepare");
-ok ($sth->execute, "execute");
-TODO: {
- local $TODO = $nano ? "SQL::Nano does not yet support this syntax" : undef;
- ok ($row = $sth->fetch, "fetch");
- is_deeply ($row, [ "", "NULL-id", " " ], "default content");
- }
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh = Connect ({ csv_null => 1 }), "connect csv_null");
-
-ok ($sth = $dbh->prepare ("select * from $tbl where id is NULL"), "prepare");
-ok ($sth->execute, "execute");
-TODO: {
- local $TODO = $nano ? "SQL::Nano does not yet support this syntax" : undef;
- ok ($row = $sth->fetch, "fetch");
- is_deeply ($row, [ undef, "NULL-id", " " ], "NULL content");
- }
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-ok ($dbh = Connect ({ csv_null => 1 }), "connect csv_null");
-ok ($dbh->do ($def), "create table");
-
-ok ($dbh->do ("insert into $tbl (id, str) values (1, ' ')"), "insert just 2");
-
-ok ($sth = $dbh->prepare ("select * from $tbl"), "prepare");
-ok ($sth->execute, "execute");
-ok ($row = $sth->fetch, "fetch");
-is_deeply ($row, [ 1, undef, " " ], "content");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,105 +0,0 @@
-#!/usr/bin/perl
-
-# Test if bindparam () works
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-
-if ($ENV{DBI_SQL_NANO}) {
- diag ("These tests are not yet supported for SQL::Nano");
- done_testing (1);
- exit 0;
- }
-
-do "t/lib.pl";
-
-defined &SQL_VARCHAR or *SQL_VARCHAR = sub { 12 };
-defined &SQL_INTEGER or *SQL_INTEGER = sub { 4 };
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-ok ($dbh->{csv_null} = 1, "Allow NULL");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-ok (my $sth = $dbh->prepare ("insert into $tbl values (?, ?)"), "prepare");
-
-# Automatic type detection
-my ($int, $chr) = (1, "Alligator Descartes");
-ok ($sth->execute ($int, $chr), "execute insert 1");
-
-# Does the driver remember the automatically detected type?
-ok ($sth->execute ("3", "Jochen Wiedman"), "execute insert 2");
-
-($int, $chr) = (2, "Tim Bunce");
-ok ($sth->execute ($int, $chr), "execute insert 3");
-
-# Now try the explicit type settings
-ok ($sth->bind_param (1, " 4", &SQL_INTEGER), "bind 4 int");
-ok ($sth->bind_param (2, "Andreas König"), "bind str");
-ok($sth->execute, "execute");
-
-# Works undef -> NULL?
-ok ($sth->bind_param (1, 5, &SQL_INTEGER), "bind 5 int");
-ok ($sth->bind_param (2, undef), "bind NULL");
-ok($sth->execute, "execute");
-
-ok ($sth->finish, "finish");
-undef $sth;
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-
-# And now retreive the rows using bind_columns
-ok ($dbh = Connect ({ csv_null => 1 }), "connect");
-
-ok ($sth = $dbh->prepare ("select * from $tbl order by id"), "prepare");
-ok ($sth->execute, "execute");
-
-my ($id, $name);
-ok ($sth->bind_columns (undef, \$id, \$name), "bind_columns");
-ok ($sth->execute, "execute");
-ok ($sth->fetch, "fetch");
-is ($id, 1, "id 1");
-is ($name, "Alligator Descartes", "name 1");
-ok ($sth->fetch, "fetch");
-is ($id, 2, "id 2");
-is ($name, "Tim Bunce", "name 2");
-ok ($sth->fetch, "fetch");
-is ($id, 3, "id 3");
-is ($name, "Jochen Wiedman", "name 3");
-ok ($sth->fetch, "fetch");
-is ($id, 4, "id 4");
-is ($name, "Andreas König", "name 4");
-ok ($sth->fetch, "fetch");
-is ($id, 5, "id 5");
-is ($name, undef, "name 5");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($sth = $dbh->prepare ("update $tbl set name = ? where id = ?"), "prepare update");
-is ($sth->execute ("Tux", 5), 1, "update");
-ok ($sth->finish, "finish");
-undef $sth;
-ok ($sth = $dbh->prepare ("update $tbl set id = ? where name = ?"), "prepare update");
-is ($sth->execute (5, "Tux"), 1, "update");
-is ($sth->execute (6, ""), "0E0", "update");
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,44 +0,0 @@
-#!/usr/bin/perl
-
-# This is a test for correct handling of BLOBS and $dbh->quote ()
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my $size = 128;
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "BLOB", $size, 0 ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-ok (my $blob = (pack "C*", 0 .. 255) x $size, "create blob");
-is (length $blob, $size * 256, "blob size");
-ok (my $qblob = $dbh->quote ($blob), "quote blob");
-
-ok ($dbh->do ("insert into $tbl values (1, ?)", undef, $blob), "insert");
-
-ok (my $sth = $dbh->prepare ("select * from $tbl where id = 1"), "prepare");
-ok ($sth->execute, "execute");
-
-ok (my $row = $sth->fetch, "fetch");
-is_deeply ($row, [ 1, $blob ], "content");
-
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,55 +0,0 @@
-#!/usr/bin/perl
-
-# This is a test for statement attributes being present appropriately.
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-defined &SQL_CHAR or *SQL_CHAR = sub { 1 };
-defined &SQL_VARCHAR or *SQL_VARCHAR = sub { 12 };
-defined &SQL_INTEGER or *SQL_INTEGER = sub { 4 };
-
-my $nano = $ENV{DBI_SQL_NANO};
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_KEY ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-ok (my $sth = $dbh->prepare ("select * from $tbl"), "prepare");
-ok ($sth->execute, "execute");
-
-is ($sth->{NUM_OF_FIELDS}, scalar @tbl_def, "NUM_OF_FIELDS");
-is ($sth->{NUM_OF_PARAMS}, 0, "NUM_OF_PARAMS");
-is ($sth->{NAME_lc}[0], lc $tbl_def[0][0], "NAME_lc");
-is ($sth->{NAME_uc}[1], uc $tbl_def[1][0], "NAME_uc");
-is_deeply ($sth->{NAME_lc_hash},
- { map { ( lc $tbl_def[$_][0] => $_ ) } 0 .. $#tbl_def }, "NAME_lc_hash");
-if ($DBD::File::VERSION gt "0.42") {
- is ($sth->{TYPE}[0], $nano ? &SQL_VARCHAR : &SQL_INTEGER, "TYPE 1");
- is ($sth->{TYPE}[1], $nano ? &SQL_VARCHAR : &SQL_CHAR, "TYPE 2");
- is ($sth->{PRECISION}[0], 0, "PRECISION 1");
- is ($sth->{PRECISION}[1], $nano ? 0 : 64, "PRECISION 2");
- is ($sth->{NULLABLE}[0], $nano ? 1 : 0, "NULLABLE 1");
- is ($sth->{NULLABLE}[1], 1, "NULLABLE 2");
- }
-
-ok ($sth->finish, "finish");
-#s ($sth->{NUM_OF_FIELDS}, 0, "NUM_OF_FIELDS");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,75 +0,0 @@
-#!/usr/bin/perl
-
-# This is a test for correctly handling UTF-8 content
-
-use strict;
-use warnings;
-use charnames ":full";
-
-use DBI;
-use Text::CSV_XS;
-use Encode qw( encode );
-
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-ok (my $dbh = Connect ({ f_ext => ".csv/r", f_schema => undef }), "connect");
-
-ok (my $tbl1 = FindNewTable ($dbh), "find new test table");
-ok (my $tbl2 = FindNewTable ($dbh), "find new test table");
-
-my @data = (
- "The \N{SNOWMAN} is melting",
- "U2 should \N{SKULL AND CROSSBONES}",
- "I \N{BLACK HEART SUIT} my wife",
- "Unicode makes me \N{WHITE SMILING FACE}",
- );
-ok ("Creating table with UTF-8 content");
-foreach my $tbl ($tbl1, $tbl2) {
- ok (my $csv = Text::CSV_XS->new ({ binary => 1, eol => "\n" }), "New csv");
- ok (open (my $fh, ">:utf8",
- File::Spec->catfile (DbDir (), "$tbl.csv")), "Open CSV");
- ok ($csv->print ($fh, [ "id", "str" ]), "CSV print header");
- ok ($csv->print ($fh, [ $_, $data[$_ - 1] ]), "CSV row $_") for 1 .. scalar @data;
- ok (close ($fh), "close");
- }
-
-{ $dbh->{f_encoding} = undef;
-
- my $row;
-
- ok (my $sth = $dbh->prepare ("select * from $tbl1"), "prepare");
- ok ($sth->execute, "execute");
- foreach my $i (1 .. scalar @data) {
- ok ($row = $sth->fetch, "fetch $i");
- my $v = $data[$i - 1];
- utf8::is_utf8 ($v) or $v = encode ("utf8", $v);
- is_deeply ($row, [ $i , $v ], "unencoded content $i");
- }
- ok ($sth->finish, "finish");
- undef $sth;
- }
-
-{ $dbh->{f_encoding} = "utf8";
-
- my $row;
-
- ok (my $sth = $dbh->prepare ("select * from $tbl2"), "prepare");
- ok ($sth->execute, "execute");
- foreach my $i (1 .. scalar @data) {
- ok ($row = $sth->fetch, "fetch $i");
- my $v = $data[$i - 1];
- ok (utf8::is_utf8 ($v), "is encoded");
- is_deeply ($row, [ $i , $v ], "encoded content $i");
- }
- ok ($sth->finish, "finish");
- undef $sth;
- }
-
-ok ($dbh->do ("drop table $tbl1"), "drop table");
-ok ($dbh->do ("drop table $tbl2"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,63 +0,0 @@
-#!/usr/bin/perl
-
-# This driver should check if 'ChopBlanks' works.
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-my @rows = (
- [ 1, "NULL", ],
- [ 2, " ", ],
- [ 3, " a b c ", ],
- [ 4, " a \r ", ],
- [ 5, " a \t ", ],
- [ 6, " a \n ", ],
- );
-ok (my $sti = $dbh->prepare ("insert into $tbl (id, name) values (?, ?)"), "prepare ins");
-ok (my $sth = $dbh->prepare ("select id, name from $tbl where id = ?"), "prepare sel");
-foreach my $row (@rows) {
- ok ($sti->execute (@$row), "insert $row->[0]");
-
- $sth->{ChopBlanks} = 0;
- ok (1, "ChopBlanks 0");
- ok ($sth->execute ($row->[0]), "execute");
- ok (my $r = $sth->fetch, "fetch ($row->[0]:1)");
- is_deeply ($r, $row, "content ($row->[0]:1)");
-
- $sth->{ChopBlanks} = 1;
- ok (1, "ChopBlanks 1");
- ok ($sth->execute ($row->[0]), "execute");
- s/ +$// for @$row;
- if ($DBD::File::VERSION <= 0.38) {
- s/\s+$// for @$row; # Bug fixed in new DBI
- }
- ok ($r = $sth->fetch, "fetch ($row->[0]:2)");
- is_deeply ($r, $row, "content ($row->[0]:2)");
- }
-
-ok ($sti->finish, "finish sti");
-undef $sti;
-ok ($sth->finish, "finish sth");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -0,0 +1,158 @@
+#!/usr/local/bin/perl
+#
+# $Id: 50chopblanks.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This driver should check whether 'ChopBlanks' works.
+#
+
+
+#
+# Make -w happy
+#
+use vars qw($test_dsn $test_user $test_password $mdriver $verbose $state
+ $dbdriver);
+use vars qw($COL_NULLABLE $COL_KEY);
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+#use SQL::Statement;
+#my $SVERSION = $SQL::Statement::VERSION;
+
+#
+# Include lib.pl
+#
+use DBI;
+use strict;
+$mdriver = "";
+{
+ my $file;
+ foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+ }
+}
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ my ($dbh, $sth, $query);
+
+ #
+ # Connect to the database
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ServerError();
+
+ #
+ # Find a possible new table name
+ #
+ my $table = '';
+ Test($state or $table = FindNewTable($dbh))
+ or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
+ $dbh->errstr);
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($query = TableDefinition($table,
+ ["id", "INTEGER", 4, $COL_NULLABLE],
+ ["name", "CHAR", 64, $COL_NULLABLE]),
+ $dbh->do($query)))
+ or ErrMsgF("Cannot create table: Error %s.\n",
+ $dbh->errstr);
+
+
+ #
+ # and here's the right place for inserting new tests:
+ #
+ my @rows;
+# if ($SVERSION > 1) {
+ @rows = ([1, 'NULL'],
+ [2, ' '],
+ [3, ' a b c ']);
+# }
+# else {
+# @rows = ([1, ''],
+# [2, ' '],
+# [3, ' a b c ']);
+# }
+ my $ref;
+ foreach $ref (@rows) {
+ my ($id, $name) = @$ref;
+ if (!$state) {
+ $query = sprintf("INSERT INTO $table (id, name) VALUES ($id, %s)",
+ $dbh->quote($name));
+ }
+ Test($state or $dbh->do($query))
+ or ErrMsgF("INSERT failed: query $query, error %s.\n",
+ $dbh->errstr);
+ $query = "SELECT id, name FROM $table WHERE id = $id\n";
+ Test($state or ($sth = $dbh->prepare($query)))
+ or ErrMsgF("prepare failed: query $query, error %s.\n",
+ $dbh->errstr);
+
+ # First try to retreive without chopping blanks.
+ $sth->{'ChopBlanks'} = 0;
+ Test($state or $sth->execute)
+ or ErrMsgF("execute failed: query %s, error %s.\n", $query,
+ $sth->errstr);
+ Test($state or defined($ref = $sth->fetchrow_arrayref))
+ or ErrMsgF("fetch failed: query $query, error %s.\n",
+ $sth->errstr);
+ Test($state or ($$ref[1] eq $name)
+ or ($name =~ /^$$ref[1]\s+$/ &&
+ ($dbdriver eq 'mysql' || $dbdriver eq 'ODBC')))
+ or ErrMsgF("problems with ChopBlanks = 0:"
+ . " expected '%s', got '%s'.\n",
+ $name, $$ref[1]);
+ Test($state or $sth->finish());
+
+ # Now try to retreive with chopping blanks.
+ $sth->{'ChopBlanks'} = 1;
+ Test($state or $sth->execute)
+ or ErrMsg("execute failed: query $query, error %s.\n",
+ $sth->errstr);
+ my $n = $name;
+ $n =~ s/\s+$//;
+ Test($state or ($ref = $sth->fetchrow_arrayref))
+ or ErrMsgF("fetch failed: query $query, error %s.\n",
+ $sth->errstr);
+ Test($state or ($$ref[1] eq $n))
+ or ErrMsgF("problems with ChopBlanks = 1:"
+ . " expected '%s', got '%s'.\n",
+ $n, $$ref[1]);
+
+ Test($state or $sth->finish)
+ or ErrMsgF("Cannot finish: %s.\n", $sth->errstr);
+ }
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or ErrMsgF("Cannot DROP test table $table: %s.\n",
+ $dbh->errstr);
+
+ # ... and disconnect
+ Test($state or $dbh->disconnect)
+ or ErrMsgF("Cannot disconnect: %s.\n", $dbh->errmsg);
+}
+
+
+
@@ -0,0 +1,219 @@
+#!/usr/local/bin/perl
+#
+# $Id: 50commit.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is testing the transaction support.
+#
+$^W = 1;
+
+
+#
+# Include lib.pl
+#
+require DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+if ($mdriver eq 'whatever') {
+ print "1..0\n";
+ exit 0;
+}
+
+
+use vars qw($gotWarning);
+sub CatchWarning ($) {
+ $gotWarning = 1;
+}
+
+
+sub NumRows($$$) {
+ my($dbh, $table, $num) = @_;
+ my($sth, $got);
+
+ if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
+ return "Failed to prepare: err " . $dbh->err . ", errstr "
+ . $dbh->errstr;
+ }
+ if (!$sth->execute) {
+ return "Failed to execute: err " . $dbh->err . ", errstr "
+ . $dbh->errstr;
+ }
+ $got = 0;
+ while ($sth->fetchrow_arrayref) {
+ ++$got;
+ }
+ if ($got ne $num) {
+ return "Wrong result: Expected $num rows, got $got.\n";
+ }
+ return '';
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)),
+ 'connect',
+ "Attempting to connect.\n")
+ or ErrMsgF("Cannot connect: Error %s.\n\n"
+ . "Make sure, your database server is up and running.\n"
+ . "Check that '$test_dsn' references a valid database"
+ . " name.\nDBI error message: %s\n",
+ $DBI::err, $DBI::errstr);
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh))
+ or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
+ $dbh->errstr);
+
+ #
+ # Create a new table
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)))
+ or ErrMsgF("Cannot create table: Error %s.\n",
+ $dbh->errstr);
+
+ Test($state or $dbh->{AutoCommit})
+ or ErrMsg("AutoCommit is off\n", 'AutoCommint on');
+
+ #
+ # Tests for databases that do support transactions
+ #
+ if (HaveTransactions()) {
+ # Turn AutoCommit off
+ $dbh->{AutoCommit} = 0;
+ Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
+ or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
+ $dbh->err, $dbh->errstr);
+
+ # Check rollback
+ Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
+ or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ my $msg;
+ Test($state or !($msg = NumRows($dbh, $table, 1)))
+ or ErrMsg($msg);
+ Test($state or $dbh->rollback)
+ or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 0)))
+ or ErrMsg($msg);
+
+ # Check commit
+ Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
+ or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 0)))
+ or ErrMsg($msg);
+ Test($state or $dbh->commit)
+ or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 0)))
+ or ErrMsg($msg);
+
+ # Check auto rollback after disconnect
+ Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
+ or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 1)))
+ or ErrMsg($msg);
+ Test($state or $dbh->disconnect)
+ or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
+ $DBI::err, $DBI::errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 0)))
+ or ErrMsg($msg);
+
+ # Check whether AutoCommit is on again
+ Test($state or $dbh->{AutoCommit})
+ or ErrMsg("AutoCommit is off\n");
+
+ #
+ # Tests for databases that don't support transactions
+ #
+ } else {
+ if (!$state) {
+ $@ = '';
+ eval { $dbh->{AutoCommit} = 0; }
+ }
+ Test($state or $@)
+ or ErrMsg("Expected fatal error for AutoCommit => 0\n",
+ 'AutoCommit off -> error');
+ }
+
+ # Check whether AutoCommit mode works.
+ Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
+ or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 1)), 'NumRows')
+ or ErrMsg($msg);
+ Test($state or $dbh->disconnect, 'disconnect')
+ or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
+ $DBI::err, $DBI::errstr);
+ Test($state or !($msg = NumRows($dbh, $table, 1)))
+ or ErrMsg($msg);
+
+ # Check whether commit issues a warning in AutoCommit mode
+ Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
+ or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ my $result;
+ if (!$state) {
+ $@ = '';
+ $SIG{__WARN__} = \&CatchWarning;
+ $gotWarning = 0;
+ eval { $result = $dbh->commit; };
+ $SIG{__WARN__} = 'DEFAULT';
+ }
+ Test($state or $gotWarning)
+ or ErrMsg("Missing warning when committing in AutoCommit mode");
+
+ # Check whether rollback issues a warning in AutoCommit mode
+ # We accept error messages as being legal, because the DBI
+ # requirement of just issueing a warning seems scary.
+ Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
+ or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
+ $dbh->err, $dbh->errstr);
+ if (!$state) {
+ $@ = '';
+ $SIG{__WARN__} = \&CatchWarning;
+ $gotWarning = 0;
+ eval { $result = $dbh->rollback; };
+ $SIG{__WARN__} = 'DEFAULT';
+ }
+ Test($state or $gotWarning or $dbh->err)
+ or ErrMsg("Missing warning when rolling back in AutoCommit mode");
+
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or ErrMsgF("Cannot DROP test table $table: %s.\n",
+ $dbh->errstr);
+ Test($state or $dbh->disconnect())
+ or ErrMsgF("Cannot DROP test table $table: %s.\n",
+ $dbh->errstr);
+}
@@ -1,81 +0,0 @@
-#!/usr/bin/perl
-
-# Check commit, rollback and "AutoCommit" attribute
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my $nano = $ENV{DBI_SQL_NANO};
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-sub RowCount
-{
- my ($dbh, $tbl) = @_;
-
- if ($nano) {
- diag ("SQL::Nano does not support count (*)");
- return 0;
- }
-
- local $dbh->{PrintError} = 1;
- my $sth = $dbh->prepare ("SELECT count (*) FROM $tbl") or return;
- $sth->execute or return;
- my $row = $sth->fetch or return;
- $row->[0];
- } # RowCount
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-is ($dbh->{AutoCommit}, 1, "AutoCommit on");
-
-eval { $dbh->{AutoCommit} = 0; };
-like ($@, qr{^Can't disable AutoCommit}, "disable");
-is ($dbh->{AutoCommit}, 1, "AutoCommit still on");
-
-# Check whether AutoCommit mode works.
-ok ($dbh->do ("insert into $tbl values (1, 'Jochen')"), "insert 1");
-is (RowCount ($dbh, $tbl), $nano ? 0 : 1, "1 row");
-
-ok ($dbh->disconnect, "disconnect");
-
-ok ($dbh = Connect (), "connect");
-is (RowCount ($dbh, $tbl), $nano ? 0 : 1, "still 1 row");
-
-# Check whether commit issues a warning in AutoCommit mode
-ok ($dbh->do ("insert into $tbl values (2, 'Tim')"), "insert 2");
-is ($dbh->{AutoCommit}, 1, "AutoCommit on");
-{ my $got_warn = 0;
- local $SIG{__WARN__} = sub { $got_warn++; };
- eval { ok ($dbh->commit, "commit"); };
- is ($got_warn, 1, "warning");
- }
-
-# Check whether rollback issues a warning in AutoCommit mode
-# We accept error messages as being legal, because the DBI
-# requirement of just issueing a warning seems scary.
-ok ($dbh->do ("insert into $tbl values (3, 'Alligator')"), "insert 3");
-is ($dbh->{AutoCommit}, 1, "AutoCommit on");
-{ my $got_warn = 0;
- local $SIG{__WARN__} = sub { $got_warn++; };
- eval { is ($dbh->rollback, 0, "rollback"); };
- is ($got_warn, 1, "warning");
- is ($dbh->err, undef, "err");
- }
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,70 +0,0 @@
-#!/pro/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-require "t/lib.pl";
-
-my $tstdir = DbDir ();
-my @extdir = ("t", File::Spec->tmpdir ());
-if (open my $fh, "<", "tests.skip") {
- grep m/\b tmpdir \b/x => <$fh> and pop @extdir;
- }
-my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
- f_schema => undef,
- f_dir => DbDir (),
- f_dir_search => \@extdir,
- f_ext => ".csv/r",
- f_lock => 2,
- f_encoding => "utf8",
-
- RaiseError => 1,
- PrintError => 1,
- FetchHashKeyName => "NAME_lc",
- }) or die "$DBI::errstr\n";
-
-my @dsn = $dbh->data_sources;
-my %dir = map {
- m{^dbi:CSV:.*\bf_dir=([^;]+)}i;
- my $folder = $1;
- # data_sources returns the string just one level to many
- $folder =~ m{\\[;\\]} and $folder =~ s{\\(.)}{$1}g;
- ($folder => 1);
- } @dsn;
-
-# Use $test_dir
-$dbh->do ("create table foo (c_foo integer, foo char (1))");
-$dbh->do ("insert into foo values ($_, $_)") for 1, 2, 3;
-
-my @test_dirs = ($tstdir, @extdir);
-is ($dir{$_}, 1, "DSN for $_") for @test_dirs;
-
-my %tbl = map { $_ => 1 } $dbh->tables (undef, undef, undef, undef);
-
-is ($tbl{$_}, 1, "Table $_ found") for qw( tmp foo );
-
-my %data = (
- tmp => { # t/tmp.csv
- 1 => "ape",
- 2 => "monkey",
- 3 => "gorilla",
- },
- foo => { # output123/foo.csv
- 1 => 1,
- 2 => 2,
- 3 => 3,
- },
- );
-foreach my $tbl ("tmp", "foo") {
- my $sth = $dbh->prepare ("select * from $tbl");
- $sth->execute;
- while (my $row = $sth->fetch) {
- is ($row->[1], $data{$tbl}{$row->[0]}, "$tbl ($row->[0], ...)");
- }
- }
-ok ($dbh->do ("drop table foo"), "Drop foo");
-
-done_testing;
@@ -1,69 +0,0 @@
-#!/usr/bin/perl
-
-# Misc tests
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-is ($dbh->quote ("tast1"), "'tast1'", "quote");
-
-ok (my $sth = $dbh->prepare ("select * from $tbl where id = 1"), "prepare");
-{ local $dbh->{PrintError} = 0;
- my @warn;
- local $SIG{__WARN__} = sub { push @warn, @_ };
- eval { is ($sth->fetch, undef, "fetch w/o execute"); };
- is (scalar @warn, 1, "one error");
- like ($warn[0],
- qr/fetch row without a precee?ding execute/, "error message");
- }
-ok ($sth->execute, "execute");
-is ($sth->fetch, undef, "fetch no rows");
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($sth = $dbh->prepare ("insert into $tbl values (?, ?)"), "prepare ins");
-ok ($sth->execute ($_, "Code $_"), "insert $_") for 1 .. 9;
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($sth = $dbh->prepare ("select * from $tbl order by id"), "prepare sel");
-# Test what happens with two consequetive execute ()'s
-ok ($sth->execute, "execute 1");
-ok ($sth->execute, "execute 2");
-
-# Test all fetch methods
-ok (my @row = $sth->fetchrow_array, "fetchrow_array");
-is_deeply (\@row, [ 1, "Code 1" ], "content");
-ok (my $row = $sth->fetchrow_arrayref, "fetchrow_arrayref");
-is_deeply ( $row, [ 2, "Code 2" ], "content");
-ok ( $row = $sth->fetchrow_hashref, "fetchrow_hashref");
-is_deeply ( $row, { id => 3, name => "Code 3" }, "content");
-ok (my $all = $sth->fetchall_hashref ("id"), "fetchall_hashref");
-is_deeply ($all,
- { map { ( $_ => { id => $_, name => "Code $_" } ) } 4 .. 9 }, "content");
-
-ok ($sth->execute, "execute");
-ok ( $all = $sth->fetchall_arrayref, "fetchall_arrayref");
-is_deeply ($all, [ map { [ $_, "Code $_" ] } 1 .. 9 ], "content");
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -1,132 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More;
-use DBI qw(:sql_types);
-do "t/lib.pl";
-
-my $cnt = join "" => <DATA>;
-my $tbl;
-
-my $expect = [
- [ 1, "Knut", "white" ],
- [ 2, "Inge", "black" ],
- [ 3, "Beowulf", "CCEE00" ],
- ];
-
-{ my $dbh = Connect ();
- ok ($tbl = FindNewTable ($dbh), "find new test table");
- }
-
-if ($DBD::File::VERSION gt "0.42") {
- note ("ScalarIO - no col_names");
- my $dbh = Connect ();
- open my $data, "<", \$cnt;
- $dbh->{csv_tables}->{data} = {
- f_file => $data,
- skip_rows => 4,
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - mem-io w/o col_names");
- }
-
-if ($DBD::File::VERSION gt "0.42") {
- note ("ScalarIO - with col_names");
- my $dbh = Connect ();
- open my $data, "<", \$cnt;
-
- $dbh->{csv_tables}->{data} = {
- f_file => $data,
- skip_rows => 4,
- col_names => [qw(id name color)],
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - mem-io w col_names");
- }
-
-my $fn = File::Spec->rel2abs (DbFile ($tbl));
-open my $fh, ">", $fn or die "Can't open $fn for writing: $!";
-print $fh $cnt;
-close $fh;
-
-note ("File handle - no col_names");
-{ open my $data, "<", $fn;
- my $dbh = Connect ();
- $dbh->{csv_tables}->{data} = {
- f_file => $data,
- skip_rows => 4,
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - file-handle w/o col_names");
- is_deeply ($sth->{NAME_lc}, [qw(id name color)],
- "column names - file-handle w/o col_names");
- }
-
-note ("File handle - with col_names");
-{ open my $data, "<", $fn;
- my $dbh = Connect ();
- $dbh->{csv_tables}->{data} = {
- f_file => $data,
- skip_rows => 4,
- col_names => [qw(foo bar baz)],
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - file-handle w col_names");
- is_deeply ($sth->{NAME_lc}, [qw(foo bar baz)], "column names - file-handle w col_names");
- }
-
-note ("File name - no col_names");
-{ my $dbh = Connect ();
- $dbh->{csv_tables}->{data} = {
- f_file => $fn,
- skip_rows => 4,
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - file-name w/o col_names");
- is_deeply ($sth->{NAME_lc}, [qw(id name color)],
- "column names - file-name w/o col_names");
- }
-
-note ("File name - with col_names");
-{ my $dbh = Connect ({ RaiseError => 1 });
- $dbh->{csv_tables}->{data} = {
- f_file => $fn,
- skip_rows => 4,
- col_names => [qw(foo bar baz)],
- };
- my $sth = $dbh->prepare ("SELECT * FROM data");
- $sth->execute ();
- my $rows = $sth->fetchall_arrayref ();
- is_deeply ($rows, $expect, "all rows found - file-name w col_names" );
- is_deeply ($sth->{NAME_lc}, [qw(foo bar baz)],
- "column names - file-name w col_names" );
-
- # TODO: Next test will hang in open_tables ()
- # 'Cannot obtain exclusive lock on .../output12660/testaa: Interrupted system call'
- #ok ($dbh->do ("drop table data"), "Drop the table");
- }
-
-unlink $fn;
-
-done_testing ();
-
-__END__
-id,name,color
-stupid content
-only for skipping
-followed by column names
-1,Knut,white
-2,Inge,black
-3,Beowulf,"CCEE00"
@@ -1,135 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, &COL_KEY ],
- [ "str", "CHAR", 64, &COL_NULLABLE ],
- [ "name", "CHAR", 64, &COL_NULLABLE ],
- );
-
-sub DbFile;
-
-my $dir = "output$$";
-my $fqd = File::Spec->rel2abs ($dir);
-my $abs = Cwd::abs_path ($dir);
-
-ok (my $dbh = Connect (), "connect");
-
-ok ($dbh->{f_dir} eq $dir || $dbh->{f_dir} eq $abs ||
- $dbh->{f_dir} eq $fqd, "default dir");
-ok ($dbh->{f_dir} = $dir, "set f_dir");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-ok (!-f DbFile ($tbl), "does not exist");
-
-ok (my $tbl2 = FindNewTable ($dbh), "find new test table");
-ok (!-f DbFile ($tbl2), "does not exist");
-
-ok (my $tbl3 = FindNewTable ($dbh), "find new test table");
-ok (!-f DbFile ($tbl3), "does not exist");
-
-ok (my $tbl4 = FindNewTable ($dbh), "find new test table");
-ok (!-f DbFile ($tbl4), "does not exist");
-
-isnt ($tbl, $tbl2, "different 1 2");
-isnt ($tbl, $tbl3, "different 1 3");
-isnt ($tbl, $tbl4, "different 1 4");
-isnt ($tbl2, $tbl3, "different 2 3");
-isnt ($tbl2, $tbl4, "different 2 4");
-isnt ($tbl3, $tbl4, "different 3 4");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table 1");
-ok (-f DbFile ($tbl), "does exists");
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok (!-f DbFile ($tbl), "does not exist");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-my $dsn = "DBI:CSV:f_dir=$dir;csv_eol=\015\012;csv_sep_char=\\;;";
-ok ($dbh = Connect ($dsn), "connect");
-
-ok ($dbh->do ($def), "create table");
-ok (-f DbFile ($tbl), "does exists");
-
-ok ($dbh->do ("insert into $tbl values (1, 1, ?)", undef, "joe"), "insert 1");
-ok ($dbh->do ("insert into $tbl values (2, 2, ?)", undef, "Jochen;"), "insert 2");
-
-ok (my $sth = $dbh->prepare ("select * from $tbl"), "prepare");
-ok ($sth->execute, "execute");
-ok (my $row = $sth->fetch, "fetch 1");
-is_deeply ($row, [ 1, "1", "joe" ], "content");
-ok ( $row = $sth->fetch, "fetch 2");
-is_deeply ($row, [ 2, "2", "Jochen;" ], "content");
-ok ($sth->finish, "finish");
-undef $sth;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok (!-f DbFile ($tbl), "does not exist");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-$dsn = "DBI:CSV:";
-ok ($dbh = Connect ($dsn), "connect");
-
-# Check, whether the csv_tables->{$tbl}{file} attribute works
-like (my $def4 = TableDefinition ($tbl4, @tbl_def),
- qr{^create table $tbl4}i, "table definition");
-ok ($dbh->{csv_tables}{$tbl4}{file} = DbFile ($tbl4), "set table/file");
-ok ($dbh->do ($def4), "create table");
-ok (-f DbFile ($tbl4), "does exists");
-
-ok ($dbh->do ("drop table $tbl4"), "drop table");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => DbDir (),
- f_ext => ".csv",
- dbd_verbose => 8,
- csv_sep_char => ";",
- csv_blank_is_undef => 1,
- csv_always_quote => 1,
- }), "connect with attr");
-
-is ($dbh->{dbd_verbose}, 8, "dbd_verbose set");
-is ($dbh->{f_ext}, ".csv", "f_ext set");
-is ($dbh->{csv_sep_char}, ";", "sep_char set");
-is ($dbh->{csv_blank_is_undef}, 1, "blank_is_undef set");
-
-ok ($dbh->do ($def), "create table");
-ok (-f DbFile ($tbl).".csv", "does exists");
-#is ($sth->{blank_is_undef}, 1, "blank_is_undef");
-eval {
- local $SIG{__WARN__} = sub { };
-
- ok ($sth = $dbh->prepare ("insert into $tbl values (?, ?, ?)"), "prepare");
- is ($sth->execute (1, ""), undef, "not enough values");
- like ($dbh->errstr, qr/passed 2 parameters where 3 required/, "error message");
-
- # Cannot use the same handle twice. SQL::Statement bug
- ok ($sth = $dbh->prepare ("insert into $tbl values (?, ?, ?)"), "prepare");
- is ($sth->execute (1, "", 1, ""), undef, "too many values");
- like ($dbh->errstr, qr/passed 4 parameters where 3 required/, "error message");
- };
-ok ($sth->execute ($_, undef, "Code $_"), "insert $_") for 0 .. 9;
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-ok (!-f DbFile ($tbl), "does not exist");
-ok (!-f DbFile ($tbl).".csv", "does not exist");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-done_testing ();
@@ -1,82 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-my $dbh;
-my @ext = ("", ".csv", ".foo", ".txt");
-
-sub DbFile;
-
-my $usr = eval { getpwuid $< } || $ENV{USERNAME} || "";
-sub Tables
-{
- my @tbl = $dbh->tables ();
- if ($usr) {
- s/^['"]*$usr["']*\.//i for @tbl;
- }
- sort @tbl;
- } # Tables
-
-my $dir = DbDir ();
-
-ok ($dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-ok (!-f DbFile ($tbl), "does not exist");
-
-foreach my $ext (@ext) {
- my $qt = '"'.$tbl.$ext.'"';
- like (my $def = TableDefinition ($qt, @tbl_def),
- qr{^create table $qt}i, "table definition");
- ok ($dbh->do ($def), "create table $ext");
- ok (-f DbFile ($tbl.$ext), "does exists");
- }
-
-ok (my @tbl = Tables (), "tables");
-is_deeply (\@tbl, [ map { "$tbl$_" } @ext ], "for all ext");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => $dir,
- f_ext => ".csv",
- }), "connect (f_ext => .csv)");
-ok (@tbl = Tables (), "tables");
-is_deeply (\@tbl,
- [ map { "$tbl$_" } grep { !m/\.csv$/i } @ext ], "for all ext");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => $dir,
- f_ext => ".csv/r",
- }), "connect (f_ext => .csv/r)");
-ok (@tbl = Tables (), "tables");
-is_deeply (\@tbl, [ $tbl ], "just one");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = Connect (), "connect");
-
-ok (@tbl = Tables (), "tables");
-ok ($dbh->do ("drop table $_"), "drop table $_") for @tbl;
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok (rmdir $dir, "no files left");
-
-done_testing ();
@@ -1,51 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-my $dir = DbDir ();
-
-ok (my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_dir => $dir,
- }), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-
-my @tbl = $dbh->tables ();
-if (my $usr = eval { getpwuid $< }) {
- s/^(['"`])(.+)\1\./$2./ for @tbl;
- is_deeply (\@tbl, [ qq{$usr.$tbl} ], "tables");
- }
-else {
- is_deeply (\@tbl, [ qq{$tbl} ], "tables");
- }
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_schema => undef,
- f_dir => $dir,
- }), "connect (f_schema => undef)");
-is_deeply ([ $dbh->tables () ], [ $tbl ], "tables");
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok (rmdir $dir, "no files left");
-
-done_testing ();
@@ -1,63 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI"); }
-do "t/lib.pl";
-
-sub DbFile;
-
-my $dir = DbDir ();
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-my $tbl = "foo";
-ok (my $dbh = Connect (), "connect");
-ok (!-f DbFile ($tbl), "foo does not exist");
-ok ($dbh->{ignore_missing_table} = 1, "ignore missing tables");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-ok (-f DbFile ($tbl), "does exists");
-
-for (qw( foo foO fOo fOO Foo FoO FOo FOO )) {
- ok (my $sth = $dbh->prepare ("select * from $_"), "select from $_");
- ok ($sth->execute, "execute");
- }
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-ok ($dbh = Connect (), "connect");
-ok ($dbh->{ignore_missing_table} = 1, "ignore missing tables");
-
-# I have not yet found an *easy* way to test the case sensitivity of
-# the target FS, which might not prove at all that things will work
-# on all folders, as case in-sensitive and case-sensitive FS's might
-# co-exist.
-for (qw( foo foO fOo fOO Foo FoO FOo FOO )) {
- ok (my $sth = $dbh->prepare (qq{select * from "$_"}), "prepare \"$_\"");
-
- if ($_ eq "foo") {
- ok ( $sth->execute, "execute ok");
- }
- else {
- TODO: {
- local $TODO = "Filesystem has to be case-aware" if $^O =~ m/win32|darwin/i;
- local $sth->{PrintError} = 0;
- ok (!$sth->execute, "table name '$_' should not match 'foo'");
- }
- }
- }
-
-ok ($dbh->do ("drop table $tbl"), "drop table");
-
-ok ($dbh->disconnect, "disconnect");
-undef $dbh;
-
-done_testing ();
@@ -1,345 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More;
-use DBI qw(:sql_types);
-
-if ($ENV{DBI_SQL_NANO}) {
- ok ($ENV{DBI_SQL_NANO}, "These tests are not suit for SQL::Nano");
- done_testing ();
- exit 0;
- }
-
-do "t/lib.pl";
-
-my ($rt, %input, %desc);
-while (<DATA>) {
- if (s/^«(\d+)»\s*-?\s*//) {
- chomp;
- $rt = $1;
- $desc {$rt} = $_;
- $input{$rt} = [];
- next;
- }
- s/\\([0-7]{1,3})/chr oct $1/ge;
- push @{$input{$rt}}, $_;
- }
-
-sub rt_file
-{
- return File::Spec->catfile (DbDir (), "rt$_[0]");
- } # rt_file
-
-{ $rt = 18477;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
-
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect (), "connect");
- ok (my $sth = $dbh->prepare ("select * from rt$rt"), "prepare");
- ok ($sth->execute, "execute");
-
- ok ($sth = $dbh->prepare (qq;
- select SEGNO, OWNER, TYPE, NAMESPACE, EXPERIMENT, STREAM, UPDATED, SIZE
- from rt$rt
- where NAMESPACE = ?
- and EXPERIMENT LIKE ?
- and STREAM LIKE ?
- ;), "prepare");
- ok ($sth->execute ("RT", "%", "%"), "execute");
- ok (my $row = $sth->fetch, "fetch");
- is_deeply ($row, [ 14, "root", "bug", "RT", "not really",
- "fast", 20090501, 42 ], "content");
- ok ($sth->finish, "finish");
- ok ($dbh->do ("drop table rt$rt"), "drop table");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 20550;
- ok ($rt, "RT-$rt - $desc{$rt}");
-
- ok (my $dbh = Connect (), "connect");
- ok ($dbh->do ("CREATE TABLE rt$rt(test INT, PRIMARY KEY (test))"), "prepare");
- ok ($dbh->do ("drop table rt$rt"), "drop table");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 33764;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
-
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect (), "connect");
- ok (my $sth = $dbh->prepare ("select * from rt$rt"), "prepare");
-
- eval {
- local $dbh->{PrintError} = 0;
- local $SIG{__WARN__} = sub { };
- is ($sth->execute, undef, "execute");
- like ($dbh->errstr, qr{Error 2034 while reading}, "error message");
- is (my $row = $sth->fetch, undef, "fetch");
- like ($dbh->errstr,
- qr{fetch row without a precee?ding execute}, "error message");
- };
- ok ($sth->finish, "finish");
- ok ($dbh->do ("drop table rt$rt"), "drop table");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 43010;
- ok ($rt, "RT-$rt - $desc{$rt}");
-
- my @tbl = (
- [ "rt${rt}_0" => [
- [ "id", "INTEGER", 4, &COL_KEY ],
- [ "one", "INTEGER", 4, &COL_NULLABLE ],
- [ "two", "INTEGER", 4, &COL_NULLABLE ],
- ]],
- [ "rt${rt}_1" => [
- [ "id", "INTEGER", 4, &COL_KEY ],
- [ "thre", "INTEGER", 4, &COL_NULLABLE ],
- [ "four", "INTEGER", 4, &COL_NULLABLE ],
- ]],
- );
-
- ok (my $dbh = Connect (), "connect");
- $dbh->{csv_null} = 1;
-
- foreach my $t (@tbl) {
- like (my $def = TableDefinition ($t->[0], @{$t->[1]}),
- qr{^create table $t->[0]}i, "table def");
- ok ($dbh->do ($def), "create table");
- }
-
- ok ($dbh->do ("INSERT INTO $tbl[0][0] (id, one) VALUES (8, 1)"), "insert 1");
- ok ($dbh->do ("INSERT INTO $tbl[1][0] (id, thre) VALUES (8, 3)"), "insert 2");
-
- ok (my $row = $dbh->selectrow_hashref (join (" ",
- "SELECT *",
- "FROM $tbl[0][0]",
- "JOIN $tbl[1][0]",
- "USING (id)")), "join 1 2");
-
- is_deeply ($row, { id => 8,
- one => 1, two => undef, thre => 3, four => undef }, "content");
-
- ok ($dbh->do ("drop table $_"), "drop table") for map { $_->[0] } @tbl;
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 44583;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
-
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect (), "connect");
- ok (my $sth = $dbh->prepare ("select * from rt$rt"), "prepare");
- ok ($sth->execute, "execute");
- is_deeply ($sth->{NAME_lc}, [qw( c_tab s_tab )], "field names");
-
- ok ($sth = $dbh->prepare (qq;
- select c_tab, s_tab
- from rt$rt
- where c_tab = 1
- ;), "prepare");
- ok ($sth->execute (), "execute");
- ok (my $row = $sth->fetch, "fetch");
- is_deeply ($row, [ 1, "ok" ], "content");
- ok ($sth->finish, "finish");
-
- ok ($dbh = Connect ({ raw_headers => 1 }), "connect");
- ok ($sth = $dbh->prepare ("select * from rt$rt"), "prepare");
- # $sth is `empty' and should fail on all actions
- $sth->{NAME_lc} # this can return undef or an empty list
- ? is_deeply ($sth->{NAME_lc}, [], "field names")
- : is ($sth->{NAME_lc}, undef, "field names");
- ok ($sth->finish, "finish");
-
- ok ($dbh->do ("drop table rt$rt"), "drop table");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 46627;
-
- ok ($rt, "RT-$rt - $desc{$rt}");
-
- ok (my $dbh = Connect ({f_ext => ".csv/r"}),"connect");
- unlink "RT$rt.csv";
-
- ok ($dbh->do ("
- create table RT$rt (
- name varchar,
- id integer
- )"), "create");
-
- ok (my $sth = $dbh->prepare ("
- insert into RT$rt values (?, ?)"), "prepare ins");
- ok ($sth->execute ("Steffen", 1), "insert 1");
- ok ($sth->execute ("Tux", 2), "insert 2");
- ok ($sth->finish, "finish");
- ok ($dbh->do ("
- insert into RT$rt (
- name,
- id,
- ) values (?, ?)",
- undef, "", 3), "insert 3");
-
- ok ($sth = $dbh->prepare ("
- update RT$rt
- set name = ?
- where id = ?"
- ), "prepare upd");
- ok ($sth->execute ("Tim", 1), "update");
- ok ($sth->execute ("Tux", 2), "update");
- ok ($sth->finish, "finish");
-
- my $rtfn = DbFile ("RT$rt.csv");
- -f $rtfn or $rtfn = DbFile ("rt$rt.csv");
- ok (-f $rtfn, "file $rtfn exists");
- ok (-s $rtfn, "file is not empty");
- open my $fh, "<", $rtfn;
- ok ($fh, "open file");
- binmode $fh;
- is (scalar <$fh>, qq{name,id\r\n}, "Field names");
- is (scalar <$fh>, qq{Tim,1\r\n}, "Record 1");
- is (scalar <$fh>, qq{Tux,2\r\n}, "Record 2");
- is (scalar <$fh>, qq{,3\r\n}, "Record 3");
- is (scalar <$fh>, undef, "EOF");
- close $fh;
-
- ok ($dbh->do ("drop table RT$rt"), "drop");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 51090;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
- my @dbitp = ( SQL_INTEGER, SQL_LONGVARCHAR, SQL_NUMERIC );
- my @csvtp = ( 1, 0, 2 );
-
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect ({ f_lock => 0 }), "connect");
- $dbh->{csv_tables}{rt51090}{types} = [ @dbitp ];
- ok (my $sth = $dbh->prepare ("select * from rt$rt"), "prepare");
- is_deeply ($dbh->{csv_tables}{rt51090}{types}, \@dbitp, "set types (@dbitp)");
-
- ok ($sth->execute (), "execute");
- is_deeply ($dbh->{csv_tables}{rt51090}{types}, \@csvtp, "get types (@csvtp)");
-
- ok ($dbh->do ("drop table RT$rt"), "drop");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 61168;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
-
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect ({ f_lock => 0 }), "connect");
- $dbh->{csv_tables}{rt61168}{sep_char} = ";";
- cmp_ok ($dbh->{csv_tables}{rt61168}{csv_in} {sep_char}, "eq", ";", "cvs_in adjusted");
- cmp_ok ($dbh->{csv_tables}{rt61168}{csv_out}{sep_char}, "eq", ";", "cvs_out adjusted");
- ok (my $sth = $dbh->prepare ("select * from rt$rt"), "prepare");
-
- ok ($sth->execute (), "execute");
- ok (my $all_rows = $sth->fetchall_arrayref({}), "fetch");
- my $wanted_rows = [
- { header1 => "Volki",
- header2 => "Bolki",
- },
- { header1 => "Zolki",
- header2 => "Solki",
- },
- ];
- is_deeply ($all_rows, $wanted_rows, "records");
-
- ok ($dbh->do ("drop table RT$rt"), "drop");
- ok ($dbh->disconnect, "disconnect");
- }
-
-{ $rt = 80078;
- ok ($rt, "RT-$rt - $desc{$rt}");
- my @lines = @{$input{$rt}};
-
- my $tbl = "rt$rt";
- open my $fh, ">", rt_file ($rt);
- print $fh @lines;
- close $fh;
-
- ok (my $dbh = Connect ({
- csv_sep_char => "\t",
- csv_quote_char => undef,
- csv_escape_char => "\\",
- csv_allow_loose_escapes => 1,
- RaiseError => 1,
- PrintError => 1,
- }), "connect");
- $dbh->{csv_tables}{$tbl}{col_names} = [];
- ok (my $sth = $dbh->prepare ("select * from $tbl"), "prepare");
- eval {
- ok ($sth->execute, "execute");
- ok (!$@, "no error");
- };
-
- ok ($dbh->do ("drop table $tbl"), "drop");
- ok ($dbh->disconnect, "disconnect");
- }
-
-done_testing ();
-
-__END__
-«357» - build failure of DBD::CSV
-«2193» - DBD::File fails on create
-«5392» - No way to process Unicode CSVs
-«6040» - Implementing "Active" attribute for driver
-«7214» - error with perl-5.8.5
-«7877» - make test says "t/40bindparam......FAILED test 14"
-«8525» - Build failure due to output files in DBD-CSV-0.21.tar.gz
-«11094» - hint in docs about unix eol
-«11763» - dependency revision incompatibility
-«14280» - wish: detect typo'ed connect strings
-«17340» - Update statements does not work properly
-«17744» - Using placeholder in update statement causes error
-«18477» - use of prepare/execute with placeholders fails
-segno,owner,type,namespace,experiment,stream,updated,size
-14,root,bug,RT,"not really",fast,20090501,42
-«20340» - csv_eol
-«20550» - Using "Primary key" leads to error
-«31395» - eat memory
-«33764» - $! is not an indicator of failure
-c_tab,s_tab
-1,correct
-2,Fal"se
-3,Wr"ong
-«33767» - (No subject)
-«43010» - treatment of nulls scrambles joins
-«44583» - DBD::CSV cannot read CSV files with dots on the first line
-c.tab,"s,tab"
-1,ok
-«46627» - DBD::File is damaged now
-«51090» - Report a bug in DBD-CSV
-integer,longvarchar,numeric
-«61168» - Specifying seperation character per table does not work
-"HEADER1";"HEADER2"
-Volki;Bolki
-Zolki;Solki
-«80078» - bug in DBD::CSV causes select to fail
-a b c d
-e f g h
@@ -1,42 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-BEGIN { use_ok ("DBI") }
-do "t/lib.pl";
-
-my @tbl_def = (
- [ "id", "INTEGER", 4, 0 ],
- [ "name", "CHAR", 64, 0 ],
- );
-
-ok (my $dbh = Connect (), "connect");
-
-ok (my $tbl = FindNewTable ($dbh), "find new test table");
-
-like (my $def = TableDefinition ($tbl, @tbl_def),
- qr{^create table $tbl}i, "table definition");
-ok ($dbh->do ($def), "create table");
-my $tbl_file = DbFile ($tbl);
-ok (-s $tbl_file, "file exists");
-ok ($dbh->disconnect, "disconnect");
-
-ok (-f $tbl_file, "file still there");
-open my $fh, ">>", $tbl_file;
-print $fh qq{1, "p0wnd",",""",0\n}; # Very bad content
-close $fh;
-
-ok ($dbh = Connect (), "connect");
-{ local $dbh->{PrintError} = 0;
- local $dbh->{RaiseError} = 0;
- ok (my $sth = $dbh->prepare ("select * from $tbl"), "prepare");
- is ($sth->execute, undef, "execute should fail");
- # It is safe to regex on this text, as it is NOT local dependant
- like ($dbh->errstr, qr{\w+ \@ line [0-9?]+ pos [0-9?]+}, "error message");
- };
-ok ($dbh->do ("drop table $tbl"), "drop");
-ok ($dbh->disconnect, "disconnect");
-
-done_testing ();
@@ -0,0 +1,136 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: Adabas.dbtest,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# database specific definitions for an 'Adabas' database
+
+
+# This function generates a mapping of ANSI type names to
+# database specific type names; it is called by TableDefinition().
+#
+sub AnsiTypeToDb ($;$) {
+ my ($type, $size) = @_;
+ my ($ret);
+
+ if ((lc $type) eq 'blob') {
+ $ret = 'LONG';
+ } elsif ((lc $type) eq 'int' || (lc $type) eq 'integer') {
+ $ret = $type;
+ } elsif ((lc $type) eq 'char') {
+ $ret = "CHAR($size)";
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+ $ret;
+}
+
+
+#
+# This function generates a table definition based on an
+# input list. The input list consists of references, each
+# reference referring to a single column. The column
+# reference consists of column name, type, size and a bitmask of
+# certain flags, namely
+#
+# $COL_NULLABLE - true, if this column may contain NULL's
+# $COL_KEY - true, if this column is part of the table's
+# primary key
+#
+# Hopefully there's no big need for you to modify this function,
+# if your database conforms to ANSI specifications.
+#
+
+sub TableDefinition ($@) {
+ my($tablename, @cols) = @_;
+ my($def);
+
+ #
+ # Should be acceptable for most ANSI conformant databases;
+ #
+ # msql 1 uses a non-ANSI definition of the primary key: A
+ # column definition has the attribute "PRIMARY KEY". On
+ # the other hand, msql 2 uses the ANSI fashion ...
+ #
+ my($col, @keys, @colDefs, $keyDef);
+
+ #
+ # Count number of keys
+ #
+ @keys = ();
+ foreach $col (@cols) {
+ if ($$col[3] & $::COL_KEY) {
+ push(@keys, $$col[0]);
+ }
+ }
+
+ foreach $col (@cols) {
+ my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
+ if (!($$col[3] & $::COL_NULLABLE)) {
+ $colDef .= " NOT NULL";
+ }
+ push(@colDefs, $colDef);
+ }
+ if (@keys) {
+ $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
+ } else {
+ $keyDef = "";
+ }
+ $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
+ join(", ", @colDefs), $keyDef);
+
+ print "Table definition: $def\n";
+ $def;
+}
+
+
+#
+# This function generates a list of tables associated to a
+# given DSN.
+#
+sub ListTables(@) {
+ my($dbh) = shift;
+ my ($sth) = $dbh->tables();
+ my(@tables);
+
+ if (!$sth) {
+ die "Cannot create table list: " . $dbh->errstr;
+ }
+
+ @tables = ();
+ while (@row = $sth->fetchrow) {
+ push(@tables, (lc $row[2]));
+ }
+ @tables;
+}
+
+
+#
+# This function is called by DBD::pNET; given a hostname and a
+# dsn without hostname, return a dsn for connecting to dsn at
+# host.
+sub HostDsn ($$) {
+ my($hostname, $dsn) = @_;
+ "$dsn:$hostname";
+}
+
+
+#
+# Return a string for checking, whether a given column is NULL.
+#
+sub IsNull($) {
+ my($var) = @_;
+
+ "$var IS NULL";
+}
+
+
+#
+# Return TRUE, if database supports transactions
+#
+sub HaveTransactions () {
+ 1;
+}
+
+
+1;
@@ -0,0 +1,7 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: Adabas.mtest,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# module specific definitions for an 'Adabas' database
+
+1;
@@ -0,0 +1,134 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: CSV.dbtest,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# database specific definitions for a 'CSV' database
+
+
+# This function generates a mapping of ANSI type names to
+# database specific type names; it is called by TableDefinition().
+#
+sub AnsiTypeToDb ($;$) {
+ my ($type, $size) = @_;
+ my ($ret);
+
+ if ((lc $type) eq 'char' || (lc $type) eq 'varchar') {
+ $size ||= 1;
+ return (uc $type) . " ($size)";
+ } elsif ((lc $type) eq 'blob' || (lc $type) eq 'real' ||
+ (lc $type) eq 'integer') {
+ return uc $type;
+ } elsif ((lc $type) eq 'int') {
+ return 'INTEGER';
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+ $ret;
+}
+
+
+#
+# This function generates a table definition based on an
+# input list. The input list consists of references, each
+# reference referring to a single column. The column
+# reference consists of column name, type, size and a bitmask of
+# certain flags, namely
+#
+# $COL_NULLABLE - true, if this column may contain NULL's
+# $COL_KEY - true, if this column is part of the table's
+# primary key
+#
+# Hopefully there's no big need for you to modify this function,
+# if your database conforms to ANSI specifications.
+#
+
+sub TableDefinition ($@) {
+ my($tablename, @cols) = @_;
+ my($def);
+
+ #
+ # Should be acceptable for most ANSI conformant databases;
+ #
+ # msql 1 uses a non-ANSI definition of the primary key: A
+ # column definition has the attribute "PRIMARY KEY". On
+ # the other hand, msql 2 uses the ANSI fashion ...
+ #
+ my($col, @keys, @colDefs, $keyDef);
+
+ #
+ # Count number of keys
+ #
+ @keys = ();
+ foreach $col (@cols) {
+ if ($$col[2] & $::COL_KEY) {
+ push(@keys, $$col[0]);
+ }
+ }
+
+ foreach $col (@cols) {
+ my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
+ if (!($$col[3] & $::COL_NULLABLE)) {
+ $colDef .= " NOT NULL";
+ }
+ push(@colDefs, $colDef);
+ }
+ if (@keys) {
+ $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
+ } else {
+ $keyDef = "";
+ }
+ $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
+ join(", ", @colDefs), $keyDef);
+}
+
+
+#
+# This function generates a list of tables associated to a
+# given DSN.
+#
+sub ListTables(@) {
+ my($dbh) = shift;
+ my(@tables);
+
+ @tables = $dbh->func('list_tables');
+ if ($dbh->errstr) {
+ die "Cannot create table list: " . $dbh->errstr;
+ }
+ @tables;
+}
+
+
+#
+# This function is called by DBD::pNET; given a hostname and a
+# dsn without hostname, return a dsn for connecting to dsn at
+# host.
+sub HostDsn ($$) {
+ my($hostname, $dsn) = @_;
+ "$dsn:$hostname";
+}
+
+
+#
+# Return a string for checking, whether a given column is NULL.
+#
+sub IsNull($) {
+ my($var) = @_;
+
+ "$var IS NULL";
+}
+
+
+#
+# Return TRUE, if database supports transactions
+#
+sub HaveTransactions () {
+ 0;
+}
+
+
+if (! -d "output") {
+ mkdir "output", 0755;
+}
+
+1;
@@ -0,0 +1,8 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: CSV.mtest,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# module specific definitions for a 'CSV' database
+
+
+1;
@@ -0,0 +1,327 @@
+$Id: README,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+
+
+A test suite for DBD drivers
+============================
+
+This is an attempt to write a test suite for DBD drivers. In short I
+took Alligator Descarte's test script for mSQL, isolated database
+specific parts and wrote something around. I'd be glad, if other
+driver authors would take it, adapt the DBMS specific file (lib.pl)
+to their drivers. IMO this would enhance the stability of DBI a
+lot.
+
+
+What's currently included?
+==========================
+
+The test suite consists of a lot of files, currently these are:
+
+ lib.pl the core of the test suite, being included by any
+ test before doing anything; in short it defines
+ variables $mdriver and $dbdriver, includes
+ $mdriver.mtest and $dbdriver.dbtest and defines
+ some global functions used within any test.
+
+ skeleton.test A skeleton file for writing new tests. Basically you
+ take this file and at a given point you include your
+ tests. This file is described in detail below.
+
+ README You are reading this. :-)
+
+ 00base.t This is essentially the base.t from DBD::Oracle. It
+ checks whether the driver may be installed.
+
+ 10dsnlist.t This script checks $dbh->data_sources. I missed the
+ possibility of passing data source attributes like
+ host and port. :-(
+
+ 10listtables.t This is a DBMS specific test: It lists the tables of
+ a given dsn.
+
+ 20createdrop.t Guess what this does? :-) Yes, it creates a table and
+ drops it.
+
+ 30insertfetch.t Inserts a row into a table and retreives it
+
+ 40blobs.t Likewise, but using blobs. This is a check for
+ $dbh->quote and inserting and retreiving binary data.
+
+ 40listfields.t Checks the attributes of a statement handle, currently
+ NUM_OF_FIELDS, NAME and NULLABLE.
+
+ 40nulls.t Checks working with NULLS.
+
+ 40update.t Checks the UPDATE statement.
+
+ 40bindparam.t Checks the bind_col() method and the internal
+ function dbd_ph_bind().
+
+ 50chopblanks.t Checks the "ChopBlanks" attribute.
+
+ 50commit.t Checks commit, rollback and the "AutoCommit" attribute.
+
+ mysql.mtest These files are used for setting up the DBMS specific
+ mysql.dbtest part for the 'mysql' database with constants (dsn
+ definitions, user, password for running tests), a
+ possibility to create a table from a somewhat abstract
+ table description, and a function for listing tables.
+ Additionally some functions for supporting test script
+ are included. These files are described in detail below.
+
+ mSQL.mtest Likewise for mSQL.
+ mSQL.dbtest
+
+ pNET.mtest Likewise for pNET.
+ pNET.dbtest
+
+ Ingres.mtest Likewise for Ingres.
+ Ingres.dbtest
+
+ ODBC.mtest Likewise for ODBC.
+ ODBC.dbtest
+
+
+How do I use the test suite for my driver?
+==========================================
+
+Basically you create scripts "mydriver.mtest" and "mydriver.dbtest",
+modify them for your needs and insert the name "mydriver" in "lib.pl".
+There should be no need for modifying the test files themselves, except
+for executing immediately after including lib.pl, if a test isn't well
+suited for your driver. (See mSQL and t/40blobs.t for an example.)
+
+In particular you should
+
+ - set the variable $mdriver and $dbdriver to your driver name;
+ examples are
+
+ $mdriver = $dbdriver = 'mysql'; or
+ $mdriver = $dbdriver = 'mSQL';
+
+ (Using different values is only required for DBD::pNET where one
+ has to distinguish between the module driver ($mdriver = 'pNET')
+ and the database driver ($dbdriver).
+
+ Ignore $test_dsn, $test_user and $test_password here, set this in
+ "mydriver.dbtest".
+
+ - set the dsn, user name and password for test purposes in
+ "mydriver.dbtest", if the defaults aren't good for you. The
+ default is
+
+ $::test_dsn = $ENV{'DBI_DSN'} || "DBI::$::driver:test";
+ $::test_user = $ENV{'DBI_USER'} || "";
+ $::test_password = $ENV{'DBI_PASS'} || "";
+
+ - create a function ListTables() in "mydriver.mtest" (This could
+ be in "mydriver.dbtest" as soon as there is a similar functionality
+ in DBI itself.): Given a database handle dbh, return a list of table
+ names present in the corresponding database; for example in mysql
+ this is done as follows:
+
+ if (!defined(@tables = $dbh->func('_ListTables')) ||
+ $dbh->errstr) {
+ return undef;
+ } else {
+ return tables;
+ }
+
+ See mysql.mtest for an exaple.
+
+ - create a function AnsiTypeToDb() in "mydriver.dbtest":
+ Given a type string like "char", "integer" or "blob" and a size,
+ return a string that is suitable for use in CREATE statements.
+ For example "char" and "64" could return "char(64)", sizes can
+ currently be ignored for "integer". Currently "integer", "char"
+ and "blob" are valid input types. In mysql.dbtest this is implemented
+ as follows:
+
+ if ((lc $type) eq 'blob') {
+ if ($size >= 1 << 16) {
+ $ret = 'MEDIUMBLOB';
+ } else {
+ $ret = 'BLOB';
+ }
+ } elsif ((lc $type) eq 'int' || (lc $type) eq 'integer') {
+ $ret = uc $type;
+ } elsif ((lc $type) eq 'char') {
+ $ret = "CHAR($size)";
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+
+ See mysql.dbtest for an example.
+
+ - create a function TableDefinition() in "mydriver.dbtest": Given a
+ table name and a list of column attributes like
+
+ TableDefinition("tablename",
+ [ "id", "INTEGER", 4, $COL_KEY ],
+ [ "name", "CHAR", 64, 0 ],
+ [ "email", "CHAR", 64, $COL_NULLABLE ]),
+
+ return a string for use in a CREATE statement, like
+
+ CREATE TABLE tablename (
+ id INTEGER NOT NULL,
+ name VARCHAR(64) NOT NULL,
+ email VARCHAR(64),
+ PRIMARY KEY(id))
+
+ The function need not know about foreign keys, secondary keys or other
+ extended possibilities. If AnsiTypeToDb works and your driver conforms
+ to Ansi SQL, the example from mysql.dbtest should be fine for you.
+
+ - create a function HaveTransactians() that returns TRUE, if your
+ database supports transactions and FALSE otherwise
+
+ - create a function IsNull(): Given a column name, return an SQL
+ expression that checks whether the column is NULL, for example
+
+ sub IsNull ($) {
+ my($col) = @_;
+ "$col = NULL"; # or "$col IS NULL"
+ }
+
+That's it! Try a "make test". :-)
+
+
+How do I use the test suite for my driver?
+==========================================
+
+Let's take a look at skeleton.test:
+
+The first thing you notice is that the file "lib.pl" is included by executing
+a "do". Leave this as it is, but note the last lines:
+
+ if ($mdriver eq 'whatever') {
+ print "1..0\n";
+ exit 0;
+ }
+
+This is the place where to stop the test, if it isn't suitable for a certain
+driver or for your driver only by modifying the condition. The next thing
+to notice is
+
+ #
+ # Main loop; leave this untouched, put tests after creating
+ # the new table.
+ #
+ while (Testing()) {
+
+You should know, that skeleton.test will run this loop twice. The
+first time no test is executed, only the tests are counted, so that
+a valid input string for Test::Harness can be printed, like
+
+ 1..15
+
+to indicate that 15 tests will follow.
+
+The second pass will indeed run the tests. The Testing() function has
+extended possibilities which I won't describe here, for building groups
+of tests (for example it probably doesn´t make sense to execute a
+test if even the connect failed).
+
+The next thing we notice is a first test: Connecting to the DBMS.
+
+ #
+ # Connect to the database
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)),
+ undef,
+ "Attempting to connect.\n");
+ or ErrMsgF("Cannot connect: Error %s.\n\n"
+ . "Make sure, your database server is up and running.\n"
+ . "Check that '$test_dsn' references a valid database"
+ . " name.\nDBI error message: $DBI::errstr");
+
+Things you should note here:
+
+ - The Test() function will be called always, so that lib.pl has
+ control over what happens; in particular the number of tests will
+ be counted.
+ - The test will only be executed if $state == 0 (not vice versa!);
+ this ensures that your tests won't be executed twice, although
+ the loop will be repeated.
+ - a boolean value is passed to the function Test() as the first
+ argument. This function will print a "ok $numTests" or a "not
+ ok $numTests" for TRUE or FALSE.
+ - the second argument is 'undef'; ignore this for now.
+ - the third argument is a message that will be printed before
+ executing the test, if $verbose=1. This is for use in large
+ test scripts where you would otherwise leave the connection
+ between test output ("315 ok, 316 ok, 317 not ok, ...") and
+ test script.
+ - if Test() fails a long error message is printed by using the
+ function ErrMsgF. This function receives printf-style input.
+
+Now a second test: We let lib.pl detect the name for a new table
+that should be created, so that we may work in it.
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)))
+ or ErrMsgF("Cannot create table: Error %s.\n",
+ $dbh->errstr);
+
+As a third test we create the database. Note the use of the
+TableDefinition() function.
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)),
+ undef, "Creating a table.\n")
+ or ErrMsgF("Cannot create table: Error %s.\n",
+ $dbh->errstr);
+
+
+and finally, here's the place for you, the place where you enter
+your tests:
+
+ #
+ # and here's the right place for inserting new tests:
+ #
+ EDIT THIS!
+
+There follows some stuff later, especially dropping the new
+table, but in general leave this as it is.
+
+
+Known problems
+==============
+
+mysql: The blob test fails with blobs larger than 252*256 bytes, you
+ must start the mysql daemon with -Omax_allowed_packet=<bigvalue>.
+
+msql: The null test fails, because the query
+
+ SELECT * FROM $table WHERE id = NULL
+
+ doesn't return anything. Does anyone have an idea, how to modify
+ this?
+
+ODBC: ChopBlank test fail; seems to be a driver problem.
+
+
+What remains to do?
+===================
+
+Writing test cases! For example I do currently not
+
+ - check transactions (mysql doesn't know about transactions :-(
+
+I'll be happy to include them into the test suite. Any new tests,
+critics or suggestions welcome:
+
+ Jochen Wiedmann
+ joe@ispsoft.de
@@ -0,0 +1,385 @@
+#!/usr/local/bin/perl
+#
+# $Id: ak-dbd.t,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# This is a skeleton test. For writing new tests, take this file
+# and modify/extend it.
+#
+
+$^W = 1;
+$| = 1;
+
+
+#
+# Make -w happy
+#
+use vars qw($test_dsn $test_user $test_password $dbdriver $mdriver
+ $verbose $state);
+use vars qw($COL_NULLABLE $COL_KEY);
+#require SQL::Statement;
+#my $SVERSION = $SQL::Statement::VERSION;
+$test_dsn = '';
+$test_user = '';
+$test_password = '';
+
+
+#
+# Include lib.pl
+#
+use DBI;
+use strict;
+$dbdriver = "";
+{ my $file;
+ foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($dbdriver ne '') {
+ last;
+ }
+ }
+}
+
+my $test_db = '';
+my $test_hostname = $ENV{DBI_HOST} || 'localhost';
+
+if ($test_dsn =~ /^DBI\:[^\:]+\:/) {
+ $test_db = $';
+ if ($test_db =~ /:/) {
+ $test_db = $`;
+ $test_hostname = $';
+ }
+}
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ my($dbh, $sth, $test_table, $query);
+ $test_table = ''; # Avoid warnings for undefined variables.
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ErrMsg("Cannot connect: $DBI::errstr.\n");
+
+ #
+ # Verify whether constants work
+ #
+ if ($mdriver eq 'mysql') {
+ my ($val);
+ Test($state or (($val = &DBD::mysql::FIELD_TYPE_STRING()) == 254))
+ or ErrMsg("Wrong value for FIELD_TYPE_STRING:"
+ . " Expected 254, got $val\n");
+ Test($state or (($val = &DBD::mysql::FIELD_TYPE_SHORT()) == 2))
+ or ErrMsg("Wrong value for FIELD_TYPE_SHORT:"
+ . " Expected 2, got $val\n");
+ } elsif ($mdriver eq 'mSQL') {
+ my ($val);
+ Test($state or (($val = &DBD::mSQL::CHAR_TYPE()) == 2))
+ or ErrMsg("Wrong value for CHAR_TYPE: Expected 2, got $val\n");
+ Test($state or (($val = &DBD::mSQL::INT_TYPE()) == 1))
+ or ErrMsg("Wrong value for INT_TYPE: Expected 1, got $val\n");
+ }
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $test_table = FindNewTable($dbh)) or !$verbose
+ or ErrMsg("Cannot get table name: $dbh->errstr.\n");
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($query = TableDefinition($test_table,
+ ["id", "INTEGER", 4, $COL_NULLABLE],
+ ["name", "CHAR", 64, $COL_NULLABLE]),
+ $dbh->do($query)))
+ or ErrMsg("Cannot create table: query $query error $dbh->errstr.\n");
+
+ #
+ # and here's the right place for inserting new tests:
+ #
+ Test($state or $dbh->quote('tast1'))
+ or ErrMsgF("quote('tast1') returned %s.\n", $dbh->quote('tast1'));
+
+ ### ...and disconnect
+ Test($state or $dbh->disconnect)
+ or ErrMsg("\$dbh->disconnect() failed!\n",
+ "Make sure your server is still functioning",
+ "correctly, and check to make\n",
+ "sure your network isn\'t malfunctioning in the",
+ "case of the server running on a remote machine.\n");
+
+ ### Now, re-connect again so that we can do some more complicated stuff..
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ErrMsg("reconnect failed: $DBI::errstr\n");
+
+ ### List all the tables in the selected database........
+ ### This test for mSQL and mysql only.
+ if ($mdriver eq 'mysql' or $mdriver eq 'mSQL' or $mdriver eq 'mSQL1') {
+ Test($state or $dbh->func('_ListTables'))
+ or ErrMsgF("_ListTables failed: $dbh->errstr.\n"
+ . "This could be due to the fact you have no tables,"
+ . " but I hope not. You\n"
+ . "could try running '%s -h %s %s' and see if it\n"
+ . "reports any information about your database,"
+ . " or errors.\n",
+ ($mdriver eq 'mysql') ? "mysqlshow" : "relshow",
+ $test_hostname, $test_db);
+ }
+
+ Test($state or $dbh->do("DROP TABLE $test_table"))
+ or ErrMsg("Dropping table failed: $dbh->errstr.\n");
+ Test($state or ($query = TableDefinition($test_table,
+ ["id", "INTEGER", 4, $COL_NULLABLE],
+ ["name", "CHAR", 64, $COL_NULLABLE]),
+ $dbh->do($query)))
+ or ErrMsg("create failed, query $query, error $dbh->errstr.\n");
+
+ ### Get some meta-data for the table we've just created...
+ if ($mdriver eq 'mysql' or $mdriver eq 'mSQL1' or $mdriver eq 'mSQL') {
+ my $ref;
+ Test($state or ($ref = $dbh->prepare("LISTFIELDS $test_table")))
+ or ErrMsg("listfields failed: $dbh->errstr.\n");
+ Test($state or $ref->execute);
+ }
+
+ ### Insert a row into the test table.......
+ print "Inserting a row...\n";
+ Test($state or ($dbh->do("INSERT INTO $test_table VALUES(1,"
+ . " 'Alligator Descartes')")))
+ or ErrMsg("INSERT failed: $dbh->errstr.\n");
+
+ ### ...and delete it........
+ print "Deleting a row...\n";
+ Test($state or $dbh->do("DELETE FROM $test_table WHERE id = 1"))
+ or ErrMsg("Cannot delete row: $dbh->errstr.\n");
+ Test($state or ($sth = $dbh->prepare("SELECT * FROM $test_table"
+ . " WHERE id = 1")))
+ or ErrMsg("Cannot select: $dbh->errstr.\n");
+
+ # This should fail with error message: We "forgot" execute.
+ my($pe) = $sth->{'PrintError'};
+ $sth->{'PrintError'} = 0;
+ Test($state or !eval { $sth->fetchrow() })
+ or ErrMsg("Missing error report from fetchrow.\n");
+ $sth->{'PrintError'} = $pe;
+
+ Test($state or $sth->execute)
+ or ErrMsg("execute SELECT failed: $dbh->errstr.\n");
+
+ # This should fail without error message: No rows returned.
+ my(@row, $ref);
+ {
+ local($^W) = 0;
+ Test($state or !defined($ref = $sth->fetch))
+ or ErrMsgF("Unexpected row returned by fetchrow: $ref\n".
+ scalar(@row));
+ }
+
+ # Now try a "finish"
+ Test($state or $sth->finish)
+ or ErrMsg("sth->finish failed: $sth->errstr.\n");
+
+ # Call destructors:
+ Test($state or (undef $sth || 1));
+
+ ### This section should exercise the sth->func( '_NumRows' ) private
+ ### method by preparing a statement, then finding the number of rows
+ ### within it. Prior to execution, this should fail. After execution,
+ ### the number of rows affected by the statement will be returned.
+ Test($state or ($dbh->do($query = "INSERT INTO $test_table VALUES"
+ . " (1, 'Alligator Descartes' )")))
+ or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
+ Test($state or ($sth = $dbh->prepare($query = "SELECT * FROM $test_table"
+ . " WHERE id = 1")))
+ or ErrMsgF("prepare failed: query $query, error %s.\n", $dbh->errstr);
+ if ($dbdriver eq 'mysql' || $dbdriver eq 'mSQL' ||
+ $dbdriver eq 'mSQL1') {
+ Test($state or defined($sth->rows))
+ or ErrMsg("sth->rows returning result before 'execute'.\n");
+ }
+
+ if (!$state) {
+ print "Test 19: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
+ }
+ Test($state or $sth->execute)
+ or ErrMsgF("execute failed: query $query, error %s.\n", $sth->errstr);
+ Test($state or ($sth->rows == 1) or ($sth->rows == -1))
+ or ErrMsgF("sth->rows returned wrong result %s after 'execute'.\n",
+ $sth->rows);
+ Test($state or $sth->finish)
+ or ErrMsgF("finish failed: %s.\n", $sth->errstr);
+ Test($state or (undef $sth or 1));
+
+ ### Test whether or not a field containing a NULL is returned correctly
+ ### as undef, or something much more bizarre
+ $query = "INSERT INTO $test_table VALUES ( NULL, 'NULL-valued id' )";
+ Test($state or $dbh->do($query))
+ or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
+ $query = "SELECT id FROM $test_table WHERE " . IsNull("id");
+ Test($state or ($sth = $dbh->prepare($query)))
+ or ErrMsgF("Cannot prepare, query = $query, error %s.\n",
+ $dbh->errstr);
+ if (!$state) {
+ print "Test 25: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
+ }
+ Test($state or $sth->execute)
+ or ErrMsgF("Cannot execute, query = $query, error %s.\n",
+ $dbh->errstr);
+ my $rv;
+ Test($state or defined($rv = $sth->fetch) or $dbdriver eq 'CSV'
+ or $dbdriver eq 'ConfFile')
+ or ErrMsgF("fetch failed, error %s.\n", $dbh->errstr);
+# Test($state or !defined($$rv[0]))
+# or ErrMsgF("Expected NULL value, got %s.\n", $$rv[0]);
+ Test($state or $sth->finish)
+ or ErrMsgF("finish failed: %s.\n", $sth->errstr);
+ Test($state or undef $sth or 1);
+
+ ### Delete the test row from the table
+ $query = "DELETE FROM $test_table WHERE id = NULL AND"
+ . " name = 'NULL-valued id'";
+ Test($state or ($rv = $dbh->do($query)))
+ or ErrMsg("DELETE failed: query $query, error %s.\n", $dbh->errstr);
+
+ ### Test whether or not a char field containing a blank is returned
+ ### correctly as blank, or something much more bizarre
+
+# if ($SVERSION > 1) {
+### $query = "INSERT INTO $test_table VALUES (2, NULL)";
+# }
+# else {
+ $query = "INSERT INTO $test_table VALUES (2, '')";
+# }
+
+ Test($state or $dbh->do($query))
+ or ErrMsg("INSERT failed: query $query, error %s.\n", $dbh->errstr);
+# if ($SVERSION > 1) {
+### $query = "SELECT name FROM $test_table WHERE id = 2 AND name IS NULL";
+# }
+# else {
+ $query = "SELECT name FROM $test_table WHERE id = 2 AND name = ''";
+# }
+
+ Test($state or ($sth = $dbh->prepare($query)))
+ or ErrMsg("prepare failed: query $query, error %s.\n", $dbh->errstr);
+ Test($state or $sth->execute)
+ or ErrMsg("execute failed: query $query, error %s.\n", $dbh->errstr);
+ $rv = undef;
+### Test($state or defined($ref = $sth->fetch))
+### or ErrMsgF("fetchrow failed: query $query, error %s.\n", $sth->errstr);
+# if ($SVERSION > 1) {
+ Test($state or !defined($$ref[0]) )
+ or ErrMsgF("blank value returned as [%s].\n", $$ref[0]);
+# }
+# else {
+# Test($state or (defined($$ref[0]) && ($$ref[0] eq '')))
+# or ErrMsgF("blank value returned as %s.\n", $$ref[0]);
+# }
+ Test($state or $sth->finish)
+ or ErrMsg("finish failed: $sth->errmsg.\n");
+ Test($state or undef $sth or 1);
+
+ ### Delete the test row from the table
+# if ($SVERSION > 1) {
+ $query = "DELETE FROM $test_table WHERE id = 2 AND name IS NULL";
+# }
+# else {
+# $query = "DELETE FROM $test_table WHERE id = 2 AND name = ''";
+# }
+ Test($state or $dbh->do($query))
+ or ErrMsg("DELETE failed: query $query, error $dbh->errstr.\n");
+
+ ### Test the new funky routines to list the fields applicable to a SELECT
+ ### statement, and not necessarily just those in a table...
+ $query = "SELECT * FROM $test_table";
+ Test($state or ($sth = $dbh->prepare($query)))
+ or ErrMsg("prepare failed: query $query, error $dbh->errstr.\n");
+ Test($state or $sth->execute)
+ or ErrMsg("execute failed: query $query, error $dbh->errstr.\n");
+ if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' || $mdriver eq 'mSQL1') {
+ my($warning);
+ $SIG{__WARN__} = sub { $warning = shift; };
+ Test($state or ($ref = $sth->func('_ListSelectedFields')))
+ or ErrMsg("_ListSelectedFields failed, error $sth->errstr.\n");
+ Test($state or ($warning =~ /deprecated/))
+ or ErrMsg("Expected warning from _ListSelectedFields");
+ $SIG{__WARN__} = 'DEFAULT';
+ }
+# if ($SVERSION > 1) {
+ Test($state or $sth->execute, 'execute 284')
+ or ErrMsg("re-execute failed: query $query, error $dbh->errstr.\n");
+# }
+# else {
+# Test($state or $sth->execute, 'execute 284')
+# or ErrMsg("re-execute failed: query $query, error $dbh->errstr.\n");
+# }
+ Test($state or (@row = $sth->fetchrow_array), 'fetchrow 286')
+ or ErrMsg("Query returned no result, query $query,",
+ " error $sth->errstr.\n");
+ Test($state or $sth->finish)
+ or ErrMsg("finish failed: $sth->errmsg.\n");
+ Test($state or undef $sth or 1);
+
+ ### Insert some more data into the test table.........
+ $query = "INSERT INTO $test_table VALUES( 2, 'Gary Shea' )";
+ Test($state or $dbh->do($query))
+ or ErrMsg("INSERT failed: query $query, error $dbh->errstr.\n");
+ $query = "UPDATE $test_table SET id = 3 WHERE name = 'Gary Shea'";
+ Test($state or ($sth = $dbh->prepare($query)))
+ or ErrMsg("prepare failed: query $query, error $sth->errmsg.\n");
+ # This should fail: We "forgot" execute.
+ if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' ||
+ $mdriver eq 'mSQL1') {
+ Test($state or !defined($sth->{'NAME'}))
+ or ErrMsg("Expected error without execute, got $ref.\n");
+ }
+ Test($state or undef $sth or 1);
+
+ ### Drop the test table out of our database to clean up.........
+ $query = "DROP TABLE $test_table";
+ Test($state or $dbh->do($query))
+ or ErrMsg("DROP failed: query $query, error $dbh->errstr.\n");
+
+ Test($state or $dbh->disconnect)
+ or ErrMsg("disconnect failed: $dbh->errstr.\n");
+
+ #
+ # Try mysql's insertid feature
+ #
+ if ($dbdriver eq 'mysql') {
+ my ($sth, $table);
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ErrMsgF("connect failed: %s.\n", $DBI::errstr);
+ Test($state or ($table = FindNewTable($dbh)));
+ Test($state or $dbh->do("CREATE TABLE $table ("
+ . " id integer AUTO_INCREMENT PRIMARY KEY,"
+ . " country char(30) NOT NULL)"))
+ or printf("Error while executing query: %s\n", $dbh->errstr);
+ Test($state or
+ ($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'a')")))
+ or printf("Error while preparing query: %s\n", $dbh->errstr);
+ Test($state or $sth->execute)
+ or printf("Error while executing query: %s\n", $sth->errstr);
+ Test($state or $sth->finish)
+ or printf("Error while finishing query: %s\n", $sth->errstr);
+ Test($state or
+ ($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'b')")))
+ or printf("Error while preparing query: %s\n", $dbh->errstr);
+ Test($state or $sth->execute)
+ or printf("Error while executing query: %s\n", $sth->errstr);
+ Test($state or $sth->{insertid} =~ /\d+/)
+ or printf("insertid generated incorrect result: %s\n",
+ $sth->insertid);
+ Test($state or $sth->finish)
+ or printf("Error while finishing query: %s\n", $sth->errstr);
+ Test($state or $dbh->do("DROP TABLE $table"));
+ Test($state or $dbh->disconnect)
+ or ErrMsg("disconnect failed: $dbh->errstr.\n");
+ }
+}
@@ -0,0 +1,158 @@
+# -*- perl -*-
+
+use strict;
+use DBI;
+
+use lib ".";
+use lib "t";
+require "lib.pl";
+
+
+use vars qw($dbdriver $test_dsn $test_user $test_password $state
+ $haveFileSpec);
+
+
+if ($dbdriver ne 'CSV') {
+ print "1..0\n";
+ exit 0;
+}
+
+# Extract the directory from the dsn
+my $dir;
+if ($test_dsn =~ /(.*)\;?f_dir=([^\;]*)\;?(.*)/) {
+ $dir = $2;
+ $test_dsn = $1 . (length($3) ? ";$3" : '');
+} else {
+ $dir = "output";
+}
+if (! -d $dir && !mkdir $dir, 0755) {
+ die "Cannot create directory $dir: $!";
+}
+
+while (Testing()) {
+ #
+ # Connect to the database
+ my $dbh;
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or die "Cannot connect";
+
+ #
+ # Check, whether the f_dir attribute works
+ #
+ my $table = '';
+ my $tableb = '';
+ if (!$state) {
+ $dbh->{f_dir} = $dir;
+ print "Trying to create file $table in directory $dir.\n";
+ }
+ Test($state
+ or (($table = FindNewTable($dbh))
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $table) : "$dir/$table"))))
+ or print("Cannot determine a legal table name: Error ",
+ $dbh->errstr);
+ Test($state
+ or (($tableb = FindNewTable($dbh))
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $tableb) : "$dir/$tableb"))))
+ or print("Cannot determine a legal table name: Error ",
+ $dbh->errstr);
+ Test($state or ($table ne $tableb))
+ or print("Second table name same as first.\n");
+
+ my $cquery;
+ Test($state or (($cquery = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]))
+ and $dbh->do($cquery)))
+ or print("Cannot create table $table in directory $dir: ",
+ $dbh->errstr);
+ Test($state
+ or (-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $table) : "$dir/$table")))
+ or print("No such file in directory $dir: $table");
+ Test($state
+ or ($dbh->do("DROP TABLE $table")
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $table) : "$dir/$table"))))
+ or print("Cannot drop table $table in directory $dir: ",
+ $dbh->errstr());
+ Test($state or $dbh->disconnect());
+
+
+ #
+ # Try to read a semicolon separated file.
+ #
+
+ my $dsn = "DBI:CSV:f_dir=$dir;csv_eol=\015\012;csv_sep_char=\\;;";
+ Test($state or ($dbh = DBI->connect($dsn)))
+ or print "Cannot connect to DSN $dsn: $DBI::errstr\n";
+ my $tablec;
+ Test($state
+ or (($tablec = FindNewTable($dbh))
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $tablec) : "$dir/$tablec"))))
+ or print("Cannot determine a legal table name: Error ",
+ $dbh->errstr);
+ if (!$state) {
+ print "Trying to create file $tablec in directory $dir.\n";
+ }
+ Test($state or
+ $dbh->do("CREATE TABLE $tablec (id INTEGER, name CHAR(64))"))
+ or print("Cannot create table $tablec: ", $dbh->errstr(), "\n");
+ Test($state or
+ $dbh->do("INSERT INTO $tablec VALUES (1, ?)", undef, "joe"))
+ or print("Cannot insert data into $tablec: ", $dbh->errstr(), "\n");
+ Test($state or
+ $dbh->do("INSERT INTO $tablec VALUES (2, ?)", undef, "Jochen;"))
+ or print("Cannot insert data into $tablec: ", $dbh->errstr(), "\n");
+ my($sth, $ref);
+ Test($state or
+ ($sth = $dbh->prepare("SELECT * FROM $tablec")))
+ or print("Cannot prepare: ", $dbh->errstr(), "\n");
+ Test($state or $sth->execute())
+ or print("Cannot execute: ", $sth->errstr(), "\n");
+ Test($state or (($ref = $sth->fetchrow_arrayref()) and
+ $ref->[0] eq "1" and $ref->[1] eq "joe"))
+ or printf("Expected 1,joe, got %s,%s\n", ($ref->[0] || "undef"),
+ ($ref->[1] || "undef"));
+ Test($state or (($ref = $sth->fetchrow_arrayref()) and
+ $ref->[0] eq "2" and $ref->[1] eq "Jochen;"))
+ or printf("Expected 2,Jochen;, got %s,%s\n", ($ref->[0] || "undef"),
+ ($ref->[1] || "undef"));
+ Test($state
+ or ($dbh->do("DROP TABLE $tablec")
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $table) : "$dir/$tablec"))))
+ or print("Cannot drop table $tablec in directory $dir: ",
+ $dbh->errstr());
+ Test($state or $dbh->disconnect());
+
+ #
+ # Check, whether the csv_tables->{$table}->{file} attribute works
+ #
+ $dsn = "DBI:CSV:";
+ Test($state or ($dbh = DBI->connect($dsn)));
+ if (!$state) {
+ $dbh->{csv_tables}->{$table}->{file} =
+ $haveFileSpec ? File::Spec->catfile($dir, $tableb)
+ : "$dir/$tableb";
+ print "Trying to create file $tableb in directory $dir.\n";
+ }
+ Test($state or $dbh->do($cquery))
+ or print("Cannot create table $table in directory $dir: ",
+ $dbh->errstr);
+ Test($state
+ or (-f ($haveFileSpec ? File::Spec->catfile($dir, $tableb)
+ : "$dir/$tableb")))
+ or print("No such file in directory $dir: $tableb");
+ Test($state
+ or ($dbh->do("DROP TABLE $table")
+ and !(-f ($haveFileSpec ?
+ File::Spec->catfile($dir, $table) : "$dir/$tableb"))))
+ or print("Cannot drop table $table in directory $dir: ",
+ $dbh->errstr());
+
+}
+
@@ -0,0 +1,211 @@
+#!/usr/local/bin/perl
+#
+# Test suite for the admin functions of DBD::mSQL and DBD::mysql.
+#
+
+
+#
+# Make -w happy
+#
+$test_dsn = $test_user = $test_password = $verbose = '';
+$| = 1;
+
+
+#
+# Include lib.pl
+#
+$DBI::errstr = ''; # Make -w happy
+require DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+
+sub InDsnList($@) {
+ my($dsn, @dsnList) = @_;
+ my($d);
+ foreach $d (@dsnList) {
+ if ($d =~ /^dbi:[^:]+:$dsn\b/i) {
+ return 1;
+ }
+ }
+ 0;
+}
+
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ # Check if the server is awake.
+ $dbh = undef;
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)))
+ or ServerError();
+
+ Test($state or (@dsn = DBI->data_sources($mdriver)) >= 0);
+ if (!$state && $verbose) {
+ my $d;
+ print "List of $mdriver data sources:\n";
+ foreach $d (@dsn) {
+ print " $d\n";
+ }
+ print "List ends.\n";
+ }
+
+ my $drh;
+ Test($state or ($drh = DBI->install_driver($mdriver)))
+ or print STDERR ("Cannot obtain drh: " . $DBI::errstr);
+
+ #
+ # Check the ping method.
+ #
+ Test($state or $dbh->ping())
+ or ErrMsgF("Ping failed: %s.\n", $dbh->errstr);
+
+
+ if ($mdriver eq 'mSQL' or $mdriver eq 'mysql') {
+ my($testdsn) = "testaa";
+ my($testdsn1, $testdsn2);
+ my($accessDenied) = 0;
+ my($warning);
+ my($warningSub) = sub { $warning = shift };
+
+ if (!$state) {
+ while (InDsnList($testdsn, @dsn)) {
+ ++$testdsn;
+ }
+ $testdsn1 = $testdsn;
+ ++$testdsn1;
+ while (InDsnList($testdsn1, @dsn)) {
+ ++$testdsn1;
+ }
+ $testdsn2 = $testdsn1;
+ ++$testdsn2;
+ while (InDsnList($testdsn2, @dsn)) {
+ ++$testdsn2;
+ }
+
+ $SIG{__WARN__} = $warningSub;
+ $warning = '';
+ if (!($result = $drh->func($testdsn, '_CreateDB'))
+ and ($drh->errstr =~ /(access|permission) denied/i)) {
+ $accessDenied = 1;
+ $result = 1;
+ }
+ $SIG{__WARN__} = 'DEFAULT';
+ }
+
+ Test($state or $result)
+ or print STDERR ("Error while executing _CreateDB: "
+ . $drh->errstr);
+ Test($state or ($warning =~ /deprecated/))
+ or print STDERR ("Expected warning, got '$warning'.\n");
+
+ Test($state or $accessDenied
+ or InDsnList($testdsn, DBI->data_sources($mdriver)))
+ or print STDERR ("New DB not in DSN list\n");
+
+ $SIG{__WARN__} = $warningSub;
+ $warning = '';
+ Test($state or $accessDenied
+ or $drh->func($testdsn, '_DropDB'))
+ or print STDERR ("Error while executing _DropDB: "
+ . $drh->errstr);
+ Test($state or $accessDenied or ($warning =~ /deprecated/))
+ or print STDERR ("Expected warning, got '$warning'\n");
+ $SIG{__WARN__} = 'DEFAULT';
+
+ Test($state or $accessDenied
+ or !InDsnList($testdsn, DBI->data_sources($mdriver)))
+ or print STDERR ("New DB not removed from DSN list\n");
+
+ my($mayShutdown) = $ENV{'DB_SHUTDOWN_ALLOWED'};
+
+ Test($state or $accessDenied
+ or $drh->func('createdb', $testdsn1, 'admin'))
+ or printf STDERR ("\$drh->admin('createdb') failed: %s\n",
+ $drh->errstr);
+ Test($state or $accessDenied
+ or InDsnList($testdsn1, DBI->data_sources($mdriver)))
+ or printf STDERR ("DSN $testdsn1 not in DSN list.\n");
+ Test($state or $accessDenied
+ or $drh->func('dropdb', $testdsn1, 'admin'))
+ or printf STDERR ("\$drh->admin('dropdb') failed: %s\n",
+ $drh->errstr);
+ Test($state or $accessDenied
+ or !InDsnList($testdsn1, DBI->data_sources($mdriver)))
+ or printf STDERR ("DSN $testdsn1 not removed from DSN list.\n");
+ Test($state or $accessDenied
+ or $drh->func('createdb', $testdsn2, 'admin'))
+ or printf STDERR ("\$drh->admin('createdb') failed: %s\n",
+ $drh->errstr);
+ Test($state or $accessDenied
+ or InDsnList($testdsn2, DBI->data_sources($mdriver)))
+ or printf STDERR ("DSN $testdsn2 not in DSN list.\n");
+ Test($state or $accessDenied
+ or $drh->func('dropdb', $testdsn2, 'admin'))
+ or printf STDERR ("\$drh->admin('dropdb') failed: %s\n",
+ $drh->errstr);
+ Test($state or $accessDenied
+ or !InDsnList($testdsn2, DBI->data_sources($mdriver)))
+ or printf STDERR ("DSN $testdsn2 not removed from DSN list.\n");
+
+ if ($mdriver eq 'mysql') {
+ #
+ # Try to do a shutdown.
+ #
+ Test($state or !$mayShutdown or $accessDenied
+ or $dbh->func("shutdown", "admin"))
+ or ErrMsgF("Cannot shutdown database: %s.\n", $dbh->errstr);
+ if (!$state) {
+ sleep 10;
+ }
+
+ #
+ # Pinging should fail now.
+ #
+ Test($state or !$mayShutdown or $accessDenied or !$dbh->ping())
+ or print STDERR ("Shutdown failed (ping succeeded)");
+
+ #
+ # Restart the database
+ #
+ if (!$state && $mayShutdown && !$accessDenied) {
+ if (fork() == 0) {
+ close STDIN;
+ close STDOUT;
+ close STDERR;
+ exec "safe_mysqld &";
+ }
+ }
+ sleep 5;
+
+ #
+ # Try DBD::mysql's automatic reconnect
+ #
+ Test($state or $dbh->ping())
+ or ErrMsgF("Reconnect failed: %s.\n", $dbh->errstr);
+ }
+
+ Test($state or $dbh->disconnect);
+ }
+}
@@ -1,138 +1,247 @@
-#!/usr/bin/perl
+# Hej, Emacs, give us -*- perl mode here!
+#
+# $Id: lib.pl,v 1.1.1.1 1999/06/13 12:59:35 joe Exp $
+#
+# lib.pl is the file where database specific things should live,
+# whereever possible. For example, you define certain constants
+# here and the like.
+#
+
+#exit 0;
+use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password
+ $haveFileSpec);
-# lib.pl is the file where database specific things should live,
-# whereever possible. For example, you define certain constants
-# here and the like.
-use strict;
-use warnings;
+#
+# Driver names; EDIT THIS!
+#
+$mdriver = 'CSV';
+$dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver.
+ # The exception is DBD::pNET where we have to
+ # to separate between local driver (pNET) and
+ # the remote driver ($dbdriver)
-use File::Spec;
-my $testname = "output$$";
-my $base_dir = File::Spec->rel2abs (File::Spec->curdir ());
-my $test_dir = File::Spec->rel2abs ($testname);
-my $test_dsn = $ENV{DBI_DSN} || "DBI:CSV:f_dir=$testname";
-my $test_user = $ENV{DBI_USER} || "";
-my $test_pass = $ENV{DBI_PASS} || "";
+#
+# DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
+#
+$haveFileSpec = eval { require File::Spec };
+my $table_dir = $haveFileSpec ?
+ File::Spec->catdir(File::Spec->curdir(), 'output') : 'output';
+$test_dsn = $ENV{'DBI_DSN'}
+ || "DBI:$dbdriver:f_dir=$table_dir";
+$test_user = $ENV{'DBI_USER'} || "";
+$test_password = $ENV{'DBI_PASS'} || "";
-sub COL_NULLABLE () { 1 }
-sub COL_KEY () { 2 }
-my %v;
-{ my @req = qw( DBI SQL::Statement Text::CSV_XS DBD::CSV );
- my $req = join ";\n" => map { qq{require $_;\n\$v{"$_"} = $_->VERSION ()} } @req;
- eval $req;
+$::COL_NULLABLE = 1;
+$::COL_KEY = 2;
+eval {
+ require DBI;
+ $v->{DBI}= $DBI::VERSION;
+ require SQL::Statement;
+ $v->{SQL}= $SQL::Statement::VERSION;
+ require Text::CSV_XS;
+ $v->{CSV}= $Text::CSV_XS::VERSION;
+ require DBD::CSV;
+ $v->{DBD}= $DBD::CSV::VERSION;
+};
+if ($@) {
+ print STDERR "\n\nYOU ARE MISSING REQUIRED MODULES: [ ";
+ print STDERR "DBI " unless $v->{DBI};
+ print STDERR "SQL::Statement " unless $v->{SQL};
+ print STDERR "Text_CSV " unless $v->{CSV};
+ print STDERR "]\n\n";
+ exit 0;
+}
+
+my $file;
+if (-f ($file = "t/$dbdriver.dbtest") ||
+ -f ($file = "$dbdriver.dbtest") ||
+ -f ($file = "../tests/$dbdriver.dbtest") ||
+ -f ($file = "tests/$dbdriver.dbtest")) {
+ eval { require $file; };
if ($@) {
- my @missing = grep { !exists $v{$_} } @req;
- print STDERR "\n\nYOU ARE MISSING REQUIRED MODULES: [ @missing ]\n\n";
+ print STDERR "Cannot execute $file: $@.\n";
+ print "1..0\n";
exit 0;
- }
}
+}
+if (-f ($file = "t/$mdriver.mtest") ||
+ -f ($file = "$mdriver.mtest") ||
+ -f ($file = "../tests/$mdriver.mtest") ||
+ -f ($file = "tests/$mdriver.mtest")) {
+ eval { require $file; };
+ if ($@) {
+ print STDERR "Cannot execute $file: $@.\n";
+ print "1..0\n";
+ exit 0;
+ }
+}
-sub AnsiTypeToDb
-{
- my ($type, $size) = @_;
- my $uctype = uc $type;
-
- if ($uctype eq "CHAR" || $uctype eq "VARCHAR") {
- $size ||= 1;
- return "$uctype ($size)";
- }
-
- $uctype eq "BLOB" || $uctype eq "REAL" || $uctype eq "INTEGER" and
- return $uctype;
- $uctype eq "INT" and
- return "INTEGER";
+open (STDERR, ">&STDOUT") || die "Cannot redirect stderr" ;
+select (STDERR) ; $| = 1 ;
+select (STDOUT) ; $| = 1 ;
- warn "Unknown type $type\n";
- return $type;
- } # AnsiTypeToDb
-# This function generates a table definition based on an input list. The input
-# list consists of references, each reference referring to a single column. The
-# column reference consists of column name, type, size and a bitmask of certain
-# flags, namely
#
-# COL_NULLABLE - true, if this column may contain NULL's
-# COL_KEY - true, if this column is part of the table's primary key
-
-sub TableDefinition
+# The Testing() function builds the frame of the test; it can be called
+# in many ways, see below.
+#
+# Usually there's no need for you to modify this function.
+#
+# Testing() (without arguments) indicates the beginning of the
+# main loop; it will return, if the main loop should be
+# entered (which will happen twice, once with $state = 1 and
+# once with $state = 0)
+# Testing('off') disables any further tests until the loop ends
+# Testing('group') indicates the begin of a group of tests; you
+# may use this, for example, if there's a certain test within
+# the group that should make all other tests fail.
+# Testing('disable') disables further tests within the group; must
+# not be called without a preceding Testing('group'); by default
+# tests are enabled
+# Testing('enabled') reenables tests after calling Testing('disable')
+# Testing('finish') terminates a group; any Testing('group') must
+# be paired with Testing('finish')
+#
+# You may nest test groups.
+#
{
- my ($tablename, @cols) = @_;
+ # Note the use of the pairing {} in order to get local, but static,
+ # variables.
+ my (@stateStack, $count, $off);
- my @keys = ();
- foreach my $col (@cols) {
- $col->[2] & COL_KEY and push @keys, $col->[0];
+ $count = 0;
+
+ sub Testing(;$) {
+ my ($command) = shift;
+ if (!defined($command)) {
+ @stateStack = ();
+ $off = 0;
+ if ($count == 0) {
+ ++$count;
+ $::state = 1;
+ } elsif ($count == 1) {
+ my($d);
+ if ($off) {
+ print "1..0\n";
+ exit 0;
+ }
+ ++$count;
+ $::state = 0;
+ print "1..$::numTests\n";
+ } else {
+ return 0;
+ }
+ if ($off) {
+ $::state = 1;
+ }
+ $::numTests = 0;
+ } elsif ($command eq 'off') {
+ $off = 1;
+ $::state = 0;
+ } elsif ($command eq 'group') {
+ push(@stateStack, $::state);
+ } elsif ($command eq 'disable') {
+ $::state = 0;
+ } elsif ($command eq 'enable') {
+ if ($off) {
+ $::state = 0;
+ } else {
+ my $s;
+ $::state = 1;
+ foreach $s (@stateStack) {
+ if (!$s) {
+ $::state = 0;
+ last;
+ }
+ }
+ }
+ return;
+ } elsif ($command eq 'finish') {
+ $::state = pop(@stateStack);
+ } else {
+ die("Testing: Unknown argument\n");
}
+ return 1;
+ }
+
- my @colDefs;
- foreach my $col (@cols) {
- my $colDef = $col->[0] . " " . AnsiTypeToDb ($col->[1], $col->[2]);
- $col->[3] & COL_NULLABLE or $colDef .= " NOT NULL";
- push @colDefs, $colDef;
+#
+# Read a single test result
+#
+ sub Test ($;$$) {
+ my($result, $error, $diag) = @_;
+
+ ++$::numTests;
+ if ($count == 2) {
+ if (defined($diag)) {
+ printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n"));
+ }
+ if ($::state || $result) {
+ print "ok $::numTests ". (defined($error) ? "$error\n" : "\n");
+ return 1;
+ } else {
+ print("not ok $::numTests - " .
+ (defined($error) ? "$error\n" : "\n"));
+ print STDERR ("FAILED Test $::numTests - " .
+ (defined($error) ? "$error\n" : "\n"));
+ return 0;
+ }
}
- my $keyDef = @keys ? ", PRIMARY KEY (" . join (", ", @keys) . ")" : "";
- my $tq = $tablename =~ m/^\w+\./ ? qq{"$tablename"} : $tablename;
- return sprintf "CREATE TABLE %s (%s%s)", $tq,
- join (", ", @colDefs), $keyDef;
- } # TableDefinition
-
-# This function generates a list of tables associated to a given DSN.
-sub ListTables
-{
- my $dbh = shift or return;
+ return 1;
+ }
+}
- my @tables = $dbh->func ("list_tables");
- my $msg = $dbh->errstr || $DBI::errstr;
- $msg and die "Cannot create table list: $msg";
- @tables;
- } # ListTables
-sub DbCleanup
-{
- chdir $base_dir;
- -d $testname or return;
- chdir $testname or BAIL_OUT ("Cleanup failed");
- unlink glob "*";
- chdir $base_dir;
- rmdir $testname;
- } # DbCleanup
+#
+# Print a DBI error message
+#
+sub DbiError ($$) {
+ my($rc, $err) = @_;
+ $rc ||= 0;
+ $err ||= '';
+ print "Test $::numTests: DBI error $rc, $err\n";
+}
-mkdir $testname, 0755;
-END { DbCleanup (); }
-# This functions generates a list of possible DSN's aka
-# databases and returns a possible table name for a new
-# table being created.
#
-# Problem is, we have two different situations here: Test scripts
-# call us by pasing a dbh, which is fine for most situations.
-{ my $listTablesHook;
+# This functions generates a list of possible DSN's aka
+# databases and returns a possible table name for a new
+# table being created.
+#
+# Problem is, we have two different situations here: Test scripts
+# call us by pasing a dbh, which is fine for most situations.
+# From within DBD::pNET, however, the dbh isn't that meaningful.
+# Thus we are working with the global variable $listTablesHook:
+# Once defined, we call &$listTablesHook instead of ListTables.
+#
+# See DBD::pNET/t/pNET.mtest for details.
+#
+{
+ use vars qw($listTablesHook);
- my $testtable = "testaa";
- my $listed = 0;
+ my(@tables, $testtable, $listed);
- my @tables;
+ $testtable = "testaa";
+ $listed = 0;
- sub FindNewTable
- {
- my $dbh = shift;
+ sub FindNewTable($) {
+ my($dbh) = @_;
- unless ($listed) {
- if (defined $listTablesHook) {
- @tables = $listTablesHook->($dbh);
- }
- elsif (defined &ListTables) {
- @tables = ListTables ($dbh);
- }
- else {
+ if (!$listed) {
+ if (defined($listTablesHook)) {
+ @tables = &$listTablesHook($dbh);
+ } elsif (defined(&ListTables)) {
+ @tables = &ListTables($dbh);
+ } else {
die "Fatal: ListTables not implemented.\n";
- }
- $listed = 1;
}
+ $listed = 1;
+ }
# A small loop to find a free test table we can use to mangle stuff in
# and out of. This starts at testaa and loops until testaz, then testba
@@ -145,41 +254,21 @@ END { DbCleanup (); }
if ($table eq $testtable) {
$testtable++;
$foundtesttable = 1;
- }
}
}
+ }
$table = $testtable;
$testtable++;
return $table;
- } # FindNewTable
}
+}
-sub ServerError
-{
- die "# Cannot connect: $DBI::errstr\n";
- } # ServerError
-sub Connect
-{
- my $attr = @_ && ref $_[-1] eq "HASH" ? pop @_ : {};
- my ($dsn, $usr, $pass) = @_;
- $dsn ||= $test_dsn;
- $usr ||= $test_user;
- $pass ||= $test_pass;
- my $dbh = DBI->connect ($dsn, $usr, $pass, $attr) or ServerError;
- $dbh;
- } # Connect
-
-sub DbDir
-{
- @_ and $test_dir = File::Spec->catdir ($base_dir, shift);
- $test_dir;
- } # DbDir
+sub ErrMsg (\@) { print (@_); }
+sub ErrMsgF (\@) { printf (@_); }
+
+#sub ErrMsg (@_) { print (@_); }
+#sub ErrMsgF (@_) { printf (@_); }
-sub DbFile
-{
- my $file = shift or return;
- File::Spec->catdir ($test_dir, $file);
- } # DbFile
1;
@@ -0,0 +1,124 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mSQL.dbtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# database specific definitions for an 'mSQL' database
+
+
+# This function generates a mapping of ANSI type names to
+# database specific type names; it is called by TableDefinition().
+#
+sub AnsiTypeToDb ($;$) {
+ my ($type, $size) = @_;
+ my ($ret);
+
+ if ((lc $type) eq 'int' || (lc $type) eq 'integer') {
+ $ret = $type;
+ } elsif ((lc $type) eq 'char') {
+ $ret = "CHAR($size)";
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+ $ret;
+}
+
+
+#
+# This function generates a table definition based on an
+# input list. The input list consists of references, each
+# reference referring to a single column. The column
+# reference consists of column name, type, size and a bitmask of
+# certain flags, namely
+#
+# $COL_NULLABLE - true, if this column may contain NULL's
+# $COL_KEY - true, if this column is part of the table's
+# primary key
+#
+# Hopefully there's no big need for you to modify this function,
+# if your database conforms to ANSI specifications.
+#
+
+sub TableDefinition ($@) {
+ my($tablename, @cols) = @_;
+ my($def);
+
+ #
+ # Should be acceptable for most ANSI conformant databases;
+ #
+ # msql 1 uses a non-ANSI definition of the primary key: A
+ # column definition has the attribute "PRIMARY KEY". On
+ # the other hand, msql 2 uses the ANSI fashion ...
+ #
+ my($col, @keys, @colDefs, $keyDef);
+
+ #
+ # Count number of keys
+ #
+ @keys = ();
+ foreach $col (@cols) {
+ if ($$col[2] & $::COL_KEY) {
+ push(@keys, $$col[0]);
+ }
+ }
+ if (@keys > 1) {
+ warn "Warning: Your test won't run with msql 1\n";
+ }
+
+ foreach $col (@cols) {
+ my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
+ if (($$col[3] & $::COL_KEY) && @keys == 1) {
+ $colDef .= " PRIMARY KEY";
+ } elsif (!($$col[3] & $::COL_NULLABLE)) {
+ $colDef .= " NOT NULL";
+ }
+ push(@colDefs, $colDef);
+ }
+ if (@keys > 1 || defined(&DBD::mSQL::IDX_TYPE)) {
+ $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
+ } else {
+ $keyDef = "";
+ }
+ $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
+ join(", ", @colDefs), $keyDef);
+ if ($::verbose) {
+ print "Table definition: $def\n";
+ }
+ $def;
+}
+
+
+#
+# This function generates a list of tables associated to a
+# given DSN. Highly DBMS specific, EDIT THIS!
+#
+sub ListTables($) {
+ my($dbh) = @_;
+ my(@tables);
+
+ if (!defined(@tables = $dbh->func('_ListTables')) || $dbh->errstr) {
+ return undef;
+ }
+ @tables;
+}
+
+
+#
+# Return a string for checking, whether a given column is NULL.
+#
+sub IsNull($) {
+ my($var) = @_;
+
+ "$var = NULL";
+}
+
+
+#
+# Return TRUE, if database supports transactions
+#
+sub HaveTransactions () {
+ 0;
+}
+
+
+1;
@@ -0,0 +1,9 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mSQL.mtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# module specific definitions for an 'mSQL' database
+
+
+
+1;
@@ -0,0 +1,124 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mSQL1.dbtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# database specific definitions for an 'mSQL1' database
+
+
+# This function generates a mapping of ANSI type names to
+# database specific type names; it is called by TableDefinition().
+#
+sub AnsiTypeToDb ($;$) {
+ my ($type, $size) = @_;
+ my ($ret);
+
+ if ((lc $type) eq 'int' || (lc $type) eq 'integer') {
+ $ret = $type;
+ } elsif ((lc $type) eq 'char') {
+ $ret = "CHAR($size)";
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+ $ret;
+}
+
+
+#
+# This function generates a table definition based on an
+# input list. The input list consists of references, each
+# reference referring to a single column. The column
+# reference consists of column name, type, size and a bitmask of
+# certain flags, namely
+#
+# $COL_NULLABLE - true, if this column may contain NULL's
+# $COL_KEY - true, if this column is part of the table's
+# primary key
+#
+# Hopefully there's no big need for you to modify this function,
+# if your database conforms to ANSI specifications.
+#
+
+sub TableDefinition ($@) {
+ my($tablename, @cols) = @_;
+ my($def);
+
+ #
+ # Should be acceptable for most ANSI conformant databases;
+ #
+ # msql 1 uses a non-ANSI definition of the primary key: A
+ # column definition has the attribute "PRIMARY KEY". On
+ # the other hand, msql 2 uses the ANSI fashion ...
+ #
+ my($col, @keys, @colDefs, $keyDef);
+
+ #
+ # Count number of keys
+ #
+ @keys = ();
+ foreach $col (@cols) {
+ if ($$col[2] & $::COL_KEY) {
+ push(@keys, $$col[0]);
+ }
+ }
+ if (@keys > 1) {
+ warn "Warning: Your test won't run with msql 1\n";
+ }
+
+ foreach $col (@cols) {
+ my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
+ if (($$col[3] & $::COL_KEY) && @keys == 1) {
+ $colDef .= " PRIMARY KEY";
+ } elsif (!($$col[3] & $::COL_NULLABLE)) {
+ $colDef .= " NOT NULL";
+ }
+ push(@colDefs, $colDef);
+ }
+ if (@keys > 1 || defined(&DBD::mSQL1::IDX_TYPE)) {
+ $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
+ } else {
+ $keyDef = "";
+ }
+ $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
+ join(", ", @colDefs), $keyDef);
+ if ($::verbose) {
+ print "Table definition: $def\n";
+ }
+ $def;
+}
+
+
+#
+# This function generates a list of tables associated to a
+# given DSN. Highly DBMS specific, EDIT THIS!
+#
+sub ListTables($) {
+ my($dbh) = @_;
+ my(@tables);
+
+ if (!defined(@tables = $dbh->func('_ListTables')) || $dbh->errstr) {
+ return undef;
+ }
+ @tables;
+}
+
+
+#
+# Return a string for checking, whether a given column is NULL.
+#
+sub IsNull($) {
+ my($var) = @_;
+
+ "$var = NULL";
+}
+
+
+#
+# Return TRUE, if database supports transactions
+#
+sub HaveTransactions () {
+ 0;
+}
+
+
+1;
@@ -0,0 +1,9 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mSQL1.mtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# module specific definitions for an 'mSQL1' database
+
+
+
+1;
@@ -0,0 +1,132 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mysql.dbtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# database specific definitions for a 'mysql' database
+
+
+# This function generates a mapping of ANSI type names to
+# database specific type names; it is called by TableDefinition().
+#
+sub AnsiTypeToDb ($;$) {
+ my ($type, $size) = @_;
+ my ($ret);
+
+ if ((lc $type) eq 'blob') {
+ if ($size >= 1 << 16) {
+ $ret = 'MEDIUMBLOB';
+ } else {
+ $ret = 'BLOB';
+ }
+ } elsif ((lc $type) eq 'int' || (lc $type) eq 'integer') {
+ $ret = $type;
+ } elsif ((lc $type) eq 'char') {
+ $ret = "CHAR($size)";
+ } else {
+ warn "Unknown type $type\n";
+ $ret = $type;
+ }
+ $ret;
+}
+
+
+#
+# This function generates a table definition based on an
+# input list. The input list consists of references, each
+# reference referring to a single column. The column
+# reference consists of column name, type, size and a bitmask of
+# certain flags, namely
+#
+# $COL_NULLABLE - true, if this column may contain NULL's
+# $COL_KEY - true, if this column is part of the table's
+# primary key
+#
+# Hopefully there's no big need for you to modify this function,
+# if your database conforms to ANSI specifications.
+#
+
+sub TableDefinition ($@) {
+ my($tablename, @cols) = @_;
+ my($def);
+
+ #
+ # Should be acceptable for most ANSI conformant databases;
+ #
+ # msql 1 uses a non-ANSI definition of the primary key: A
+ # column definition has the attribute "PRIMARY KEY". On
+ # the other hand, msql 2 uses the ANSI fashion ...
+ #
+ my($col, @keys, @colDefs, $keyDef);
+
+ #
+ # Count number of keys
+ #
+ @keys = ();
+ foreach $col (@cols) {
+ if ($$col[2] & $::COL_KEY) {
+ push(@keys, $$col[0]);
+ }
+ }
+
+ foreach $col (@cols) {
+ my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
+ if (!($$col[3] & $::COL_NULLABLE)) {
+ $colDef .= " NOT NULL";
+ }
+ push(@colDefs, $colDef);
+ }
+ if (@keys) {
+ $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
+ } else {
+ $keyDef = "";
+ }
+ $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
+ join(", ", @colDefs), $keyDef);
+}
+
+
+#
+# This function generates a list of tables associated to a
+# given DSN.
+#
+sub ListTables(@) {
+ my($dbh) = shift;
+ my(@tables);
+
+ @tables = $dbh->func('_ListTables');
+ if ($dbh->errstr) {
+ die "Cannot create table list: " . $dbh->errstr;
+ }
+ @tables;
+}
+
+
+#
+# This function is called by DBD::pNET; given a hostname and a
+# dsn without hostname, return a dsn for connecting to dsn at
+# host.
+sub HostDsn ($$) {
+ my($hostname, $dsn) = @_;
+ "$dsn:$hostname";
+}
+
+
+#
+# Return a string for checking, whether a given column is NULL.
+#
+sub IsNull($) {
+ my($var) = @_;
+
+ "$var IS NULL";
+}
+
+
+#
+# Return TRUE, if database supports transactions
+#
+sub HaveTransactions () {
+ 0;
+}
+
+
+1;
@@ -0,0 +1,8 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: mysql.mtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# module specific definitions for a 'mysql' database
+
+
+1;
@@ -0,0 +1,8 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: pNET.dbtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# database specific definitions for a 'mysql' database
+
+
+die "Misconfiguration: DBD::pNET cannot be configured as database driver";
@@ -0,0 +1,181 @@
+# Hej, Emacs, give us -*- perl -*- mode here!
+#
+# $Id: pNET.mtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# database specific definitions for the DBI proxy 'DBD::pNET'
+
+
+#
+# DSN being used; EDIT THIS!
+#
+my $cipherDef = "";
+my ($hostname, $dsn);
+if (!$test_dsn) {
+ die "Need \$test_dsn being set in lib.pl.\n";
+}
+if ($dbdriver eq 'Ingres') {
+ $hostname = $ENV{'II_HOST'} || $ENV{'PNET_HOST'} || 'localhost';
+} else {
+ $hostname = $ENV{'PNET_HOST'} || 'localhost';
+}
+TryToConnect($hostname, $test_dsn, $test_user, $test_password);
+$dsn = "DBI:pNET:hostname=$hostname:port=3334";
+$@ = '';
+eval "use Crypt::DES";
+if (!$@) {
+ $dsn .= ":key=0123456789abcdef:cipher=DES";
+ $cipherDef .= " encryption DES\n"
+ . " key 0123456789abcdef\n"
+ . " encryptModule Crypt::DES\n";
+ eval "use Crypt::IDEA";
+ if (!$@) {
+ $dsn .= ":userkey=0123456789abcdef0123456789abcdef"
+ . ":usercipher=IDEA";
+ $cipherDef .= " $test_user encrypt=\"Crypt::IDEA,IDEA,"
+ . "0123456789abcdef0123456789abcdef\"\n"
+ }
+}
+$test_dsn = "$dsn:dsn=DBI:$dbdriver:test";
+
+
+# For testing DBD::pNET, we need a server available. So, fork
+# a child and let it run as a server.
+
+$childPid = undef;
+
+sub childGone () {
+ my $pid = wait;
+ if (defined($childPid) && $pid == $childPid) {
+ undef $childPid;
+ }
+ $SIG{'CHLD'} = \&childGone;
+}
+
+sub StartServer () {
+ my ($path, $file, $clients);
+ if (!open(CLIENTS, ">t/clients")) {
+ die "Cannot create 'clients' file: $!\n";
+ }
+ print CLIENTS <<"EOF";
+accept localhost
+ users $test_user
+$cipherDef
+
+deny .*
+EOF
+ close(CLIENTS);
+
+ foreach $file ("./blib/script/pNETagent",
+ "../blib/script/pNETagent",
+ "./pNETagent",
+ "../pNETagent") {
+ if (-x $file) {
+ $path = $file;
+ last;
+ }
+ }
+
+ if (!$path) {
+ die "Cannot find pNETagent script.\n";
+ }
+
+ $SIG{'CHLD'} = \&childGone;
+
+ my $pid;
+ if (!defined($pid = fork())) {
+ die "Cannot fork: $!";
+ }
+ if (!$pid) {
+ # This is the child, start as the server
+ exec "perl -Iblib/lib -Iblib/arch $path --port 3334 --debug --configFile t/clients --pidFile pNETagent.pid";
+ } else {
+ $childPid = $pid;
+ }
+}
+
+sub StopServer () {
+ if (defined($childPid)) {
+ kill 15, $childPid;
+ undef $childPid;
+ sleep 5;
+ }
+}
+
+use Sys::Syslog;
+if (defined(&Sys::Syslog::setlogsock)) {
+ Sys::Syslog::setlogsock('unix');
+}
+Sys::Syslog::openlog($0, '', 'daemon');
+StartServer();
+sleep 5;
+END {
+ StopServer();
+# if (-f 't/clients') { unlink 't/clients'; }
+ if (-f 'pNETagent.pid') { unlink 'pNETagent.pid'; }
+ exit 0;
+}
+
+
+############################################################################
+#
+# For typical drivers, we'd define a function ListTables here.
+# As of pNET, however, we are interested in using $dbdriver's
+# ListTables function.
+#
+# As a workaround we define a hook $listTablesHook pointing to
+# pNetListTables, that's called from within FindNewTable.
+# Advantages are:
+#
+# - We reuse the drivers ListTables
+# - We don't bother driver authors and testers with details
+# of DBD::pNET.
+#
+# Drawback is, this is getting somewhat complicated ...
+#
+############################################################################
+
+use vars qw($listTablesHook);
+
+{
+ my $listTablesData;
+ my $listTablesHostname;
+
+ sub TryToConnect ($$$$) {
+ my ($hostname, $dsn, $user, $password) = @_;
+
+ $listTablesData = [HostDsn($hostname, $dsn), $user, $password];
+ my $dbh = eval { DBI->connect(@$listTablesData) };
+ if (!$dbh) {
+ if( $0 !~ /00base\.t/) {
+ print "1..0\n";
+ print STDERR q{
+Unable to execute test suite on this platform. The test suite can only be
+executed if a
+
+ DBI->connect("DBI:$dbdriver:test", "$test_user", "$test_password");
+
+succeeds or you modify the test suite.
+};
+ exit 0;
+ }
+ } else {
+ $listTablesHook = \&pNetListTables;
+ $dbh->disconnect;
+ my $file;
+ }
+ }
+
+ sub pNetListTables ($) {
+ my ($dbh) = shift;
+ my ($ndbh) = DBI->connect(@$listTablesData);
+ if (!$ndbh) {
+ die "Cannot connect to dsn " . $listTablesData->[0] . ":"
+ . $DBI::errstr;
+ }
+ my @tables = ListTables($ndbh);
+ $ndbh->disconnect;
+ @tables;
+ }
+}
+
+1;
@@ -0,0 +1,81 @@
+#!/usr/local/bin/perl
+#
+# $Id: skeleton.test,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
+#
+# This is a skeleton test. For writing new tests, take this file
+# and modify/extend it.
+#
+
+
+#
+# Make -w happy
+#
+$test_dsn = $test_user = $test_password = '';
+
+
+#
+# Include lib.pl
+#
+require DBI;
+$mdriver = "";
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+if ($mdriver eq 'whatever') {
+ print "1..0\n";
+ exit 0;
+}
+
+
+#
+# Main loop; leave this untouched, put tests after creating
+# the new table.
+#
+while (Testing()) {
+ #
+ # Connect to the database
+ Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
+ $test_password)),
+ undef,
+ "Attempting to connect.\n");
+ or ErrMsgF("Cannot connect: Error %s.\n\n"
+ . "Make sure, your database server is up and running.\n"
+ . "Check that '$test_dsn' references a valid database"
+ . " name.\nDBI error message: $DBI::errstr");
+
+ #
+ # Find a possible new table name
+ #
+ Test($state or $table = FindNewTable($dbh))
+ or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
+ $dbh->errstr);
+
+ #
+ # Create a new table; EDIT THIS!
+ #
+ Test($state or ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]),
+ $dbh->do($def)))
+ or ErrMsgF("Cannot create table: Error %s.\n",
+ $dbh->errstr);
+
+
+ #
+ # and here's the right place for inserting new tests:
+ #
+ EDIT THIS!
+
+ #
+ # Finally drop the test table.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or ErrMsgF("Cannot DROP test table $table: %s.\n",
+ $dbh->errstr);
+ Test($state or $dbh->disconnect);
+}
@@ -1,4 +0,0 @@
-c_tmp,tmp
-1,ape
-2,monkey
-3,gorilla