Driver arg for new() support DBI handle

LICENSE

@@ -1,4 +1,4 @@
-This software is copyright (c) 2013 by Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>.
+This software is copyrighted (c) 2013 by Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>, and copyrighted (c) 2004 by David Baird.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@ b) the "Artistic License"
 
 --- The GNU General Public License, Version 1, February 1989 ---
 
-This software is Copyright (c) 2013 by Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>.
+This software is copyrighted (c) 2013 by Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>, and copyrighted (c) 2004 by David Baird.
 
 This is free software, licensed under:
 

META.json

@@ -54,7 +54,8 @@
          "requires" : {
             "Test::More" : "0.98",
             "Test::Requires" : "0",
-            "Tie::IxHash" : "0"
+            "Tie::IxHash" : "0",
+            "DBD::SQLite" : "0"
          }
       }
    },

README.md

@@ -35,9 +35,9 @@ SQL::Maker is yet another SQL builder class. It is based on [DBIx::Skinny](http:
 
     Attributes are following:
 
-    - driver: Str
+    - driver: Str or DBI handle
 
-        Driver name is required. The driver type is needed to create SQL string.
+        Driver name or DBI handle is required. The driver type is needed to create SQL string.
 
     - quote\_char: Str
 
@@ -256,5 +256,7 @@ Whole code was taken from [DBIx::Skinny](http://search.cpan.org/perldoc?DBIx::Sk
 
 Copyright (C) Tokuhiro Matsuno
 
+Copyright (C) 2004 David Baird (for dbh driver handling)
+
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.

lib/SQL/Maker.pm

@@ -32,7 +32,7 @@ sub new {
     unless ($args{driver}) {
         Carp::croak("'driver' is required for creating new instance of $class");
     }
-    my $driver = $args{driver};
+    my $driver = $class->_find_database_type($args{driver});
     unless ( defined $args{quote_char} ) {
     $args{quote_char} = do{
         if ($driver eq  'mysql') {
@@ -42,7 +42,7 @@ sub new {
         }
     };
     }
-    $args{select_class} = $driver eq 'Oracle' ? 'SQL::Maker::Select::Oracle' : 'SQL::Maker::Select';
+    $args{select_class} = $driver eq 'oracle' ? 'SQL::Maker::Select::Oracle' : 'SQL::Maker::Select';
 
     return bless {
         name_sep => '.',
@@ -297,6 +297,44 @@ sub select_query {
     return $stmt;
 }
 
+sub _find_database_type {
+    my ($class, $driver) = @_;
+    my $db;
+
+    if (ref $driver) {
+        if (eval { $driver->{Driver}->{Name} }) {
+            # dbh of DBI
+            return $class->_find_database_from_dbh($driver);
+        }
+        else {
+            Carp::croak("unsupported ORM object: " . ref $driver);
+        }
+    }
+    else {
+        return lc $driver;
+    }
+}
+
+sub _find_database_from_dbh {
+    my ($class, $dbh) = @_;
+
+    my $driver = $dbh->{Driver}->{Name}
+        or Carp::croak("no driver in $dbh");
+
+    if (lc $driver eq 'proxy') {
+        ( $driver ) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/;
+    }
+
+    $driver = lc $driver;
+
+    my ( $odbc, $ado ) = ( $driver eq 'odbc', $driver eq 'ado' );
+    if ($odbc || $ado) {
+        Carp::croak("ODBC nor ADO are not supported.");
+    }
+
+    return $driver;
+}
+
 1;
 __END__
 
@@ -346,9 +384,9 @@ Attributes are following:
 
 =over 4
 
-=item driver: Str
+=item driver: Str or DBI handle
 
-Driver name is required. The driver type is needed to create SQL string.
+Driver name or DBI handle is required. The driver type is needed to create SQL string.
 
 =item quote_char: Str
 
@@ -608,6 +646,8 @@ Whole code was taken from L<DBIx::Skinny> by nekokak++.
 
 Copyright (C) Tokuhiro Matsuno
 
+Copyright (C) 2004 David Baird (for dbh driver handling)
+
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 

t/01_dbh.t

@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More;
+use SQL::Maker;
+use Test::Requires qw(
+    Tie::IxHash
+    DBI
+    DBD::SQLite
+);
+
+sub ordered_hashref {
+    tie my %params, Tie::IxHash::, @_;
+    return \%params;
+}
+
+subtest 'new with dbh of SQLite as driver' => sub {
+    subtest 'driver: sqlite' => sub {
+        my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:", "", "");
+        my $builder = SQL::Maker->new(driver => $dbh);
+
+        do {
+            my $stmt = $builder->select_query('foo' => ['foo', 'bar'], ordered_hashref(bar => 'baz', john => 'man'), {order_by => 'yo'});
+            is $stmt->as_sql, qq{SELECT "foo", "bar"\nFROM "foo"\nWHERE ("bar" = ?) AND ("john" = ?)\nORDER BY yo};
+            is join(',', $stmt->bind), 'baz,man';
+        };
+    };
+};
+
+done_testing;
+