From dc7bb5693a27402bd32dbd077525727aafcbc98c Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 25 Sep 2000 12:44:09 +0000 Subject: [PATCH 1/1] s/DBIx::Database/DBIx::DataSource/ --- Changes | 8 ++++ DataSource.pm | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++ DataSource/Driver.pm | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++ DataSource/Pg.pm | 77 +++++++++++++++++++++++++++++++++++++++ DataSource/mysql.pm | 78 +++++++++++++++++++++++++++++++++++++++ MANIFEST | 9 +++++ Makefile.PL | 10 +++++ README | 40 ++++++++++++++++++++ test.pl | 20 ++++++++++ 9 files changed, 443 insertions(+) create mode 100644 Changes create mode 100644 DataSource.pm create mode 100644 DataSource/Driver.pm create mode 100644 DataSource/Pg.pm create mode 100644 DataSource/mysql.pm create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 test.pl diff --git a/Changes b/Changes new file mode 100644 index 0000000..ac2bf29 --- /dev/null +++ b/Changes @@ -0,0 +1,8 @@ +Revision history for Perl extension DBIx::DataSource + +0.02 Mon Sep 25 03:54:55 2000 + - change name from DBIx::Database, oops! + +0.01 Wed Sep 20 22:56:58 2000 + - original version; created by h2xs 1.19 + diff --git a/DataSource.pm b/DataSource.pm new file mode 100644 index 0000000..87fef47 --- /dev/null +++ b/DataSource.pm @@ -0,0 +1,100 @@ +package DBIx::DataSource; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $errstr); +use Exporter; + +@ISA = qw(Exporter); +@EXPORT_OK = qw( create_database drop_database ); + +$VERSION = '0.02'; + +=head1 NAME + +DBIx::DataSource - Database-independant create and drop functions + +=head1 SYNOPSIS + + use DBIx::DataSource qw( create_database drop_database ); + + create_database( $data_source, $username, $password ) + or warn $DBIx::DataSource::errstr; + + drop_database( $data_source, $username, $password ) + or warn $DBIx::DataSource::errstr; + +=head1 DESCRIPTION + +This module implements create_database and drop_database functions for +databases. It aims to provide a common interface to database creation and +deletion regardless of the actual database being used. + +Currently supported databases are MySQL and PostgreSQL. Assistance adding +support for other databases is welcomed and relatively simple - see +L. + +=head1 FUNCTIONS + +=over 4 + +=item create_database DATA_SOURCE USERNAME PASSWORD + +Create the database specified by the given DBI data source. + +=cut + +sub create_database { + my( $dsn, $user, $pass ) = @_; + my $driver = _load_driver($dsn); + eval "DBIx::DataSource::$driver->create_database( \$dsn, \$user, \$pass )" + or do { $errstr=$@ if $@; ''; }; +} + +=item drop_database DATA_SOURCE + +Drop the database specified by the given DBI data source. + +=cut + +sub drop_database { + my( $dsn, $user, $pass ) = @_; + my $driver = _load_driver($dsn); + eval "DBIx::DataSource::$driver->drop_database( \$dsn, \$user, \$pass )" + or do { $errstr=$@ if $@; ''; }; +} + +sub _load_driver { + my $datasrc = shift; + $datasrc =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + my $driver = $1 or die "can't parse data source: $datasrc"; + require "DBIx/DataSource/$driver.pm"; + $driver; +} + +=back + +=head1 AUTHOR + +Ivan Kohler + +=head1 COPYRIGHT + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 BUGS + +If DBI data sources were objects, these functions would be methods. + +=head1 SEE ALSO + +L, L, L, +L + +=cut + +1; diff --git a/DataSource/Driver.pm b/DataSource/Driver.pm new file mode 100644 index 0000000..d848fa3 --- /dev/null +++ b/DataSource/Driver.pm @@ -0,0 +1,101 @@ +package DBIx::DataSource::Driver; + +use strict; +use vars qw($VERSION); +use DBI; + +$VERSION = '0.01'; + +=head1 NAME + +DBIx::DataSource::Driver - Driver Writer's Guide and base class + +=head1 SYNOPSIS + + perldoc DBIx::DataSource::Driver; + + or + + package DBIx::DataSource::FooBase; + use DBIx::DataSource::Driver; + @ISA = qw( DBIx::DataSource::Driver ); + +=head1 DESCRIPTION + +To implement a driver for your database: + +1) If you can create a database with an SQL command through DBI/DBD, simply + provide a parse_dsn class method which returns a list consisting of the + *actual* data source to use in DBI->connect and the SQL. + + package DBIx::DataSource::NewDatabase; + use DBIx::DataSource::Driver; + @ISA = qw( DBIx::DataSource::Driver ); + + sub parse_dsn { + my( $class, $action, $dsn ) = @_; + + # $action is `create' or `drop' + # for example, if you parse parse $dsn for $database, + # $sql = "$action $database"; + + # you can die on errors - it'll be caught + + ( $new_dsn, $sql ); + } + +2) Otherwise, you'll need to write B and B + class methods. + + package DBIx::DataSource::NewDatabase; + + sub create_database { + my( $class, $dsn, $user, $pass ) = @_; + + # for success, return true + # for failure, die (it'll be caught) + } + + sub drop_database { + my( $class, $dsn, $user, $pass ) = @_; + + # for success, return true + # for failure, die (it'll be caught) + } + +=cut + +sub create_database { shift->_sql('create', @_) }; +sub drop_database { shift->_sql('drop', @_) }; + +sub _sql { + my( $class, $action, $dsn, $user, $pass ) = @_; + my( $new_dsn, $sql ) = $class->parse_dsn($action, $dsn); + my $dbh = DBI->connect( $new_dsn, $user, $pass ) or die $DBI::errstr; +# $dbh->do($sql) or die $dbh->errstr; +# silly DBI. implicit DESTROY yummy. + $dbh->do($sql) or do { my $err = $dbh->errstr; $dbh->disconnect; die $err; }; + $dbh->disconnect or die $dbh->errstr; +} + +=head1 AUTHOR + +Ivan Kohler + +=head1 COPYRIGHT + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L + +=cut + +1; diff --git a/DataSource/Pg.pm b/DataSource/Pg.pm new file mode 100644 index 0000000..4956785 --- /dev/null +++ b/DataSource/Pg.pm @@ -0,0 +1,77 @@ +package DBIx::DataSource::Pg; + +use strict; +use vars qw($VERSION @ISA); +use DBIx::DataSource::Driver; +@ISA = qw( DBIx::DataSource::Driver ); + +$VERSION = '0.01'; + +=head1 NAME + +DBIx::DataSource::Pg - PostgreSQL driver for DBIx::DataSource + +=head1 SYNOPSIS + + use DBIx::DataSource; + + use DBIx::DataSource qw( create_database drop_database ); + + create_database( "dbi:Pg:dbname=$dbname", $username, $password ) + or warn $DBIx::DataSource::errstr; + + create_database( "dbi:Pg:dbname=$dbname;host=$host;port=$port", + $username, $password ) + or warn $DBIx::DataSource::errstr; + + drop_database( "dbi:Pg:dbname=$dbname", $username, $password ) + or warn $DBIx::DataSource::errstr; + + drop_database( "dbi:Pg:dbname=$dbname;host=$host;port=$port", + $username, $password ) + or warn $DBIx::DataSource::errstr; + +=head1 DESCRIPTION + +This is the PostgresSQL driver for DBIx::DataSource. + +=cut + +sub parse_dsn { + my( $class, $action, $dsn ) = @_; + $dsn =~ s/^(dbi:(\w*?)(?:\((.*?)\))?:)//i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + my $prefix = $1 or die "can't parse data source: $dsn"; + + my $database; + if ( $dsn =~ s/(^|[;:])dbname=([^=:;]+)([;:]|$)/$1dbname=template1$3/ ) { + $database = $2; + } else { + die "can't parse data source: $prefix$dsn"; + } + + ( "$prefix$dsn", "\U$action\E DATABASE $database" ); +} + +=head1 AUTHOR + +Ivan Kohler + +=head1 COPYRIGHT + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L + +=cut + +1; + diff --git a/DataSource/mysql.pm b/DataSource/mysql.pm new file mode 100644 index 0000000..f049e0a --- /dev/null +++ b/DataSource/mysql.pm @@ -0,0 +1,78 @@ +package DBIx::DataSource::mysql; + +use strict; +use vars qw($VERSION @ISA); +use DBIx::DataSource::Driver; +@ISA = qw( DBIx::DataSource::Driver ); + +$VERSION = '0.01'; + +=head1 NAME + +DBIx::DataSource::mysql - MySQL driver for DBIx::DataSource + +=head1 SYNOPSIS + + use DBIx::DataSource; + + use DBIx::DataSource qw( create_database drop_database ); + + create_database( "dbi:mysql:$database", $username, $password ) + or warn $DBIx::DataSource::errstr; + + create_database( "dbi:mysql:database=$database;host=$hostname;port=$port", + $username, $password ) + or warn $DBIx::DataSource::errstr; + + drop_database( "dbi:mysql:$database", $username, $password ) + or warn $DBIx::DataSource::errstr; + + drop_database( "dbi:mysql:database=$database;host=$hostname;port=$port", + $username, $password ) + or warn $DBIx::DataSource::errstr; + +=head1 DESCRIPTION + +This is the MySQL driver for DBIx::DataSource. + +=cut + +sub parse_dsn { + my( $class, $action, $dsn ) = @_; + $dsn =~ s/^(dbi:(\w*?)(?:\((.*?)\))?:)//i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + my $prefix = $1 or die "can't parse data source: $dsn"; + + my $database; + if ( $dsn =~ s/(^|[;:])(db|dbname|database)=([^=:;]+)([;:]|$)/$1$2=$4/ ) { + $database = $3; + } else { + $database = $dsn; + $dsn = ''; + } + + ( "$prefix$dsn", "\U$action\E DATABASE $database" ); +} + +=head1 AUTHOR + +Ivan Kohler + +=head1 COPYRIGHT + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, L + +=cut + +1; + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..50116ff --- /dev/null +++ b/MANIFEST @@ -0,0 +1,9 @@ +Changes +DataSource.pm +MANIFEST +Makefile.PL +test.pl +README +DataSource/Driver.pm +DataSource/mysql.pm +DataSource/Pg.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..6bbb492 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,10 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'DBIx::DataSource', + 'VERSION_FROM' => 'DataSource.pm', # finds $VERSION + 'PREREQ_PM' => { + 'DBI' => 0, + }, +); diff --git a/README b/README new file mode 100644 index 0000000..3bf9999 --- /dev/null +++ b/README @@ -0,0 +1,40 @@ +DBIx::DataSource + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Mail Abuse Prevention System LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +This module implements create and drop functions for databases. It aims to +provide a common interface to database creation and deletion regardless +of the actual database being used. + +Currently supported databases are MySQL and PostgreSQL. Assistance adding +support for other databases is welcomed and relatively simple - see the +DBIx::DataSource::Driver documentation. + +To install: + perl Makefile.PL + make + make test # nothing substantial yet + make install + +Documentation will then be available via `man DBIx::DataSource' or +`perldoc DBIx::DataSource'. + +Anonymous CVS access is available: + $ export CVSROOT=":pserver:anonymous@cleanwhisker.420.am:/home/cvs/cvsroot" + $ cvs login + (Logging in to anonymous@cleanwhisker.420.am) + CVS password: anonymous + $ cvs checkout DBIx-DataSource +as well as . + +A mailing list is available. Send a blank message to +. + +Homepage: + +$Id: README,v 1.1 2000-09-25 12:44:09 ivan Exp $ + diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..2cc6734 --- /dev/null +++ b/test.pl @@ -0,0 +1,20 @@ +# 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.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use DBIx::DataSource; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + -- 2.11.0