package DBIx::PearDSN;
use URI::Escape qw(uri_unescape);
use Carp;
use base 'Exporter';
use strict;

our $VERSION   = '0.01';
our @EXPORT_OK = qw/parseDSN dbi_dsn pear/;
our @EXPORT    = qw/pear/;

sub parseDSN {
    return wantarray ? @_ : { @_ } if @_ > 1;
    my ($dsn) = @_;
    return wantarray ? %$dsn : $dsn if ref $dsn eq 'HASH';

    my %parsed;
    undef @parsed{qw/phptype dbsyntax protocol hostspec database usern
+ame password/};

    (my $str, $dsn) = split m[://], $dsn, 2;


    if ($str =~ /^(.+?)\((.*?)\)$/) {
        $parsed{phptype} = $1;
        $parsed{dbsyntax} = length($2) ? $2 : $1;
        croak 'dbsyntax property not supported' if $parsed{dbsyntax} n
+e $parsed{phptype};
    } else {
        $parsed{phptype} = $parsed{dbsyntax} = $str;
    }

    unless (length $dsn) {
        return wantarray ? %parsed : \%parsed;
    }

    if ((my $at = rindex($dsn, '@')) != -1) {
        $str = substr $dsn, 0, $at;
        $dsn = substr $dsn, $at + 1;
        @parsed{qw/username password/} = split /:/, $str, 2;
        defined and $_ = uri_unescape $_ for @parsed{qw/username passw
+ord/};
    }

    ($str, $dsn) = split m[/], $dsn, 2;
    if ($str =~ /\+/) {
        @parsed{qw/protocol hostspec/} = split /\+/, $str, 2;
        croak 'protocol property not supported' if $parsed{protocol};
    } else {
        $parsed{hostspec} = $str;
    }
    $_ = uri_unescape $_ for $parsed{hostspec};

    if (length $dsn) {
        $parsed{database} = $dsn;
    }

    return wantarray ? %parsed : \%parsed;
}

sub dbi_dsn {
    croak 'dbi_dsn must be used in list context' if not wantarray;
    my (%dsn) = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    @dsn{qw/hostspec port/} = split /:/, $dsn{hostspec}, 2;

    my %map = (
        msql => [
            'mSQL',
            {
                database => 'database',
                hostspec => 'host'
            }
        ],
        mysql => [
            'mysql',
            {
                database => 'database',
                hostspec => 'host',
                port     => 'port',
            }
        ],
        oci8 => [
            'Oracle',
            {
                database => 'sid',
                hostspec => 'host',
                port     => 'port'
            }
        ],
        pgsql => [
            'Pg',
            {
                database => 'dbname',
                hostspec => 'host',
                port     => 'port'
            }
        ],
        sybase => [
            'Sybase',
            {
                database => 'database',
                hostspec => 'sid'
            }
        ]
    );
    $map{lc $_} ||= $_ for values %map;

    my $db = $map{$dsn{phptype}} or croak "Database type $dsn{phptype}
+ not supported";

    my $dbi = "dbi:$db->[0]";
    my @opt ;
    for (sort keys %dsn) {
        next if $_ =~ /^(?:phptype|username|password|dbsyntax|protocol
+)$/;
        if (exists $db->[1]->{$_} and defined $dsn{$_} and length $dsn
+{$_}) {
            push @opt, "$db->[1]->{$_}=$dsn{$_}";
        } else {
            croak "$_ property not supported for database type $dsn{ph
+ptype}";
        }
    }
    $dbi .= ':' . join ';', @opt if @opt;
    return $dbi, $dsn{username}, $dsn{password};
}

sub pear ($) {
    return dbi_dsn(parseDSN(@_));
}

'sweet juicy gritty-textured fruit';

__END__

=head1 NAME

DBIx::PearDSN - An attempt to convert PEAR DSNs to DBI ones

=head1 SYNOPSIS

    use DBI;
    use DBIx::PearDSN;
    my $dbh = DBI->connect(
        pear 'mysql://user:p455w0rd@localhost/mydatabase',
        { RaiseError => 1 }
    );

    use DBIx::Simple;
    use DBIx::PearDSN;
    my $db = DBIx::Simple->connect(pear('mysql:///database'));

=head1 DISCLAIMER

This module has a very low version number, which has a reason. It has
not been tested with all databases. If you try it with an untested
database, and discover that it does or does not work, please let me
know.

=head1 DESCRIPTION

This module is an attempt to convert PEAR DSNs to DBI DSNs. PEAR is
the PHP Extension and Application Repository, an open source PHP
framework. PEAR seems to be inspired a lot by Perl.

I am not a PHP coder, but someone drove my attention to PEAR's DSN
(Data Source Name) syntax, an uri-like syntax for providing
connection information for databases. It is one of the few things I
actually like about PHP, and because Perl is and will always be more
powerful than PHP, this syntax should be available for Perl coders
too.

=head2 Functions

=over 12

=item C<pear>

Exported by default, and prototyped C<($)>. Given a PEAR DSN, this
function returns a list suitable for DBI's C<connect> method.

=item C<parseDSN>

Not exported by default. Given a list or hash reference, returns the
given list or hash reference as a list or hash reference, depending
on the context. Given a PEAR DSN, returns a list of key/value pairs,
or a hash reference.

This function is a Perl translation of PEAR's C<parseDSN> function
and should behave just like it.

=item C<dbi_dsn>

Not exported by default. Given something returned by parseDSN,
returns a three element list. The list consists of a DBI dsn, the
username and the password.

=back

=head1 PEAR

Unaltered quotation right from the PEAR source code, version 4.1.2:

    /**
     * Parse a data source name
     *
     * @param $dsn string Data Source Name to be parsed
     *
     * @return array an associative array with the following keys:
     *
     *  phptype: Database backend used in PHP (mysql, odbc etc.)
     *  dbsyntax: Database used with regards to SQL syntax etc.
     *  protocol: Communication protocol to use (tcp, unix etc.)
     *  hostspec: Host specification (hostname[:port])
     *  database: Database to use on the DBMS server
     *  username: User name for login
     *  password: Password for login
     *
     * The format of the supplied DSN is in its fullest form:
     *
     *  phptype(dbsyntax)://username:password@protocol+hostspec/databa
+se
     *
     * Most variations are allowed:
     *
     *  phptype://username:password@protocol+hostspec:110//usr/db_file
+.db
     *  phptype://username:password@hostspec/database_name
     *  phptype://username:password@hostspec
     *  phptype://username@hostspec
     *  phptype://hostspec/database
     *  phptype://hostspec
     *  phptype(dbsyntax)
     *  phptype
     *
     * @author Tomas V.V.Cox <cox@idecnet.com>
     */

=head1 BUGS AND LIMITATIONS

This module does not support the C<dbsyntax> and C<protocol>
properties, and has only limited database support.

The following databases are supported (for certain values of
"supported"):

    "phptype"   Tested
    msql        NO
    mysql       yes
    oci8        NO
    pgsql       NO
    sybase      NO

If you test an untested database type, please let me know if it
worked. I don't have all these databases, or the time needed to test
them all.

Use this module at your own risk. I disclaim all responsibility.

=head1 AUTHOR

Juerd <juerd@juerd.nl>

=cut
[download]

U28geW91IGNhbiBhbGwgcm90MTMgY
W5kIHBhY2soKS4gQnV0IGRvIHlvdS
ByZWNvZ25pc2UgQmFzZTY0IHdoZW4
geW91IHNlZSBpdD8gIC0tIEp1ZXJk