r55364 - in /trunk/libtie-dbi-perl: Changes META.yml Makefile.PL README debian/NEWS debian/changelog debian/clean debian/control debian/copyright debian/rules debian/source/ debian/source/format lib/Tie/DBI.pm lib/Tie/RDBM.pm t/DBI.t t/RDBM.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Apr 3 05:09:29 UTC 2010
Author: jawnsy-guest
Date: Sat Apr 3 05:08:46 2010
New Revision: 55364
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55364
Log:
* New upstream release
* Convert rules to new debhelper format
* Standards-Version 3.8.4 (drop perl version dep)
* Add myself to Uploaders and Copyright
* Rewrite control description
* Update copyright to new DEP5 format
* Use new 3.0 (quilt) source format
* Update copyright information
Added:
trunk/libtie-dbi-perl/debian/NEWS
trunk/libtie-dbi-perl/debian/clean
trunk/libtie-dbi-perl/debian/source/
trunk/libtie-dbi-perl/debian/source/format
Modified:
trunk/libtie-dbi-perl/Changes
trunk/libtie-dbi-perl/META.yml
trunk/libtie-dbi-perl/Makefile.PL
trunk/libtie-dbi-perl/README
trunk/libtie-dbi-perl/debian/changelog
trunk/libtie-dbi-perl/debian/control
trunk/libtie-dbi-perl/debian/copyright
trunk/libtie-dbi-perl/debian/rules
trunk/libtie-dbi-perl/lib/Tie/DBI.pm
trunk/libtie-dbi-perl/lib/Tie/RDBM.pm
trunk/libtie-dbi-perl/t/DBI.t
trunk/libtie-dbi-perl/t/RDBM.t
Modified: trunk/libtie-dbi-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/Changes?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/Changes (original)
+++ trunk/libtie-dbi-perl/Changes Sat Apr 3 05:08:46 2010
@@ -1,4 +1,13 @@
Revision history for Perl extension Tie::DBI.
+
+1.04 Mon Mar 31 22:25 2010
+ Add DBD::SQLite to build_requires meta so automated testing won't fail
+
+1.03 Mon Mar 29 13:00 2010
+ RT 3695 - SQLite support - Thanks RURBAN
+ RT 19833 - Don't Chomp blanks. The user can do that in their script if they intended it.
+ NOTE!!! This may break your code if you were depending on this behavior. Please open an RT ticket if you feel this needs to be put back in.
+ Test suite to Test::More
1.02 Wed Dec 28 12:57:18 EST 2005
Clarified requirement that column used as hash key must be declared
Modified: trunk/libtie-dbi-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/META.yml?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/META.yml (original)
+++ trunk/libtie-dbi-perl/META.yml Sat Apr 3 05:08:46 2010
@@ -1,10 +1,29 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Tie-DBI
-version: 1.02
-version_from: lib/Tie/DBI.pm
-installdirs: site
+--- #YAML:1.0
+name: Tie-DBI
+version: 1.04
+abstract: Tie hashes to DBI relational databases
+author:
+ - Lincoln D. Stein <lds at cpan.org>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ DBD::SQLite: 0
+ ExtUtils::MakeMaker: 0
+ Test::More: 0
requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+ DBI: 0
+ Test::More: 0
+resources:
+ homepage: http://wiki.github.com/toddr/Tie-DBI/
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/toddr/Tie-DBI
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libtie-dbi-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/Makefile.PL?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/Makefile.PL (original)
+++ trunk/libtie-dbi-perl/Makefile.PL Sat Apr 3 05:08:46 2010
@@ -3,12 +3,30 @@
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Tie::DBI',
- 'VERSION_FROM' => 'lib/Tie/DBI.pm', # finds $VERSION
-# 'PREREQ_PM' => {
-# Encode => 0.01,
-# },
+ 'AUTHOR' => 'Lincoln D. Stein <lds at cpan.org>',
+ 'VERSION_FROM' => 'lib/Tie/DBI.pm', # finds $VERSION
+ 'ABSTRACT_FROM' => 'lib/Tie/DBI.pm',
+ 'PREREQ_PM' => {
+ Test::More => 0,
+ DBI => 0,
+ },
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : ()),
'DISTNAME' => 'Tie-DBI',
'linkext' => { LINKTYPE=>'' }, # no link needed
'dist' => {'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',
- 'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'}
-);
+ 'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'},
+ 'clean' => { FILES => 'Tie-DBI-* test:* depth_test' },
+ 'META_MERGE' => {
+ build_requires => {
+ 'Test::More' => 0, # For testing
+ 'DBD::SQLite' => 0, # Make sure at least one DBD is there for automated testing
+ },
+ resources => {
+ license => 'http://dev.perl.org/licenses/',
+ homepage => 'http://wiki.github.com/toddr/Tie-DBI/',
+# bugtracker => 'http://code.google.com/p/Tie-DBI/issues/list',
+ repository => 'http://github.com/toddr/Tie-DBI',
+# MailingList => 'http://groups.google.com/group/Tie-DBI',
+ },
+ },
+)
Modified: trunk/libtie-dbi-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/README?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/README (original)
+++ trunk/libtie-dbi-perl/README Sat Apr 3 05:08:46 2010
@@ -45,9 +45,9 @@
If you need to specify a different database, or need to provide a
username and password to log in, you can provide these values as DB,
-USER and PASS, respectively, as in:
+USER, PASS and HOST, respectively, as in:
- make test DRIVER=Oracle DB=DEMO USER=fred PASS=xyzzy
+ make test DRIVER=Oracle DB=DEMO USER=fred PASS=xyzzy HOST=localhost
And some drivers, such as Pg, want funny database names, as in:
@@ -77,6 +77,7 @@
7) DBD::Sybase (partial, croaks on each())
8) DBD::Solid
9) DBD::ODBC (on mysql ODBC driver)
+ 10) DBD::SQLite
Microsoft SQL server works partially with Tie::DBI (everything but
"each") and not at all with Tie::RDBM. This is because SQL server
Added: trunk/libtie-dbi-perl/debian/NEWS
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/NEWS?rev=55364&op=file
==============================================================================
--- trunk/libtie-dbi-perl/debian/NEWS (added)
+++ trunk/libtie-dbi-perl/debian/NEWS Sat Apr 3 05:08:46 2010
@@ -1,0 +1,8 @@
+libtie-dbi-perl (1.04-1) UNRELEASED; urgency=low
+
+ Whitespace characters (spaces, tabs, etc) are no longer stripped
+ automatically. This may break existing code if it depends on this
+ behaviour.
+
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 03 Apr 2010 01:34:33 -0400
+
Modified: trunk/libtie-dbi-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/changelog?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/debian/changelog (original)
+++ trunk/libtie-dbi-perl/debian/changelog Sat Apr 3 05:08:46 2010
@@ -1,4 +1,14 @@
-libtie-dbi-perl (1.02-2) UNRELEASED; urgency=low
+libtie-dbi-perl (1.04-1) UNRELEASED; urgency=low
+
+ [ Jonathan Yu ]
+ * New upstream release
+ * Convert rules to new debhelper format
+ * Standards-Version 3.8.4 (drop perl version dep)
+ * Add myself to Uploaders and Copyright
+ * Rewrite control description
+ * Update copyright to new DEP5 format
+ * Use new 3.0 (quilt) source format
+ * Update copyright information
[ gregor herrmann ]
* debian/control: Changed: Switched Vcs-Browser field to ViewSVN
@@ -7,7 +17,7 @@
[ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- -- gregor herrmann <gregoa at debian.org> Sun, 16 Nov 2008 20:48:27 +0100
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 03 Apr 2010 01:41:19 -0400
libtie-dbi-perl (1.02-1) unstable; urgency=low
Added: trunk/libtie-dbi-perl/debian/clean
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/clean?rev=55364&op=file
==============================================================================
--- trunk/libtie-dbi-perl/debian/clean (added)
+++ trunk/libtie-dbi-perl/debian/clean Sat Apr 3 05:08:46 2010
@@ -1,0 +1,1 @@
+test
Modified: trunk/libtie-dbi-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/control?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/debian/control (original)
+++ trunk/libtie-dbi-perl/debian/control Sat Apr 3 05:08:46 2010
@@ -1,11 +1,11 @@
Source: libtie-dbi-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7), libdbd-sqlite3-perl
-Build-Depends-Indep: perl (>= 5.6.10-12)
+Build-Depends: debhelper (>= 7.0.50)
+Build-Depends-Indep: perl, libdbd-sqlite3-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Gunnar Wolf <gwolf at debian.org>
-Standards-Version: 3.8.0
+Uploaders: Gunnar Wolf <gwolf at debian.org>, Jonathan Yu <jawnsy at cpan.org>
+Standards-Version: 3.8.4
Homepage: http://search.cpan.org/dist/Tie-DBI/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libtie-dbi-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libtie-dbi-perl/
@@ -13,15 +13,13 @@
Package: libtie-dbi-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}
-Description: Tie hashes to relational databases
- This module allows you to tie Perl associative arrays (hashes) to SQL
- databases using the DBI interface. The tied hash is associated with a
- table in a local or networked database. One field of the table becomes the
- hash key, and another becomes the value. Once tied, all the standard
- hash operations work, including iteration over keys and values.
+Description: module tying hashes to relational databases
+ Tie::DBI is a Perl module for using a database as a backing store for Perl's
+ hash data structure. One field of the table becomes the hash key, and another
+ becomes the value. Once tied, all standard hash operations work, including
+ iteration over keys and values.
.
- By using the Storable module (provided by perl), you may store
- arbitrarily complex Perl structures (including objects) into the hash
- and later retrieve them. When used in conjunction with a
- network-accessible database, this provides a simple way to transmit
- data structures between Perl programs on two different machines.
+ Using the Storable module, you may store complex Perl data structures (even
+ objects) in the database and later retrieve them. When used in conjunction
+ with a network-accessible database, this provides a simple way to transmit
+ data structures between Perl programs on different machines.
Modified: trunk/libtie-dbi-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/copyright?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/debian/copyright (original)
+++ trunk/libtie-dbi-perl/debian/copyright Sat Apr 3 05:08:46 2010
@@ -1,28 +1,30 @@
-Format-Specification:
- http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
-Upstream-Maintainer: Lincoln Stein, lstein at w3.org
-Upstream-Source: http://search.cpan.org/dist/Tie-DBI/
-Upstream-Name: Tie-DBI
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=59
+Maintainer: Lincoln Stein <lstein at w3.org>
+Source: http://search.cpan.org/dist/Tie-DBI/
+Name: Tie-DBI
Files: *
-Copyright: Lincoln Stein, lstein at w3.org
-License-Alias: Perl
-License: Artistic | GPL-1+
+Copyright: 1998, Lincoln Stein <lstein at w3.org>
+License: Artistic or GPL-1+
Files: debian/*
-Copyright: 2008, Gunnar Wolf <gwolf at debian.org>
-License: Artistic | GPL-1+
+Copyright: 2010, Jonathan Yu <jawnsy at cpan.org>
+ 2008, Gunnar Wolf <gwolf at debian.org>
+License: Artistic or GPL-1+
License: Artistic
- This program is free software; you can redistribute it and/or modify
- it under the terms of the Artistic License, which comes with Perl.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in /usr/share/common-licenses/Artistic
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the Artistic License, which comes with Perl.
+ .
+ On Debian GNU/Linux systems, the complete text of the Artistic License
+ can be found in `/usr/share/common-licenses/Artistic'
License: GPL-1+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 1, or (at your option)
- any later version.
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL'
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+ .
+ On Debian GNU/Linux systems, the complete text of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL'
+
Modified: trunk/libtie-dbi-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/rules?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/debian/rules (original)
+++ trunk/libtie-dbi-perl/debian/rules Sat Apr 3 05:08:46 2010
@@ -1,26 +1,7 @@
#!/usr/bin/make -f
-build: build-stamp
-build-stamp:
- dh build --before test
- export DRIVER=SQLite && $(MAKE) test
- [ -f test ] && rm test # dummy DB generated by the tests
- dh build --after test
- touch $@
-
-clean:
+%:
dh $@
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
+override_dh_auto_test:
+ DRIVER=SQLite dh_auto_test
Added: trunk/libtie-dbi-perl/debian/source/format
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/debian/source/format?rev=55364&op=file
==============================================================================
--- trunk/libtie-dbi-perl/debian/source/format (added)
+++ trunk/libtie-dbi-perl/debian/source/format Sat Apr 3 05:08:46 2010
@@ -1,0 +1,1 @@
+3.0 (quilt)
Modified: trunk/libtie-dbi-perl/lib/Tie/DBI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/lib/Tie/DBI.pm?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/lib/Tie/DBI.pm (original)
+++ trunk/libtie-dbi-perl/lib/Tie/DBI.pm Sat Apr 3 05:08:46 2010
@@ -4,7 +4,7 @@
use vars qw($VERSION);
use Carp;
use DBI;
-$VERSION = '1.02';
+$VERSION = '1.04';
BEGIN {
eval {
@@ -96,7 +96,7 @@
$dbh = $class->connect($dsn,$self->{user},$self->{password},
{ AutoCommit=>$self->{AUTOCOMMIT},
- ChopBlanks=>1,
+ #ChopBlanks=>1, # Removed per RT 19833 This may break legacy code.
PrintError=>0,
Warn=>$self->{WARN},
}
Modified: trunk/libtie-dbi-perl/lib/Tie/RDBM.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/lib/Tie/RDBM.pm?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/lib/Tie/RDBM.pm (original)
+++ trunk/libtie-dbi-perl/lib/Tie/RDBM.pm Sat Apr 3 05:08:46 2010
@@ -4,7 +4,7 @@
use vars qw($VERSION %Types);
use Carp;
use DBI;
-$VERSION = '0.70';
+$VERSION = '0.72';
# %Types is used for creating the data table if it doesn't exist already.
# You may want to edit this.
Modified: trunk/libtie-dbi-perl/t/DBI.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/t/DBI.t?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/t/DBI.t (original)
+++ trunk/libtie-dbi-perl/t/DBI.t Sat Apr 3 05:08:46 2010
@@ -1,24 +1,15 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-# change this if you need to
+use strict;
+use warnings;
+use Test::More tests => 26;
my $DRIVER = $ENV{DRIVER};
use constant USER => $ENV{USER};
use constant PASS => $ENV{PASS};
use constant DBNAME => $ENV{DB} || 'test';
+use constant HOST => $ENV{HOST} || ($^O eq 'cygwin') ? '127.0.0.1' : 'localhost';
-BEGIN { $| = 1; print "1..32\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use lib './lib','../lib';
use DBI;
use Tie::DBI;
-$loaded = 1;
######################### End of black magic.
@@ -26,12 +17,12 @@
local($^W)=0; # kill uninitialized variable warning
# I like mysql best, followed by Oracle and Sybase
my ($count) = 0;
- my (%DRIVERS) = map { ($_,$count++) } qw(Informix Pg Ingres mSQL Sybase Oracle mysql); # ExampleP doesn't work;
- ($DRIVER) = sort { $DRIVERS{$b}<=>$DRIVERS{$a} } DBI->available_drivers(1);
+ my (%DRIVERS) = map { ($_,$count++) } qw(Informix Pg Ingres mSQL Sybase Oracle mysql SQLite); # ExampleP doesn't work;
+ ($DRIVER) = sort { $DRIVERS{$b}<=>$DRIVERS{$a} } grep {exists $DRIVERS{$_}} DBI->available_drivers(1);
}
if ($DRIVER) {
- print STDERR "Using DBD driver $DRIVER...";
+ diag("DBI.t - Using DBD driver $DRIVER...");
} else {
die "Found no DBD driver to use.\n";
}
@@ -85,21 +76,16 @@
['eggs', 1.00, 12, 'Farm-fresh Atlantic eggs']
);
-sub test {
- local($^W) = 0;
- my($num, $true,$msg) = @_;
- print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
-
sub initialize_database {
local($^W) = 0;
my $dsn;
if ($DRIVER eq 'Pg') { $dsn = "dbi:$DRIVER:dbname=${\DBNAME}"; }
- else { $dsn = "dbi:$DRIVER:${\DBNAME}"; }
- my $dbh = DBI->connect($dsn,USER,PASS,{ChopBlanks=>1}) || return undef;
+ else { $dsn = "dbi:$DRIVER:${\DBNAME}:${\HOST}"; }
+ my $dbh = DBI->connect($dsn,USER,PASS,{PrintError=>0}) || return undef;
$dbh->do("DROP TABLE testTie");
return $dbh if $DRIVER eq 'ExampleP';
my $table = $TABLES{$DRIVER} || DEFAULT_TABLE;
+
foreach (split(';',$table)) {
$dbh->do($_) || warn $DBI::errstr;
}
@@ -123,23 +109,27 @@
$a;
}
-test 1,$loaded;
+my %h;
my $dbh = initialize_database;
-{ local($^W)=0;
- test 2,$dbh,"Couldn't create test table: $DBI::errstr";
- die unless $dbh;
+{
+ local($^W)=0;
+ ok($dbh, "DBH returned from init_db") or die("Couldn't create test table: $DBI::errstr");
}
-test 3,tie %h,Tie::DBI,{db=>$dbh,table=>'testTie',key=>'produce_id',CLOBBER=>3,WARN=>0};
+isa_ok(tie(%h,'Tie::DBI',{db=>$dbh,table=>'testTie',key=>'produce_id',CLOBBER=>3,WARN=>0}), 'Tie::DBI');
%h=() unless $DRIVER eq 'ExampleP';
-test 4,!scalar(keys %h);
-test 5,insert_data(\%h);
-test 6,exists($h{strawberries});
-test 7,defined($h{strawberries});
-test 8,join(" ",map {chopBlanks($_)} sort keys %h) eq "apricots bananas eggs kiwis strawberries";
-test 9,$h{eggs}->{quantity} == 12;
-test 10,$h{eggs}->{quantity} *= 2;
-test 11,$h{eggs}->{quantity} == 24;
+is(scalar(keys %h), 0, '%h is empty');
+
+{
+ local($^W = 0);
+ ok(insert_data(\%h), "Insert data into db");
+}
+ok(exists($h{strawberries}));
+ok(defined($h{strawberries}));
+is(join(" ",map {chopBlanks($_)} sort keys %h), "apricots bananas eggs kiwis strawberries");
+is($h{eggs}->{quantity}, 12);
+$h{eggs}->{quantity} *= 2;
+is($h{eggs}->{quantity}, 24);
my $total_price = 0;
my $count = 0;
@@ -148,35 +138,43 @@
$total_price += $value->{price} * $value->{quantity};
$count++;
}
-test 12,$count == 5;
-test 13,abs($total_price - 85.2) < 0.01;
+is($count, 5);
+cmp_ok(abs($total_price - 85.2), '<', 0.01);
-test 14,$h{'cherries'} = { description=>'Vine-ripened cherries',price=>2.50,quantity=>200 };
-test 15,$h{'cherries'}{quantity} == 200;
-test 16,$h{'cherries'} = { price => 2.75 };
-test 17,$h{'cherries'}{quantity} == 200;
-test 18,$h{'cherries'}{price} == 2.75;
-test 19,join(" ",map {chopBlanks($_)} sort keys %h) eq "apricots bananas cherries eggs kiwis strawberries";
+$h{'cherries'} = { description=>'Vine-ripened cherries',price=>2.50,quantity=>200 };
+is($h{'cherries'}{quantity}, 200);
-test 20,delete $h{'cherries'};
-test 21,!$h{'cherries'};
+$h{'cherries'} = { price => 2.75 };
+is($h{'cherries'}{quantity}, 200);
+is($h{'cherries'}{price}, 2.75);
+is(join(" ",map {chopBlanks($_)} sort keys %h), "apricots bananas cherries eggs kiwis strawberries");
-test 22,my $array = $h{'eggs','strawberries'};
-test 23,$array->[1]->{'description'} eq 'Fresh Maine strawberries';
+ok(delete $h{'cherries'});
+is(exists $h{'cherries'}, '');
-test 24,my $another_array = $array->[1]->{'produce_id','quantity'};
-test 25,"@{$another_array}" eq 'strawberries 8';
+my $array = $h{'eggs','strawberries'};
+is($array->[1]->{'description'}, 'Fresh Maine strawberries');
-test 26, at fields = tied(%h)->select_where('quantity > 10');
-test 27,join(" ",sort @fields) eq 'bananas eggs';
+my $another_array = $array->[1]->{'produce_id','quantity'};
+is("@{$another_array}", 'strawberries 8');
-test 28,delete $h{strawberries}->{quantity};
-if ($DRIVER eq 'CSV') {
- print STDERR "Skipping test 29 for CSV driver...";
- print "ok 29\n";
-} else {
- test 29,!defined($h{strawberries}->{quantity});
+is(@fields = tied(%h)->select_where('quantity > 10'), 2);
+is(join(" ",sort @fields), 'bananas eggs');
+
+SKIP: {
+ skip "Skipping test for CSV driver...", 1 if($DRIVER eq 'CSV');
+
+ delete $h{strawberries}->{quantity};
+ ok(!defined $h{strawberries}->{quantity}, 'Quantity was deleted');
}
-test 30,$h{strawberries}->{quantity}=42;
-test 31,$h{strawberries}->{quantity}=42; # make sure update statement works when nothing changes
-test 32,$h{strawberries}->{quantity}==42;
+
+ok($h{strawberries}->{quantity}=42);
+ok($h{strawberries}->{quantity}=42); # make sure update statement works when nothing changes
+is($h{strawberries}->{quantity}, 42);
+
+# RT 19833 - Trailing space inappropriatley stripped.
+use constant TEST_STRING => ' extra spaces ';
+my $before = TEST_STRING;
+$h{strawberries}->{description} = $before;
+my $after = $h{strawberries}->{description};
+is($after, $before, "blanks aren't chopped");
Modified: trunk/libtie-dbi-perl/t/RDBM.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtie-dbi-perl/t/RDBM.t?rev=55364&op=diff
==============================================================================
--- trunk/libtie-dbi-perl/t/RDBM.t (original)
+++ trunk/libtie-dbi-perl/t/RDBM.t Sat Apr 3 05:08:46 2010
@@ -1,81 +1,68 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-# change this if you need to
+use strict;
+use warnings;
+use Test::More tests => 19;
my $DRIVER = $ENV{DRIVER};
use constant USER => $ENV{USER};
use constant PASS => $ENV{PASS};
use constant DBNAME => $ENV{DB} || 'test';
+use constant HOST => $ENV{HOST} || ($^O eq 'cygwin') ? '127.0.0.1' : 'localhost';
-BEGIN { $| = 1; print "1..20\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use lib './lib','../lib';
use DBI;
use Tie::RDBM;
-$loaded = 1;
-
-######################### End of black magic.
-
-sub test {
- local($^W) = 0;
- my($num, $true,$msg) = @_;
- print($true ? "ok $num\n" : "not ok $num $msg\n");
-}
unless ($DRIVER) {
local($^W)=0; # kill uninitialized variable warning
# Test using the mysql, sybase, oracle and mSQL databases respectively
my ($count) = 0;
- my (%DRIVERS) = map { ($_,$count++) } qw(Informix Pg Ingres mSQL Sybase Oracle mysql); # ExampleP doesn't work
- ($DRIVER) = sort { $DRIVERS{$b}<=>$DRIVERS{$a} } DBI->available_drivers(1);
+ my (%DRIVERS) = map { ($_,$count++) } qw(Informix Pg Ingres mSQL Sybase Oracle mysql SQLite); # ExampleP doesn't work
+ ($DRIVER) = sort { $DRIVERS{$b}<=>$DRIVERS{$a} } grep {exists $DRIVERS{$_}} DBI->available_drivers(1);
}
if ($DRIVER) {
- print STDERR "Using DBD driver $DRIVER...";
+ diag("RDBM.t - Using DBD driver $DRIVER...");
} else {
die "Found no DBD driver to use.\n";
}
my $dsn;
if ($DRIVER eq 'Pg') { $dsn = "dbi:$DRIVER:dbname=${\DBNAME}"; }
- else { $dsn = "dbi:$DRIVER:${\DBNAME}"; }
+ else { $dsn = "dbi:$DRIVER:${\DBNAME}:${\HOST}"; }
-print "ok 1\n";
-test 2,tie %h,'Tie::RDBM',$dsn,{create=>1,drop=>1,table=>'PData','warn'=>0,user=>USER,password=>PASS};
+
+my %h;
+isa_ok(tie(%h,'Tie::RDBM',$dsn,{create=>1,drop=>1,table=>'PData','warn'=>0,user=>USER,password=>PASS}), 'Tie::RDBM');
%h=();
-test 3,!scalar(keys %h);
-test 4,$h{'fred'} = 'ethel';
-test 5,$h{'fred'} eq 'ethel';
-test 6,$h{'ricky'} = 'lucy';
-test 7,$h{'ricky'} eq 'lucy';
-test 8,$h{'fred'} = 'lucy';
-test 9,$h{'fred'} eq 'lucy';
-test 10,exists($h{'fred'});
-test 11,delete $h{'fred'};
-test 12,!exists($h{'fred'});
-if (tied(%h)->{canfreeze})
-{
- local($^W) = 0; # avoid uninitialized variable warning
- test 13,$h{'fred'}={'name'=>'my name is fred','age'=>34};
- test 14,$h{'fred'}->{'age'} == 34;
-} else {
- print STDERR "Skipping tests 13-14 on this platform...";
- print "ok 13 (skipped)\n"; #skip
- print "ok 14 (skipped)\n"; #skip
- $h{'fred'} = 'junk';
+is(scalar(keys %h), 0);
+
+is($h{'fred'} = 'ethel', 'ethel');
+is($h{'fred'}, 'ethel');
+is($h{'ricky'} = 'lucy', 'lucy');
+is($h{'ricky'}, 'lucy');
+is($h{'fred'} = 'lucy', 'lucy');
+is($h{'fred'}, 'lucy');
+
+ok(exists($h{'fred'}));
+ok(delete $h{'fred'});
+ok(!exists($h{'fred'}));
+
+SKIP: {
+ if (!tied(%h)->{canfreeze}) {
+ $h{'fred'} = 'junk';
+ skip 'Not working on this DBD', 2;
+ }
+
+ local($^W) = 0; # avoid uninitialized variable warning
+ ok($h{'fred'}={'name'=>'my name is fred','age'=>34});
+ is($h{'fred'}->{'age'}, 34);
}
-test 15,join(" ",sort keys %h) eq "fred ricky";
-test 16,$h{'george'}=42;
-test 17,join(" ",sort keys %h) eq "fred george ricky";
+is(join(" ",sort keys %h), "fred ricky");
+is($h{'george'}=42, 42);
+is(join(" ",sort keys %h), "fred george ricky");
untie %h;
-test 18,tie %i,'Tie::RDBM',$dsn,{table=>'PData',user=>USER,password=>PASS};
-test 19,$i{'george'}==42;
-test 20,join(" ",sort keys %i) eq "fred george ricky";
+my %i;
+isa_ok(tie(%i,'Tie::RDBM',$dsn,{table=>'PData',user=>USER,password=>PASS}), 'Tie::RDBM');
+is($i{'george'}, 42);
+is(join(" ",sort keys %i), "fred george ricky");
More information about the Pkg-perl-cvs-commits
mailing list