DataSource/Pg.pm

   1 package DBIx::DataSource::Pg;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA);
   5 use DBIx::DataSource::Driver;
   6 @ISA = qw( DBIx::DataSource::Driver );
   7
   8 $VERSION = '0.02';
   9
  10 =head1 NAME
  11
  12 DBIx::DataSource::Pg - PostgreSQL driver for DBIx::DataSource
  13
  14 =head1 SYNOPSIS
  15
  16   use DBIx::DataSource;
  17
  18   use DBIx::DataSource qw( create_database drop_database );
  19
  20   create_database( "dbi:Pg:dbname=$dbname", $username, $password )
  21     or warn $DBIx::DataSource::errstr;
  22
  23   create_database( "dbi:Pg:dbname=$dbname;host=$host;port=$port",
  24                    $username, $password )
  25     or warn $DBIx::DataSource::errstr;
  26
  27   drop_database( "dbi:Pg:dbname=$dbname", $username, $password )
  28     or warn $DBIx::DataSource::errstr;
  29
  30   drop_database( "dbi:Pg:dbname=$dbname;host=$host;port=$port",
  31                   $username, $password )
  32     or warn $DBIx::DataSource::errstr;
  33
  34 =head1 DESCRIPTION
  35
  36 This is the PostgresSQL driver for DBIx::DataSource.
  37
  38 =cut
  39
  40 sub parse_dsn {
  41   my( $class, $action, $dsn ) = @_;
  42   $dsn =~ s/^(dbi:(\w*?)(?:\((.*?)\))?:)//i #nicked from DBI->connect
  43                         or '' =~ /()/; # ensure $1 etc are empty if match fails
  44   my $prefix = $1 or die "can't parse data source: $dsn";
  45
  46   my $database;
  47   if ( $dsn =~ s/(^|[;:])dbname=([^=:;]+)([;:]|$)/$1dbname=template1$3/ ) {
  48     $database = $2;
  49     die "Pg database names must be lowercase\n" if $database ne lc($database);
  50   } else {
  51     die "can't parse data source: $prefix$dsn";
  52   }
  53
  54   ( "$prefix$dsn", "\U$action\E DATABASE $database" );
  55 }
  56
  57 =head1 AUTHOR
  58
  59 Ivan Kohler <ivan-dbix-datasource@420.am>
  60
  61 =head1 COPYRIGHT
  62
  63 Copyright (c) 2000 Ivan Kohler
  64 Copyright (c) 2000 Mail Abuse Prevention System LLC
  65 All rights reserved.
  66 This program is free software; you can redistribute it and/or modify it under
  67 the same terms as Perl itself.
  68
  69 =head1 BUGS
  70
  71 =head1 SEE ALSO
  72
  73 L<DBIx::DataSource::Driver>, L<DBIx::DataSource>, L<DBD::Pg>, L<DBI>
  74
  75 =cut
  76
  77 1;
  78