[Bps-public-commit] r18982 - in DBIx-CheckConnectivity: lib/DBIx lib/DBIx/CheckConnectivity lib/DBIx/CheckConnectivity/Driver
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Mon Mar 30 21:07:43 EDT 2009
Author: sunnavy
Date: Mon Mar 30 21:07:42 2009
New Revision: 18982
Added:
DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver.pm
Modified:
DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity.pm
DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm
DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm
DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm
DBIx-CheckConnectivity/t/00.load.t
DBIx-CheckConnectivity/t/01.check.t
Log:
refactor a lot, also remove auto_create stuff
Modified: DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity.pm
==============================================================================
--- DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity.pm (original)
+++ DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity.pm Mon Mar 30 21:07:42 2009
@@ -5,8 +5,6 @@
use Carp;
our $VERSION = '0.01';
-our $AUTO_CREATE = 0;
-our $ERROR = '';
use base 'Exporter';
@@ -20,58 +18,21 @@
validate(
@_,
{
- dsn => { type => SCALAR, regex => qr/^dbi:/ },
- user => 0,
- password => 0,
- attribute => { type => HASHREF, optional => 1 },
+ dsn => { type => SCALAR, regex => qr/^dbi:/ },
+ user => 0,
+ password => 0,
+ attribute => { type => HASHREF, optional => 1 },
}
);
- my %args = @_;
- my $dsn = $args{dsn};
- my $user = $args{user} || '';
- my $password = $args{password} || '';
-
- my ( $driver, $database ) = $dsn =~ m/dbi:(\w+):(?:database=)?(\w+)/;
-
- my $dbh =
- DBI->connect( $dsn, $user, $password,
- { RaiseError => 0, PrintError => 0 },
- );
- if ($dbh) {
- $ERROR = ''; # reset the ERROR
- return 1;
- }
+ my %args = @_;
+ my $dsn = $args{dsn};
- # so we have an err
- $ERROR = DBI::errstr;
- if ($AUTO_CREATE) {
- my $driver_module = __PACKAGE__ . '::Driver::' . $driver;
- $driver_module->require
+ my ( $driver ) = $dsn =~ m/dbi:(\w+):/;
+ my $driver_module = __PACKAGE__ . '::Driver::' . $driver;
+ $driver_module->require
or confess "$driver is not supported yet, sorry";
- my $system_database = $driver_module->system_database;
- my $not_exist_error = $driver_module->not_exist_error;
-
- if ( $ERROR =~ $not_exist_error ) {
+ $driver_module->check_connectivity( @_ );
- # dbi:DriverName:database_name
- # dbi:DriverName:database_name at hostname:port
- # dbi:DriverName:database=database_name;host=host_name;port=port
- $dsn =~
-s/(?<=dbi:$driver:)[^;@]*(?=([;@]?))/( ( $1 && $1 eq ';' ) ? 'database=' : '' ) . $system_database /e;
- my $dbh =
- DBI->connect( $dsn, $user, $password,
- { RaiseError => 0, PrintError => 0 },
- );
- if ( $dbh && $dbh->do("create database $database") ) {
- $ERROR = ''; # reset the ERROR
- return 1;
- }
- else {
- $ERROR .= DBI::errstr;
- }
- }
- }
- return;
}
1;
@@ -91,12 +52,14 @@
=head1 SYNOPSIS
use DBIx::CheckConnectivity;
- if ( check_connectivity( dsn => 'dbi:mysql:database=myjifty', user => 'jifty',
- password => 'blabla' ) ) {
+ my ( $ret, $msg ) = check_connectivity( dsn => 'dbi:mysql:database=myjifty', user => 'jifty',
+ password => 'blabla' );
+
+ if ( $ret ) {
print 'we can connect';
}
else {
- warn "can not connect: $DBIx::CheckConnectivity::ERROR";
+ warn "can not connect: $msg";
}
=head1 DESCRIPTION
@@ -109,11 +72,8 @@
=item check_connectivity ( dsn => $dsn, user => $user, password => $password, attribute => $attribute )
return 1 if success, undef otherwise.
-
-if $AUTO_CREATE is set to true and the db has not been created yet, this sub will
-try to create the db, return 1 if success, undef otherwise.
-
-the error message is stored in $ERROR
+in list context, if connect fails, returns a list, the 1st one is undef,
+the 2nd one is the error message.
=back
@@ -121,12 +81,6 @@
L<DBI>, L<Params::Validate>
-
-=head1 INCOMPATIBILITIES
-
-when we connect a SQLite source, if the db doesn't exist, DBI will try to create the db automatically,
-so even $AUTO_CREATE is set to false, connect to a non-exist SQLite source will try to create the db anyway.
-
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
Added: DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver.pm
==============================================================================
--- (empty file)
+++ DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver.pm Mon Mar 30 21:07:42 2009
@@ -0,0 +1,70 @@
+package DBIx::CheckConnectivity::Driver;
+
+use warnings;
+use strict;
+use Carp;
+
+use DBI;
+use Params::Validate qw/:all/;
+
+sub check_connectivity {
+ my $class = shift;
+ validate(
+ @_,
+ {
+ dsn => { type => SCALAR, regex => qr/^dbi:/ },
+ user => 0,
+ password => 0,
+ attribute => { type => HASHREF, optional => 1 },
+ }
+ );
+ my %args = @_;
+ my $dsn = $args{dsn};
+ my $user = $args{user} || '';
+ my $password = $args{password} || '';
+
+ my $attribute = $args{attribute} || { RaiseError => 0, PrintError => 0 };
+ my ($database) = $dsn =~ m/dbi:(?:\w+):(?:database=)?(\w+)/;
+
+ my $dbh = DBI->connect( $dsn, $user, $password, $attribute );
+
+ return 1 if $dbh;
+ # so we have an err
+ return wantarray ? ( undef, DBI::errstr ) : undef;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::CheckConnectivity::DBI - util to check database's connectivity
+
+
+=head1 DESCRIPTION
+
+=head1 INTERFACE
+
+=over 4
+
+=item check_connectivity ( dsn => $dsn, user => $user, password => $password, attribute => $attribute )
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+=head1 AUTHOR
+
+sunnavy C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2009 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Modified: DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm
==============================================================================
--- DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm (original)
+++ DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm Mon Mar 30 21:07:42 2009
@@ -2,14 +2,7 @@
use warnings;
use strict;
-
-sub system_database {
- return 'template1';
-}
-
-sub not_exist_error {
- return qr/not exist/i;
-}
+use base qw/DBIx::CheckConnectivity::Driver/;
1;
@@ -23,14 +16,6 @@
=over 4
-=item system_database
-
-return 'template1'
-
-=item not_exist_error
-
-return qr/not exist/
-
=back
=head1 AUTHOR
Modified: DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm
==============================================================================
--- DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm (original)
+++ DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm Mon Mar 30 21:07:42 2009
@@ -1,10 +1,7 @@
package DBIx::CheckConnectivity::Driver::SQLite;
-
use warnings;
use strict;
-
-sub system_database { }
-sub not_exist_error { }
+use base qw/DBIx::CheckConnectivity::Driver/;
1;
@@ -18,14 +15,6 @@
=over 4
-=item system_database
-
-SQLite does not have system_database, return undef
-
-=item not_exist_error
-
-SQLite does not have not exist error, normally, it just create the file
-
=back
=head1 AUTHOR
Modified: DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm
==============================================================================
--- DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm (original)
+++ DBIx-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm Mon Mar 30 21:07:42 2009
@@ -1,15 +1,7 @@
package DBIx::CheckConnectivity::Driver::mysql;
-
use warnings;
use strict;
-
-sub system_database {
- return '';
-}
-
-sub not_exist_error {
- return qr/unknown database/i;
-}
+use base qw/DBIx::CheckConnectivity::Driver/;
1;
@@ -23,14 +15,6 @@
=over 4
-=item system_database
-
-return ''
-
-=item not_exist_error
-
-return qr/unknown database/i;
-
=back
=head1 AUTHOR
Modified: DBIx-CheckConnectivity/t/00.load.t
==============================================================================
--- DBIx-CheckConnectivity/t/00.load.t (original)
+++ DBIx-CheckConnectivity/t/00.load.t Mon Mar 30 21:07:42 2009
@@ -1,7 +1,8 @@
-use Test::More tests => 4;
+use Test::More tests => 5;
BEGIN {
use_ok( 'DBIx::CheckConnectivity' );
+use_ok( 'DBIx::CheckConnectivity::Driver' );
use_ok( 'DBIx::CheckConnectivity::Driver::Pg' );
use_ok( 'DBIx::CheckConnectivity::Driver::mysql' );
use_ok( 'DBIx::CheckConnectivity::Driver::SQLite' );
Modified: DBIx-CheckConnectivity/t/01.check.t
==============================================================================
--- DBIx-CheckConnectivity/t/01.check.t (original)
+++ DBIx-CheckConnectivity/t/01.check.t Mon Mar 30 21:07:42 2009
@@ -1,35 +1,14 @@
use strict;
use warnings;
-use Test::More tests => 29;
+use Test::More tests => 19;
use_ok('DBIx::CheckConnectivity');
use_ok('DBIx::CheckConnectivity::Driver::SQLite');
use_ok('DBIx::CheckConnectivity::Driver::Pg');
use_ok('DBIx::CheckConnectivity::Driver::mysql');
-is( DBIx::CheckConnectivity::Driver::mysql->system_database,
- '', 'system_database of mysql is empty' );
-is(
- DBIx::CheckConnectivity::Driver::mysql->not_exist_error,
- qr/unknown database/i,
- 'not_exist_error of mysql is qr/unknown database/i'
-);
-
-is( DBIx::CheckConnectivity::Driver::Pg->system_database,
- 'template1', 'system_database of Pg is empty' );
-is(
- DBIx::CheckConnectivity::Driver::Pg->not_exist_error,
- qr/not exist/i,
- 'not_exist_error of Pg is qr/not exist/i'
-);
-is( DBIx::CheckConnectivity::Driver::SQLite->system_database,
- undef, 'system_database of SQLite is undef' );
-is( DBIx::CheckConnectivity::Driver::SQLite->not_exist_error,
- undef, 'not_exist_error of SQLite is undef' );
-
-is( $DBIx::CheckConnectivity::AUTO_CREATE,
- 0, 'default we do not auto create' );
+my $error;
use Test::MockModule;
my $dbi = Test::MockModule->new('DBI');
@@ -49,11 +28,6 @@
);
if ( $dsn =~ /not_exist/ ) {
- if ($DBIx::CheckConnectivity::AUTO_CREATE) {
- DBI::errstr('');
- return 1;
- }
- else {
if ( $dsn =~ /mysql/ ) {
DBI::errstr('unknown database');
}
@@ -63,7 +37,6 @@
else {
DBI::errstr('');
}
- }
}
elsif ( $password =~ /wrong/ ) {
DBI::errstr('wrong password');
@@ -79,10 +52,10 @@
},
errstr => sub {
if (@_) {
- $DBIx::CheckConnectivity::_temp = shift;
+ $error = shift;
}
else {
- return $DBIx::CheckConnectivity::_temp;
+ return $error;
}
}
);
@@ -94,10 +67,10 @@
'normal mysql driver' );
ok( !check_connectivity( dsn => 'dbi:Pg:database=not_exist;' ),
'pg with not_exist db' );
-is( $DBIx::CheckConnectivity::ERROR, 'not exist', 'err' );
+is( $error, 'not exist', 'err' );
ok( !check_connectivity( dsn => 'dbi:mysql:database=not_exist;' ),
'mysql with not_exist db' );
-is( $DBIx::CheckConnectivity::ERROR, 'unknown database', 'err' );
+is( $error, 'unknown database', 'err' );
ok(
!check_connectivity(
@@ -106,9 +79,4 @@
),
'pg with wrong password'
);
-is( $DBIx::CheckConnectivity::ERROR, 'wrong password', 'err' );
-
-$DBIx::CheckConnectivity::AUTO_CREATE = 1;
-ok( check_connectivity( dsn => 'dbi:Pg:database=not_exist;' ),
- 'pg with not_exist db' );
-is( $DBIx::CheckConnectivity::ERROR, '', 'err' );
+is( $error, 'wrong password', 'err' );
More information about the Bps-public-commit
mailing list