[Bps-public-commit] r18977 - in Database-CheckConnectivity: . lib/DBIx lib/DBIx/CheckConnectivity lib/Database t
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Mon Mar 30 09:47:11 EDT 2009
Author: sunnavy
Date: Mon Mar 30 09:47:10 2009
New Revision: 18977
Added:
Database-CheckConnectivity/lib/DBIx/
Database-CheckConnectivity/lib/DBIx/CheckConnectivity/
Database-CheckConnectivity/lib/DBIx/CheckConnectivity.pm
Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/
Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm
Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm
Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm
Removed:
Database-CheckConnectivity/lib/Database/
Modified:
Database-CheckConnectivity/Changes
Database-CheckConnectivity/MANIFEST
Database-CheckConnectivity/META.yml
Database-CheckConnectivity/Makefile.PL
Database-CheckConnectivity/README
Database-CheckConnectivity/t/00.load.t
Database-CheckConnectivity/t/01.check.t
Log:
Database:: is renamed to DBIx
Modified: Database-CheckConnectivity/Changes
==============================================================================
--- Database-CheckConnectivity/Changes (original)
+++ Database-CheckConnectivity/Changes Mon Mar 30 09:47:10 2009
@@ -1,4 +1,4 @@
-Revision history for Database-CheckConnectivity
+Revision history for DBIx-CheckConnectivity
0.01 Mon Mar 30 08:50:32 2009
Initial release.
Modified: Database-CheckConnectivity/MANIFEST
==============================================================================
--- Database-CheckConnectivity/MANIFEST (original)
+++ Database-CheckConnectivity/MANIFEST Mon Mar 30 09:47:10 2009
@@ -11,10 +11,10 @@
inc/Module/Install/Metadata.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
-lib/Database/CheckConnectivity.pm
-lib/Database/CheckConnectivity/Driver/mysql.pm
-lib/Database/CheckConnectivity/Driver/Pg.pm
-lib/Database/CheckConnectivity/Driver/SQLite.pm
+lib/DBIx/CheckConnectivity.pm
+lib/DBIx/CheckConnectivity/Driver/mysql.pm
+lib/DBIx/CheckConnectivity/Driver/Pg.pm
+lib/DBIx/CheckConnectivity/Driver/SQLite.pm
Makefile.PL
MANIFEST
META.yml
Modified: Database-CheckConnectivity/META.yml
==============================================================================
--- Database-CheckConnectivity/META.yml (original)
+++ Database-CheckConnectivity/META.yml Mon Mar 30 09:47:10 2009
@@ -11,7 +11,7 @@
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
-name: Database-CheckConnectivity
+name: DBIx-CheckConnectivity
no_index:
directory:
- inc
Modified: Database-CheckConnectivity/Makefile.PL
==============================================================================
--- Database-CheckConnectivity/Makefile.PL (original)
+++ Database-CheckConnectivity/Makefile.PL Mon Mar 30 09:47:10 2009
@@ -1,7 +1,7 @@
use inc::Module::Install;
-name 'Database-CheckConnectivity';
-all_from 'lib/Database/CheckConnectivity.pm';
+name 'DBIx-CheckConnectivity';
+all_from 'lib/DBIx/CheckConnectivity.pm';
author 'sunnavy <sunnavy at bestpractical.com>';
license 'perl';
Modified: Database-CheckConnectivity/README
==============================================================================
--- Database-CheckConnectivity/README (original)
+++ Database-CheckConnectivity/README Mon Mar 30 09:47:10 2009
@@ -1,4 +1,4 @@
-Database-CheckConnectivity version 0.01
+DBIx-CheckConnectivity version 0.01
INSTALLATION
Added: Database-CheckConnectivity/lib/DBIx/CheckConnectivity.pm
==============================================================================
--- (empty file)
+++ Database-CheckConnectivity/lib/DBIx/CheckConnectivity.pm Mon Mar 30 09:47:10 2009
@@ -0,0 +1,147 @@
+package DBIx::CheckConnectivity;
+
+use warnings;
+use strict;
+use Carp;
+
+our $VERSION = '0.01';
+our $AUTO_CREATE = 0;
+our $ERROR = '';
+
+use base 'Exporter';
+
+our @EXPORT = qw/check_connectivity/;
+
+use DBI;
+use Params::Validate qw/:all/;
+use UNIVERSAL::require;
+
+sub check_connectivity {
+ 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 ( $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;
+ }
+
+ # so we have an err
+ $ERROR = DBI::errstr;
+ if ($AUTO_CREATE) {
+ 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 ) {
+
+ # 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;
+
+__END__
+
+=head1 NAME
+
+DBIx::CheckConnectivity - util to check database's connectivity
+
+
+=head1 VERSION
+
+This document describes DBIx::CheckConnectivity version 0.01
+
+
+=head1 SYNOPSIS
+
+ use DBIx::CheckConnectivity;
+ if ( check_connectivity( dsn => 'dbi:mysql:database=myjifty', user => 'jifty',
+ password => 'blabla' ) ) {
+ print 'we can connect';
+ }
+ else {
+ warn "can not connect: $DBIx::CheckConnectivity::ERROR";
+ }
+
+=head1 DESCRIPTION
+
+
+=head1 INTERFACE
+
+=over 4
+
+=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
+
+=back
+
+=head1 DEPENDENCIES
+
+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.
+
+currently, only mysql, Pg and SQLite are supported.
+
+=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.
+
Added: Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm
==============================================================================
--- (empty file)
+++ Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/Pg.pm Mon Mar 30 09:47:10 2009
@@ -0,0 +1,47 @@
+package DBIx::CheckConnectivity::Driver::Pg;
+
+use warnings;
+use strict;
+
+sub system_database {
+ return 'template1';
+}
+
+sub not_exist_error {
+ return qr/not exist/i;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::CheckConnectivity::Pg -
+
+=head1 INTERFACE
+
+=over 4
+
+=item system_database
+
+return 'template1'
+
+=item not_exist_error
+
+return qr/not exist/
+
+=back
+
+=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.
+
Added: Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm
==============================================================================
--- (empty file)
+++ Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/SQLite.pm Mon Mar 30 09:47:10 2009
@@ -0,0 +1,42 @@
+package DBIx::CheckConnectivity::Driver::SQLite;
+
+use warnings;
+use strict;
+
+sub system_database { }
+sub not_exist_error { }
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::CheckConnectivity::SQLite -
+
+=head1 INTERFACE
+
+=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
+
+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.
+
Added: Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm
==============================================================================
--- (empty file)
+++ Database-CheckConnectivity/lib/DBIx/CheckConnectivity/Driver/mysql.pm Mon Mar 30 09:47:10 2009
@@ -0,0 +1,47 @@
+package DBIx::CheckConnectivity::Driver::mysql;
+
+use warnings;
+use strict;
+
+sub system_database {
+ return '';
+}
+
+sub not_exist_error {
+ return qr/unknown database/i;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::CheckConnectivity::mysql -
+
+=head1 INTERFACE
+
+=over 4
+
+=item system_database
+
+return ''
+
+=item not_exist_error
+
+return qr/unknown database/i;
+
+=back
+
+=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: Database-CheckConnectivity/t/00.load.t
==============================================================================
--- Database-CheckConnectivity/t/00.load.t (original)
+++ Database-CheckConnectivity/t/00.load.t Mon Mar 30 09:47:10 2009
@@ -1,10 +1,10 @@
use Test::More tests => 4;
BEGIN {
-use_ok( 'Database::CheckConnectivity' );
-use_ok( 'Database::CheckConnectivity::Driver::Pg' );
-use_ok( 'Database::CheckConnectivity::Driver::mysql' );
-use_ok( 'Database::CheckConnectivity::Driver::SQLite' );
+use_ok( 'DBIx::CheckConnectivity' );
+use_ok( 'DBIx::CheckConnectivity::Driver::Pg' );
+use_ok( 'DBIx::CheckConnectivity::Driver::mysql' );
+use_ok( 'DBIx::CheckConnectivity::Driver::SQLite' );
}
-diag( "Testing Database::CheckConnectivity $Database::CheckConnectivity::VERSION" );
+diag( "Testing DBIx::CheckConnectivity $DBIx::CheckConnectivity::VERSION" );
Modified: Database-CheckConnectivity/t/01.check.t
==============================================================================
--- Database-CheckConnectivity/t/01.check.t (original)
+++ Database-CheckConnectivity/t/01.check.t Mon Mar 30 09:47:10 2009
@@ -2,33 +2,33 @@
use warnings;
use Test::More tests => 29;
-use_ok('Database::CheckConnectivity');
-use_ok('Database::CheckConnectivity::Driver::SQLite');
-use_ok('Database::CheckConnectivity::Driver::Pg');
-use_ok('Database::CheckConnectivity::Driver::mysql');
+use_ok('DBIx::CheckConnectivity');
+use_ok('DBIx::CheckConnectivity::Driver::SQLite');
+use_ok('DBIx::CheckConnectivity::Driver::Pg');
+use_ok('DBIx::CheckConnectivity::Driver::mysql');
-is( Database::CheckConnectivity::Driver::mysql->system_database,
+is( DBIx::CheckConnectivity::Driver::mysql->system_database,
'', 'system_database of mysql is empty' );
is(
- Database::CheckConnectivity::Driver::mysql->not_exist_error,
+ DBIx::CheckConnectivity::Driver::mysql->not_exist_error,
qr/unknown database/i,
'not_exist_error of mysql is qr/unknown database/i'
);
-is( Database::CheckConnectivity::Driver::Pg->system_database,
+is( DBIx::CheckConnectivity::Driver::Pg->system_database,
'template1', 'system_database of Pg is empty' );
is(
- Database::CheckConnectivity::Driver::Pg->not_exist_error,
+ DBIx::CheckConnectivity::Driver::Pg->not_exist_error,
qr/not exist/i,
'not_exist_error of Pg is qr/not exist/i'
);
-is( Database::CheckConnectivity::Driver::SQLite->system_database,
+is( DBIx::CheckConnectivity::Driver::SQLite->system_database,
undef, 'system_database of SQLite is undef' );
-is( Database::CheckConnectivity::Driver::SQLite->not_exist_error,
+is( DBIx::CheckConnectivity::Driver::SQLite->not_exist_error,
undef, 'not_exist_error of SQLite is undef' );
-is( $Database::CheckConnectivity::AUTO_CREATE,
+is( $DBIx::CheckConnectivity::AUTO_CREATE,
0, 'default we do not auto create' );
use Test::MockModule;
@@ -49,7 +49,7 @@
);
if ( $dsn =~ /not_exist/ ) {
- if ($Database::CheckConnectivity::AUTO_CREATE) {
+ if ($DBIx::CheckConnectivity::AUTO_CREATE) {
DBI::errstr('');
return 1;
}
@@ -79,10 +79,10 @@
},
errstr => sub {
if (@_) {
- $Database::CheckConnectivity::_temp = shift;
+ $DBIx::CheckConnectivity::_temp = shift;
}
else {
- return $Database::CheckConnectivity::_temp;
+ return $DBIx::CheckConnectivity::_temp;
}
}
);
@@ -94,10 +94,10 @@
'normal mysql driver' );
ok( !check_connectivity( dsn => 'dbi:Pg:database=not_exist;' ),
'pg with not_exist db' );
-is( $Database::CheckConnectivity::ERROR, 'not exist', 'err' );
+is( $DBIx::CheckConnectivity::ERROR, 'not exist', 'err' );
ok( !check_connectivity( dsn => 'dbi:mysql:database=not_exist;' ),
'mysql with not_exist db' );
-is( $Database::CheckConnectivity::ERROR, 'unknown database', 'err' );
+is( $DBIx::CheckConnectivity::ERROR, 'unknown database', 'err' );
ok(
!check_connectivity(
@@ -106,9 +106,9 @@
),
'pg with wrong password'
);
-is( $Database::CheckConnectivity::ERROR, 'wrong password', 'err' );
+is( $DBIx::CheckConnectivity::ERROR, 'wrong password', 'err' );
-$Database::CheckConnectivity::AUTO_CREATE = 1;
+$DBIx::CheckConnectivity::AUTO_CREATE = 1;
ok( check_connectivity( dsn => 'dbi:Pg:database=not_exist;' ),
'pg with not_exist db' );
-is( $Database::CheckConnectivity::ERROR, '', 'err' );
+is( $DBIx::CheckConnectivity::ERROR, '', 'err' );
More information about the Bps-public-commit
mailing list