diff --git a/LICENSE b/LICENSE index 8eb18d8..9d82187 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -This software is copyright (c) 2013 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME. +This software is copyrighted (c) 2013 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME, 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 Etokuhirom AAJKLFJEF@ GMAIL COME. +This software is copyrighted (c) 2013 by Tokuhiro Matsuno Etokuhirom AAJKLFJEF@ GMAIL COME, and copyrighted (c) 2004 by David Baird. This is free software, licensed under: diff --git a/META.json b/META.json index 21f91b6..49e0348 100644 --- a/META.json +++ b/META.json @@ -54,7 +54,8 @@ "requires" : { "Test::More" : "0.98", "Test::Requires" : "0", - "Tie::IxHash" : "0" + "Tie::IxHash" : "0", + "DBD::SQLite" : "0" } } }, diff --git a/README.md b/README.md index fa816e9..d7e8c01 100644 --- a/README.md +++ b/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. diff --git a/lib/SQL/Maker.pm b/lib/SQL/Maker.pm index 18680b1..829a824 100644 --- a/lib/SQL/Maker.pm +++ b/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 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. diff --git a/t/01_dbh.t b/t/01_dbh.t new file mode 100644 index 0000000..63d3ae6 --- /dev/null +++ b/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; +