r55360 - in /branches/upstream/libtie-dbi-perl/current: Changes META.yml Makefile.PL README 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 04:55:54 UTC 2010
Author: jawnsy-guest
Date: Sat Apr 3 04:55:46 2010
New Revision: 55360
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55360
Log:
[svn-upgrade] Integrating new upstream version, libtie-dbi-perl (1.04)
Modified:
branches/upstream/libtie-dbi-perl/current/Changes
branches/upstream/libtie-dbi-perl/current/META.yml
branches/upstream/libtie-dbi-perl/current/Makefile.PL
branches/upstream/libtie-dbi-perl/current/README
branches/upstream/libtie-dbi-perl/current/lib/Tie/DBI.pm
branches/upstream/libtie-dbi-perl/current/lib/Tie/RDBM.pm
branches/upstream/libtie-dbi-perl/current/t/DBI.t
branches/upstream/libtie-dbi-perl/current/t/RDBM.t
Modified: branches/upstream/libtie-dbi-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/Changes?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/Changes (original)
+++ branches/upstream/libtie-dbi-perl/current/Changes Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/META.yml?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/META.yml (original)
+++ branches/upstream/libtie-dbi-perl/current/META.yml Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/Makefile.PL?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/Makefile.PL (original)
+++ branches/upstream/libtie-dbi-perl/current/Makefile.PL Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/README?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/README (original)
+++ branches/upstream/libtie-dbi-perl/current/README Sat Apr 3 04:55: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
Modified: branches/upstream/libtie-dbi-perl/current/lib/Tie/DBI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/lib/Tie/DBI.pm?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/lib/Tie/DBI.pm (original)
+++ branches/upstream/libtie-dbi-perl/current/lib/Tie/DBI.pm Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/lib/Tie/RDBM.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/lib/Tie/RDBM.pm?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/lib/Tie/RDBM.pm (original)
+++ branches/upstream/libtie-dbi-perl/current/lib/Tie/RDBM.pm Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/t/DBI.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/t/DBI.t?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/t/DBI.t (original)
+++ branches/upstream/libtie-dbi-perl/current/t/DBI.t Sat Apr 3 04:55: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: branches/upstream/libtie-dbi-perl/current/t/RDBM.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-dbi-perl/current/t/RDBM.t?rev=55360&op=diff
==============================================================================
--- branches/upstream/libtie-dbi-perl/current/t/RDBM.t (original)
+++ branches/upstream/libtie-dbi-perl/current/t/RDBM.t Sat Apr 3 04:55: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