r69608 - in /trunk/libdancer-plugin-database-perl: Changes META.yml README debian/changelog debian/control debian/copyright lib/Dancer/Plugin/Database.pm lib/Dancer/Plugin/Database/Handle.pm t/01-basic.t t/lib/TestApp.pm

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Fri Feb 25 12:12:36 UTC 2011


Author: jawnsy-guest
Date: Fri Feb 25 12:11:40 2011
New Revision: 69608

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=69608
Log:
* New upstream release
* Add myself to Copyright
* Rewrite control description

Modified:
    trunk/libdancer-plugin-database-perl/Changes
    trunk/libdancer-plugin-database-perl/META.yml
    trunk/libdancer-plugin-database-perl/README
    trunk/libdancer-plugin-database-perl/debian/changelog
    trunk/libdancer-plugin-database-perl/debian/control
    trunk/libdancer-plugin-database-perl/debian/copyright
    trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database.pm
    trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database/Handle.pm
    trunk/libdancer-plugin-database-perl/t/01-basic.t
    trunk/libdancer-plugin-database-perl/t/lib/TestApp.pm

Modified: trunk/libdancer-plugin-database-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/Changes?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/Changes (original)
+++ trunk/libdancer-plugin-database-perl/Changes Fri Feb 25 12:11:40 2011
@@ -1,4 +1,27 @@
 Revision history for Dancer-Plugin-Database
+
+1.20    2011-02-23
+        - New feature - automatically enable UTF-8 support if the app's charset
+          setting is set to 'UTF-8' and we know how to enable UTF-8 support for
+          the database driver in use.  This can be disabled with the new
+          auto_utf8 setting in the plugin's config.
+        - Bugfix - create test DB in memory, not a file named ":memory" by
+          accident.  This should fix test failures on Windows, e.g.:
+          http://www.cpantesters.org/cpan/report/d5987aa6-6d07-1014-91a2-7f5be4275be9
+
+
+1.11    2011-02-18
+        - Fix bug RT #65825 - quick_select didn't actually use the where clause
+          correctly.
+        - Extended test suite.
+        
+1.10    2011-02-11
+        - New feature quick_select
+        - Fix bug RT #65651, quick_insert generating SQL which MySQL/Postgres
+          didn't accept due to use of quote() rather than quote_identifier(),
+          thanks to Christian Sánchez and Michael Stiller
+        - Fix GH #5 - named connections not working properly - thanks to
+          "crayon"
 
 1.00    2011-01-10
         - Bumping to 1.00 to signify being ready for production use, for users

Modified: trunk/libdancer-plugin-database-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/META.yml?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/META.yml (original)
+++ trunk/libdancer-plugin-database-perl/META.yml Fri Feb 25 12:11:40 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Dancer-Plugin-Database
-version:            1.00
+version:            1.20
 abstract:           easy database connections for Dancer applications
 author:
     - David Precious <davidp at preshweb.co.uk>

Modified: trunk/libdancer-plugin-database-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/README?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/README (original)
+++ trunk/libdancer-plugin-database-perl/README Fri Feb 25 12:11:40 2011
@@ -19,6 +19,12 @@
         # DBI's DBI::db handle and adds a few convenience features, for example:
         get '/insert/:name' => sub {
             database->quick_insert('people', { name => params->{name} });
+        };
+
+        get '/users/:id' => sub {
+            template 'display_user', {
+                person => database->quick_select('users', { id => params->{id} }),
+            };
         };
 
         dance;
@@ -112,6 +118,15 @@
 
     (Thanks to Alan Haggai for this feature.)
 
