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