+AUTOMATIC UTF-8 SUPPORT
+    As of version 1.20, if your application is configured to use UTF-8
+    (you've defined the `charset' setting in your app config as `UTF-8')
+    then support for UTF-8 for the database connection will be enabled, if
+    we know how to do so for the database driver in use.
+
+    If you do not want this behaviour, set `auto_utf8' to a false value when
+    providing the connection details.
+
 GETTING A DATABASE HANDLE
     Calling `database' will return a connected database handle; the first
     time it is called, the plugin will establish a connection to the
@@ -128,7 +143,7 @@
     You can also pass a hashref of settings if you wish to provide settings
     at runtime.
 
-CONVENIENCE FEATURES (quick_update, quick_insert, quick_delete)
+CONVENIENCE FEATURES (quick_select, quick_update, quick_insert, quick_delete)
     The handle returned by the `database' keyword is a
     Dancer::Plugin::Database::Handle object, which subclasses the `DBI::db'
     DBI connection handle. This means you can use it just like you'd
@@ -137,9 +152,15 @@
 
     Examples:
 
+      # Quickly fetch the (first) row whose ID is 42 as a hashref:
+      my $row = database->quick_select($table_name, { id => 42 });
+
+      # Fetch all badgers as an array of hashrefs:
+      my @badgers = database->quick_select('animals', { genus => 'Mellivora' });
+
       # Update the row where the 'id' column is '42', setting the 'foo' column to
       # 'Bar':
-      database->quick_update($table_name, { id => 42 }, { foo => 'Bar');
+      database->quick_update($table_name, { id => 42 }, { foo => 'Bar' });
 
       # Insert a new row, using a named connection (see above)
       database('connectionname')->quick_insert($table_name, { foo => 'Bar' });
@@ -157,12 +178,20 @@
 
     Feel free to fork the repo and submit pull requests!
 
+    Feedback and bug reports are always appreciated. Even a quick mail to
+    let me know the module is useful to you would be very nice - it's nice
+    to know if code is being actively used.
+
 ACKNOWLEDGEMENTS
     Igor Bujna
 
     Franck Cuny
 
     Alan Haggai
+
+    Christian Sánchez
+
+    Michael Stiller
 
 BUGS
     Please report any bugs or feature requests to

Modified: trunk/libdancer-plugin-database-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/debian/changelog?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/debian/changelog (original)
+++ trunk/libdancer-plugin-database-perl/debian/changelog Fri Feb 25 12:11:40 2011
@@ -1,3 +1,11 @@
+libdancer-plugin-database-perl (1.20-1) UNRELEASED; urgency=low
+
+  * New upstream release
+  * Add myself to Copyright
+  * Rewrite control description
+
+ -- Jonathan Yu <jawnsy at cpan.org>  Fri, 25 Feb 2011 07:33:49 -0500
+
 libdancer-plugin-database-perl (1.00-1) unstable; urgency=low
 
   * New upstream release.

Modified: trunk/libdancer-plugin-database-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/debian/control?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/debian/control (original)
+++ trunk/libdancer-plugin-database-perl/debian/control Fri Feb 25 12:11:40 2011
@@ -2,13 +2,12 @@
 Section: perl
 Priority: optional
 Build-Depends: debhelper (>= 7)
-Build-Depends-Indep:
+Build-Depends-Indep: perl,
  libdancer-perl,
  libdbd-sqlite3-perl,
  libdbi-perl,
  libtest-pod-perl,
- libtest-pod-coverage-perl,
- perl
+ libtest-pod-coverage-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Damyan Ivanov <dmn at debian.org>, gregor herrmann <gregoa at debian.org>,
  Jonathan Yu <jawnsy at cpan.org>
@@ -19,20 +18,14 @@
 
 Package: libdancer-plugin-database-perl
 Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends}, libdancer-perl,
- libdbi-perl, perl
-Description: easy database connections for Dancer applications
- Dancer::Plugin::Database provides an easy way to obtain a connected DBI
- database handle by simply calling the database keyword within your Dancer
- application.
+Depends: ${misc:Depends}, ${perl:Depends},
+ libdancer-perl,
+ libdbi-perl
+Description: plugin providing easy database connections
+ Dancer::Plugin::Database is a Dancer plugin that provides an easy way to
+ obtain a connected DBI database handle by simply calling the "database"
+ keyword within your Dancer application. It also ensures that the database
+ handle is still connected and valid.
  .
- It takes care of ensuring that the database handle is still connected and
- valid. If the handle was last asked for more than connection_check_threshold
- seconds ago, it will check that the connection is still alive, using either
- the $dbh->ping method if the DBD driver supports it, or performing a simple
- no-op query against the database if not. If the connection has gone away, a
- new connection will be obtained and returned. This avoids any problems for a
- long-running script where the connection to the database might go away.
- .
- The connection credentials and other information neded when connecting is
- retrieved from the Dancer configuration so the code stays nice and clean.
+ Additionally, connection credentials and other information are retrieved
+ from the Dancer configuration, leaving your code nice and clean.

Modified: trunk/libdancer-plugin-database-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/debian/copyright?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/debian/copyright (original)
+++ trunk/libdancer-plugin-database-perl/debian/copyright Fri Feb 25 12:11:40 2011
@@ -10,6 +10,7 @@
 Files: debian/*
 Copyright: 2010, Damyan Ivanov <dmn at debian.org>
  2010-2011, gregor herrmann <gregoa at debian.org>
+ 2011, Jonathan Yu <jawnsy at cpan.org>
 License: Artistic or GPL-1+
 
 License: Artistic

Modified: trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database.pm?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database.pm (original)
+++ trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database.pm Fri Feb 25 12:11:40 2011
@@ -2,6 +2,7 @@
 
 use strict;
 use Dancer::Plugin;
+use Dancer::Config;
 use DBI;
 use Dancer::Plugin::Database::Handle;
 
@@ -11,7 +12,7 @@
 
 =cut
 
-our $VERSION = '1.00';
+our $VERSION = '1.20';
 
 my $settings = undef;
 
@@ -26,26 +27,42 @@
 register database => sub {
     my $arg = shift;
 
-    my $name;
+    _load_db_settings() if (!$settings);
+
+    # The key to use to store this handle in %handles.  This will be either the
+    # name supplied to database(), the hashref supplied to database() (thus, as
+    # long as the same hashref of settings is passed, the same handle will be
+    # reused) or $def_handle if database() is called without args:
+    my $handle_key;
+    my $conn_details; # connection settings to use.
     my $handle;
 
-    _load_db_settings() if (!$settings);
-
-    # Update settings from configuration file with those from application
-    if ( ref $arg eq 'HASH' ) {
-        for my $key ( keys %$arg ) {
-            $settings->{$key} = $arg->{$key};
-        }
-    }
-    else {
-        $name     = $arg;
-        $handle   = defined($name) ? $handles{$name} : $def_handle;
-        $settings = _get_settings($name);
-    }
-
+
+    # Accept a hashref of settings to use, if desired.  If so, we use this
+    # hashref to look for the handle, too, so as long as the same hashref is
+    # passed to the database() keyword, we'll reuse the same handle:
+    if (ref $arg eq 'HASH') {
+        $handle_key = $arg;
+        $conn_details = $arg;
+    } else {
+        $handle_key = defined $arg ? $arg : $def_handle;
+        $conn_details = _get_settings($arg);
+        if (!$conn_details) {
+            Dancer::Logger::error(
+                "No DB settings for " . ($arg || "default connection")
+            );
+            return;
+        }
+    }
+
+    # OK, see if we have a matching handle
+    $handle = $handles{$handle_key} || {};
+    
     if ($handle->{dbh}) {
-        if (time - $handle->{last_connection_check}
-            < $settings->{connection_check_threshold}) {
+        if ($conn_details->{connection_check_threshold} &&
+            time - $handle->{last_connection_check}
+            < $conn_details->{connection_check_threshold}) 
+        {
             return $handle->{dbh};
         } else {
             if (_check_connection($handle->{dbh})) {
@@ -56,19 +73,15 @@
                     "Database connection went away, reconnecting"
                 );
                 if ($handle->{dbh}) { $handle->{dbh}->disconnect; }
-                return $handle->{dbh}= _get_connection($settings);
+                return $handle->{dbh}= _get_connection($conn_details);
+
             }
         }
     } else {
         # Get a new connection
-        if (!$settings) {
-            Dancer::Logger::error(
-                "No DB settings named $name, so cannot connect"
-            );
-            return;
-        }
-        if ($handle->{dbh} = _get_connection($settings)) {
+        if ($handle->{dbh} = _get_connection($conn_details)) {
             $handle->{last_connection_check} = time;
+            $handles{$handle_key} = $handle;
             return $handle->{dbh};
         } else {
             return;
@@ -108,6 +121,28 @@
         }
         $dsn .= ':' . join(';', @extra_args) if @extra_args;
     }
+
+    # If the app is configured to use UTF-8, the user will want text from the
+    # database in UTF-8 to Just Work, so if we know how to make that happen, do
+    # so, unless they've set the auto_utf8 plugin setting to a false value.
+    my $app_charset = Dancer::Config::setting('charset');
+    my $auto_utf8 = exists $settings->{auto_utf8} ?  $settings->{auto_utf8} : 1;
+    if (lc $app_charset eq 'utf-8' && $auto_utf8) {
+        
+        # The option to pass to the DBI->connect call depends on the driver:
+        my %param_for_driver = (
+            SQLite => 'sqlite_unicode',
+            mysql  => 'mysql_enable_utf8',
+            Pg     => 'pg_enable_utf8',
+        );
+        if (my $param = $param_for_driver{ $settings->{driver} }) {
+            Dancer::Logger::debug(
+                "Adding $param to DBI connection params to enable UTF-8 support"
+            );
+            $settings->{dbi_params}{$param} = 1;
+        }
+    }
+
 
     my $dbh = DBI->connect($dsn, 
         $settings->{username}, $settings->{password}, $settings->{dbi_params}
@@ -159,8 +194,6 @@
     my $return_settings;
 
     # If no name given, just return the default settings
-    # (Take a copy and remove the connections key, so we have only the main
-    # connection details)
     if (!defined $name) {
         $return_settings = { %$settings };
     } else {
@@ -180,12 +213,10 @@
         }
     }
 
-    # We should have soemthing to return now; remove any unrelated connections
-    # (only needed if this is the default connection), and make sure we have a
+    # We should have soemthing to return now; make sure we have a
     # connection_check_threshold, then return what we found.  In previous
     # versions the documentation contained a typo mentioning
     # connectivity-check-threshold, so support that as an alias.
-    delete $return_settings->{connections};
     if (exists $return_settings->{'connectivity-check-threshold'}
         && !exists $return_settings->{connection_check_threshold})
     {
@@ -217,6 +248,12 @@
     # DBI's DBI::db handle and adds a few convenience features, for example:
     get '/insert/:name' => sub {
         database->quick_insert('people', { name => params->{name} });
+    };
+
+    get '/users/:id' => sub {
+        template 'display_user', {
+            person => database->quick_select('users', { id => params->{id} }),
+        };
     };
 
     dance;
@@ -314,6 +351,17 @@
 
 (Thanks to Alan Haggai for this feature.)
 
+=head1 AUTOMATIC UTF-8 SUPPORT
+
+As of version 1.20, if your application is configured to use UTF-8 (you've
+defined the C<charset> setting in your app config as C<UTF-8>) then support for
+UTF-8 for the database connection will be enabled, if we know how to do so for
+the database driver in use.
+
+If you do not want this behaviour, set C<auto_utf8> to a false value when
+providing the connection details.
+
+
 
 =head1 GETTING A DATABASE HANDLE
 
@@ -332,7 +380,7 @@
 runtime.
 
 
-=head1 CONVENIENCE FEATURES (quick_update, quick_insert, quick_delete)
+=head1 CONVENIENCE FEATURES (quick_select, quick_update, quick_insert, quick_delete)
 
 The handle returned by the C<database> keyword is a
 L<Dancer::Plugin::Database::Handle> object, which subclasses the C<DBI::db> DBI
@@ -342,9 +390,15 @@
 
 Examples:
 
+  # Quickly fetch the (first) row whose ID is 42 as a hashref:
+  my $row = database->quick_select($table_name, { id => 42 });
+
+  # Fetch all badgers as an array of hashrefs:
+  my @badgers = database->quick_select('animals', { genus => 'Mellivora' });
+
   # Update the row where the 'id' column is '42', setting the 'foo' column to
   # 'Bar':
-  database->quick_update($table_name, { id => 42 }, { foo => 'Bar');
+  database->quick_update($table_name, { id => 42 }, { foo => 'Bar' });
 
   # Insert a new row, using a named connection (see above)
   database('connectionname')->quick_insert($table_name, { foo => 'Bar' });
@@ -367,6 +421,9 @@
 
 Feel free to fork the repo and submit pull requests!
 
+Feedback and bug reports are always appreciated.  Even a quick mail to let me
+know the module is useful to you would be very nice - it's nice to know if code
+is being actively used.
 
 =head1 ACKNOWLEDGEMENTS
 
@@ -375,6 +432,10 @@
 Franck Cuny
 
 Alan Haggai
+
+Christian Sánchez
+
+Michael Stiller
 
 =head1 BUGS
 

Modified: trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database/Handle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database/Handle.pm?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database/Handle.pm (original)
+++ trunk/libdancer-plugin-database-perl/lib/Dancer/Plugin/Database/Handle.pm Fri Feb 25 12:11:40 2011
@@ -5,7 +5,7 @@
 use DBI;
 use base qw(DBI::db);
 
-our $VERSION = '0.02';
+our $VERSION = '0.04';
 
 =head1 NAME
 
@@ -13,7 +13,7 @@
 
 =head1 DESCRIPTION
 
-Subclassed DBI connection handle with added features
+Subclassed DBI connection handle with added convenience features
 
 
 =head1 SYNOPSIS
@@ -23,6 +23,9 @@
 
   # Updating a record where id = 42:
   database->quick_update($tablename, { id => 42 }, { foo => 'New value' });
+
+  # Fetching a row quickly
+  my $employee = database->quick_select('employees', { id => $emp_id });
 
 
 =head1 Added features
@@ -53,27 +56,6 @@
 Given a table name, a hashref describing a where clause and a hashref of
 changes, update a row.
 
-The second parameter is a hashref of field => 'value', each of which will be
-included in the WHERE clause used, for instance:
-
-  { id => 42 }
-
-Will result in an SQL query which would include:
-
-  WHERE id = 42
-
-When more than one field => value pair is given, they will be ANDed together:
-
-  { foo => 'Bar', bar => 'Baz' }
-
-Will result in:
-
-  WHERE foo = 'Bar' AND bar = 'Baz'
-
-(Actually, parameterised queries will be used, with placeholders, so SQL
-injection attacks will not work, but it's easier to illustrate as though the
-values were interpolated directly.)
-
 =cut
 
 sub quick_update {
@@ -86,8 +68,8 @@
 
   database->quick_delete($table, {  id => 42 });
 
-Given a table name and a hashref to describe the rows which should be deleted,
-delete them.
+Given a table name and a hashref to describe the rows which should be deleted
+(the where clause - see below for further details), delete them.
 
 =cut
 
@@ -96,10 +78,33 @@
     return $self->_quick_query('DELETE', $table_name, undef, $where);
 }
 
+
+=item quick_select
+
+  my $row  = database->quick_select($table, { id => 42 });
+  my @rows = database->quick_select($table, { id => 42 });
+
+Given a table name and a hashref of where clauses (see below for explanation),
+returns either the first matching row as a hashref, if called in scalar context,
+or a list of matching rows as hashrefs, if called in list context.
+
+=cut
+
+sub quick_select {
+    my ($self, $table_name, $where) = @_;
+    # Make sure to call _quick_query in the same context we were called.
+    # This is a little ugly, rewrite this perhaps.
+    if (wantarray) {
+        return ($self->_quick_query('SELECT', $table_name, undef, $where));
+    } else {
+        return $self->_quick_query('SELECT', $table_name, undef, $where);
+    }
+}
+
 sub _quick_query {
     my ($self, $type, $table_name, $data, $where) = @_;
     
-    if ($type !~ m{^ (INSERT|UPDATE|DELETE) $}x) {
+    if ($type !~ m{^ (SELECT|INSERT|UPDATE|DELETE) $}x) {
         carp "Unrecognised query type $type!";
         return;
     }
@@ -113,7 +118,7 @@
         carp "Expected a hashref of changes";
         return;
     }
-    if (($type eq 'UPDATE' || $type eq 'DELETE')
+    if (($type =~ m{^ (SELECT|UPDATE|DELETE) $}x)
         && (!$where || ref $where ne 'HASH')) {
         carp "Expected a hashref of where conditions";
         return;
@@ -122,13 +127,14 @@
     $table_name = $self->quote_identifier($table_name);
     my @bind_params;
     my $sql = {
+        SELECT => "SELECT * FROM $table_name ",
         INSERT => "INSERT INTO $table_name ",
         UPDATE => "UPDATE $table_name SET ",
         DELETE => "DELETE FROM $table_name ",
     }->{$type};
     if ($type eq 'INSERT') {
         $sql .= "("
-            . join(',', map { $self->quote($_) } keys %$data)
+            . join(',', map { $self->quote_identifier($_) } keys %$data)
             . ") VALUES ("
             . join(',', map { "?" } values %$data)
             . ")";
@@ -139,15 +145,39 @@
         push @bind_params, values %$data;
     }
     
-    if ($type eq 'UPDATE' || $type eq 'DELETE') {
+    if ($type eq 'UPDATE' || $type eq 'DELETE' || $type eq 'SELECT') {
         $sql .= " WHERE " . join " AND ",
             map { $self->quote_identifier($_) . '=?' } keys %$where;
         push @bind_params, values %$where;
     }
+    
+    # If it's a select query and we're called in scalar context, we'll only
+    # return one row, so add a LIMIT 1
+    if ($type eq 'SELECT' && !wantarray) {
+        $sql .= ' LIMIT 1';
+    }
+
     Dancer::Logger::debug(
-        "Executing query $sql with params " . join ',', @bind_params
+        "Executing $type query $sql with params " . join ',', @bind_params
     );
-    return $self->do($sql, undef, @bind_params);
+
+    # Select queries, in scalar context, return the first matching row; in list
+    # context, they return a list of matching rows.
+    if ($type eq 'SELECT') {
+        if (wantarray) {
+            return @{ 
+                $self->selectall_arrayref(
+                    $sql, { Slice => {} }, @bind_params
+                )
+            };
+        } else {
+            return $self->selectrow_hashref($sql, undef, @bind_params);
+        }
+
+    } else {
+        # INSERT/UPDATE/DELETE queries just return the result of DBI's do()
+        return $self->do($sql, undef, @bind_params);
+    }
 }
 
 
@@ -159,6 +189,37 @@
 important, if you're not familiar with it.
 
 
+=head1 WHERE clauses as hashrefs
+
+C<quick_update>, C<quick_delete> and C<quick_select> take a hashref of WHERE
+clauses.  This is a hashref of field => 'value', each of which will be
+included in the WHERE clause used, for instance:
+
+  { id => 42 }
+
+Will result in an SQL query which would include:
+
+  WHERE id = 42
+
+When more than one field => value pair is given, they will be ANDed together:
+
+  { foo => 'Bar', bar => 'Baz' }
+
+Will result in:
+
+  WHERE foo = 'Bar' AND bar = 'Baz'
+
+(Actually, parameterised queries will be used, with placeholders, so SQL
+injection attacks will not work, but it's easier to illustrate as though the
+values were interpolated directly.  Don't worry, they're not.))
+
+TODO: this isn't very flexible; it would be nice to easily use other logic
+combinations, and other comparisons other than a straightforward equality
+comparison.  However, supporting this abstraction without the syntax used
+becoming a real mess can be... awkward.  Accepting a pre-written SQL 'WHERE'
+clause would be one option.  Any thoughts on this would be appreciated!
+
+
 =head1 AUTHOR
 
 David Precious C< <<davidp at preshweb.co.uk >> >

Modified: trunk/libdancer-plugin-database-perl/t/01-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/t/01-basic.t?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/t/01-basic.t (original)
+++ trunk/libdancer-plugin-database-perl/t/01-basic.t Fri Feb 25 12:11:40 2011
@@ -12,7 +12,7 @@
     plan skip_all => 'DBD::SQLite required to run these tests';
 }
 
-plan tests => 16;
+plan tests => 19;
 
 my $dsn = "dbi:SQLite:dbname=:memory:";
 
@@ -21,7 +21,8 @@
 response_status_is [ GET => '/prepare_db' ], 200, 'db is created';
 
 response_status_is    [ GET => '/' ], 200,   "GET / is found";
-response_content_like [ GET => '/' ], qr/2/, "content looks good for /";
+response_content_like [ GET => '/' ], qr/3/, 
+    "content looks good for / (3 users afiter DB initialisation)";
 
 response_status_is [ GET => '/user/1' ], 200, 'GET /user/1 is found';
 
@@ -30,14 +31,24 @@
 response_content_like [ GET => '/user/2' ], qr/bigpresh/,
   "content looks good for /user/2";
 
-response_status_is [ DELETE => '/user/2' ], 200, 'DELETE /user/2 is ok';
-response_content_like [ GET => '/' ], qr/1/, 'content looks good for /';
+response_status_is [ DELETE => '/user/3' ], 200, 'DELETE /user/3 is ok';
+response_content_like [ GET => '/' ], qr/2/, 
+    'content looks good for / (2 users after deleting one)';
 
 # Exercise the extended features (quick_update et al)
 response_status_is    [ GET => '/quick_insert/42/Bob' ], 200, 
     "quick_insert returned OK status";
 response_content_like [ GET => '/user/42' ], qr/Bob/,
     "quick_insert created a record successfully";
+
+response_content_like   [ GET => '/quick_select/42' ], qr/Bob/,
+    "quick_select returned the record created by quick_insert";
+response_content_unlike [ GET => '/quick_select/69' ], qr/Bob/,
+    "quick_select doesn't return non-matching record";
+
+response_content_like  [ GET => '/quick_select_many' ], 
+    qr/\b bigpresh,sukria \b/x,
+    "quick_select returns multiple records in list context";
 
 response_status_is    [ GET => '/quick_update/42/Billy' ], 200,
     "quick_update returned OK status";

Modified: trunk/libdancer-plugin-database-perl/t/lib/TestApp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-plugin-database-perl/t/lib/TestApp.pm?rev=69608&op=diff
==============================================================================
--- trunk/libdancer-plugin-database-perl/t/lib/TestApp.pm (original)
+++ trunk/libdancer-plugin-database-perl/t/lib/TestApp.pm Fri Feb 25 12:11:40 2011
@@ -6,9 +6,10 @@
 get '/prepare_db' => sub {
 
     my @sql = (
-        q/create table users (id INTEGER, name VARCHAR(64))/,
-        q/insert into users values (1, 'sukria')/,
-        q/insert into users values (2, 'bigpresh')/,
+        q/create table users (id INTEGER, name VARCHAR, category VARCHAR)/,
+        q/insert into users values (1, 'sukria', 'admin')/,
+        q/insert into users values (2, 'bigpresh', 'admin')/,
+        q/insert into users values (3, 'badger', 'animal')/,
     );
 
     database->do($_) for @sql;
@@ -39,7 +40,7 @@
 # Routes to exercise some of the extended features:
 get '/quick_insert/:id/:name' => sub {
     database->quick_insert('users',
-        { id => params->{id}, name => params->{name} },
+        { id => params->{id}, name => params->{name}, category => 'user' },
     );
     'ok';
 };
@@ -57,9 +58,19 @@
     'ok';
 };
 
+get '/quick_select/:id' => sub {
+    my $row = database->quick_select('users', { id => params->{id} });
+    return to_json($row || { error => 'No matching user' });
+};
+
+get '/quick_select_many' => sub {
+        my @users = database->quick_select('users', {  category => 'admin' });
+        return join ',', sort map { $_->{name} } @users;
+};
+
 # Check we can get a handle by passing a hashref of settings, too:
 get '/runtime_config' => sub {
-    my $dbh = database({ driver => 'SQLite', database => ':memory'});
+    my $dbh = database({ driver => 'SQLite', database => ':memory:'});
     $dbh ? 'ok' : '';
 };
 




More information about the Pkg-perl-cvs-commits mailing list