Permalink
Browse files

[Squerl] updated for blog example

Triggered [perl #69438], so had to adjust 02-dataset.t a bit to compensate.
  • Loading branch information...
1 parent 7047117 commit a22061c6a34e5c6dd993d6335929cdbd7c123d3d @masak committed Sep 28, 2009
Showing with 82 additions and 42 deletions.
  1. +50 −14 lib/Squerl.pm
  2. +32 −28 t/squerl/02-dataset.t
View
@@ -113,18 +113,40 @@ class Squerl::Dataset does Positional {
Squerl::LiteralString.new("(EXISTS ({self.select_sql}))");
}
- method insert(*@values) {
- my $values = @values>>.perl.join(', ');
+ method insert(*@positionals, *%nameds) {
given $!db {
.open;
# RAKUDO: Real string interpolation
- .exec("INSERT INTO {%!opts<table>} VALUES($values)");
+ .exec(self.insert_sql(|@positionals, |%nameds));
+ .close;
+ }
+ }
+
+ method delete() {
+ given $!db {
+ .open;
+ # RAKUDO: Real string interpolation
+ .exec(self.delete_sql());
+ .close;
+ }
+ }
+
+ method update(*@pairs) {
+ given $!db {
+ .open;
+ # RAKUDO: Real string interpolation
+ .exec(self.update_sql(|@pairs));
.close;
}
}
method all() {
- $!db.select("*", %!opts<table>);
+ $!db.do-select(self.select_sql()).list;
+ }
+
+ # RAKUDO: Strange Parrot global namespace bug
+ method llist() {
+ $!db.do-select(self.select_sql()).list;
}
method literal($value? is copy) {
@@ -135,14 +157,14 @@ class Squerl::Dataset does Positional {
when Squerl::Symbol { return self.literal_symbol($value) }
when Squerl::LiteralString { return $value.Str }
when Str { return literal_string($value) }
- when Pair { return literal_pair($value) }
+ when Pair { return self.literal_pair($value) }
when Squerl::BooleanExpression { $value.Str }
default { die "Can't handle {$value.WHAT}" }
}
}
- sub literal_pair($pair) {
- sprintf '(%s = %s)', $pair.key, $pair.value;
+ method literal_pair($pair) {
+ sprintf '(%s = %s)', $pair.key, self.literal($pair.value);
}
method literal_symbol($name is copy) {
@@ -229,7 +251,10 @@ class Squerl::Dataset does Positional {
self.check_modification_allowed();
# RAKUDO: Real string interpolation
- "DELETE FROM {%!opts<from>}";
+ "DELETE FROM {%!opts<from>}"
+ ~ (%!opts.exists('where')
+ ?? " WHERE {self.literal(%!opts<where>)}"
+ !! '');
}
method truncate_sql() {
@@ -281,16 +306,19 @@ class Squerl::Dataset does Positional {
"INSERT INTO {%!opts<from>} $columns$values";
}
- method update_sql(*%nameds) {
+ method update_sql(*@pairs) {
return self.static_sql(%!opts<sql>)
if %!opts.exists('sql');
self.check_modification_allowed();
my $values = join $COMMA_SEPARATOR, map {
"{.key} = {self.literal(.value)}"
- }, %nameds.pairs;
- "UPDATE {%!opts<from>} SET $values";
+ }, @pairs;
+ "UPDATE {%!opts<from>} SET $values"
+ ~ (%!opts.exists('where')
+ ?? " WHERE {self.literal(%!opts<where>)}"
+ !! '');
}
}
@@ -331,10 +359,14 @@ class Squerl::Database {
.close;
}
- method select($_: $what, $table) {
+ method select($what, $table) {
+ self.do-select("SELECT $what FROM $table");
+ }
+
+ method do-select($_: $query) {
my @rows;
.open;
- my $sth = $!dbh.prepare("SELECT $what FROM $table");
+ my $sth = $!dbh.prepare($query);
while $sth.step() == 100 {
push @rows, [map { $sth.column_text($_) }, ^$sth.column_count()];
}
@@ -343,7 +375,7 @@ class Squerl::Database {
}
method from($table) {
- return Squerl::Dataset.new(self, :$table,
+ return Squerl::Dataset.new(self, :from($table),
:quote_identifiers($!quote_identifiers),
:identifier_input_method(
$!identifier_input_method
@@ -352,6 +384,10 @@ class Squerl::Database {
$!identifier_output_method
));
}
+
+ method postcircumfix:<{ }>($table) {
+ self.from($table);
+ }
}
class Squerl {
View
@@ -5,6 +5,9 @@ use Squerl;
my $dataset = Squerl::Dataset.new('db');
+# RAKUDO: There are plenty of unnecessary semicolons at the end of blocks
+# in this file, due to [perl #69438]
+
{
my $db = 'db';
my %opts = :from<test>;
@@ -16,7 +19,7 @@ my $dataset = Squerl::Dataset.new('db');
is $d.db, $db, 'attribtue .db was properly set';
ok $d.opts ~~ Hash, 'attribute .opts is a hash even when not set';
is_deeply $d.opts, {}, 'attribute .opts is empty';
-}
+};
{
my $d1 = $dataset.clone( :from( ['test'] ) );
@@ -37,11 +40,11 @@ my $dataset = Squerl::Dataset.new('db');
is_deeply $d2.opts<order>, ['name'],
'the attribute passed with the .clone method is there';
ok !$d1.opts.exists('order'), 'the original clone is unchanged';
-}
+};
{
ok Squerl::Dataset ~~ Positional, 'you can index into Squerl::Dataset';
-}
+};
{
my $db = Squerl::Database.new( :quote_identifiers );
@@ -50,7 +53,7 @@ my $dataset = Squerl::Dataset.new('db');
$db = Squerl::Database.new( :!quote_identifiers );
nok $db.from('a').quote_identifiers,
'should get quote_identifiers default from database II';
-}
+};
{
my $db = Squerl::Database.new( :identifier_input_method<upcase> );
@@ -59,7 +62,7 @@ my $dataset = Squerl::Dataset.new('db');
$db = Squerl::Database.new( :identifier_input_method<downcase> );
ok $db.from('a').identifier_input_method eq 'downcase',
'should get identifier_input_method default from database II';
-}
+};
{
my $db = Squerl::Database.new( :identifier_output_method<upcase> );
@@ -68,7 +71,7 @@ my $dataset = Squerl::Dataset.new('db');
$db = Squerl::Database.new( :identifier_output_method<downcase> );
ok $db.from('a').identifier_output_method eq 'downcase',
'should get identifier_output_method default from database II';
-}
+};
$dataset = Squerl::Dataset.new('db');
@@ -80,7 +83,7 @@ $dataset = Squerl::Dataset.new('db');
is $dataset.literal(ident('a')), 'a',
'setting quote_identifiers to False makes .literal '
~ 'not quote identifiers';
-}
+};
{
$dataset.identifier_input_method = 'upcase';
@@ -102,7 +105,7 @@ $dataset = Squerl::Dataset.new('db');
$dataset.identifier_input_method = 'flip';
is $dataset.literal(ident('at_b')), 'b_ta',
'identifier_input_method changes literalization of identifiers VI';
-}
+};
{
is $dataset.output_identifier('at_b_C'), 'at_b_C',
@@ -127,7 +130,7 @@ $dataset = Squerl::Dataset.new('db');
$dataset.identifier_output_method = 'flip';
is $dataset.output_identifier('at_b_C'), 'C_b_ta',
'identifier_output_method changes identifiers returned from the db VII';
-}
+};
$dataset = Squerl::Dataset.new(undef).from('items');
@@ -139,7 +142,7 @@ $dataset = Squerl::Dataset.new(undef).from('items');
is $clone.WHAT, $dataset.WHAT, 'clone has the same type as original';
is_deeply $clone.opts, $dataset.opts, 'opts attributes are equivalent';
ok $clone.row_proc === $dataset.row_proc, 'row_proc attributes equal';
-}
+};
{
my $clone = $dataset.clone;
@@ -148,15 +151,15 @@ $dataset = Squerl::Dataset.new(undef).from('items');
$dataset.=filter( 'a' => 'b' );
ok !$clone.opts.exists('filter'),
'changing original.opts leaves clone.opts unchanged';
-}
+};
{
my $clone = $dataset.clone;
is $clone.WHAT, $dataset.WHAT, 'should return a clone self I';
is $clone.db, $dataset.db, 'should return a clone self II';
is_deeply $clone.opts, $dataset.opts, 'should return a clone self III';
-}
+};
$dataset = Squerl::Dataset.new(undef).from('items');
@@ -165,21 +168,21 @@ $dataset = Squerl::Dataset.new(undef).from('items');
is_deeply $clone.opts, { one => 2, from => 'items' },
'should merge the specified options';
-}
+};
{
my $clone = $dataset.clone( :from(['other']) );
is_deeply $clone.opts, { :from(['other']) },
'should overwrite existing options';
-}
+};
{
my $clone = $dataset.clone( :from(['other']) );
is_deeply $dataset.opts<from>, 'items', 'original .opts<from> unharmed';
is_deeply $clone.opts<from>, ['other'], 'cloned .opts<from> changed'
-}
+};
{
# TODO: Can't realisticly do this one yet.
@@ -189,7 +192,7 @@ $dataset = Squerl::Dataset.new(undef).from('items');
# end
# @dataset.extend(m)
# @dataset.clone({}).should respond_to(:__xyz__)
-}
+};
$dataset = Squerl::Dataset.new(undef).from('test');
@@ -206,17 +209,17 @@ is $dataset.insert_sql, 'INSERT INTO test DEFAULT VALUES',
'format an insert statement with hash';
is $dataset.insert_sql({}), 'INSERT INTO test DEFAULT VALUES',
'empty hash gives an insert statement with default values';
-}
+};
{
my $sql = $dataset.insert_sql( 'name' => 'wxyz', 'price' => 342 );
ok $sql eq q[INSERT INTO test (name, price) VALUES ('wxyz', 342)]
| q[INSERT INTO test (price, name) VALUES (342, 'wxyz')],
'format an insert statement with string keys';
-}
+};
role R1 { method values { 'a' => 1; } }
-role R2 { method values { {} } }
+role R2 { method values { {} } };
{
my $v = Object.new but R1;
@@ -226,35 +229,36 @@ role R2 { method values { {} } }
$v = Object.new but R2;
is $dataset.insert_sql($v), 'INSERT INTO test DEFAULT VALUES',
'format an insert statement with an object that .can("values") II';
-}
+};
{
is $dataset.insert_sql(123), 'INSERT INTO test VALUES (123)',
'format an insert statement with an arbitrary value';
-}
+};
{
my $sub = Squerl::Dataset.new('').from('something').filter('x' => 2);
is $dataset.insert_sql($sub),
'INSERT INTO test SELECT * FROM something WHERE (x = 2)',
'format an insert statement with sub-query';
-}
+};
{
is $dataset.insert_sql('a', 2, 6.5),
q[INSERT INTO test VALUES ('a', 2, 6.5)],
'format an insert statement with array';
-}
+};
{
- is $dataset.update_sql(:name<abc>), q[UPDATE test SET name = 'abc'],
+ is $dataset.update_sql('name' => 'abc'),
+ q[UPDATE test SET name = 'abc'],
'format an update statement';
-}
+};
{
is $dataset.clone(:sql('xxx yyy zzz')).select_sql(), 'xxx yyy zzz',
'return rows for arbitrary SQL';
-}
+};
{
my $sql = 'X';
@@ -264,7 +268,7 @@ role R2 { method values { {} } }
is $ds.delete_sql(), $sql, ':sql option works for .delete_sql';
is $ds.update_sql(), $sql, ':sql option works for .update_sql';
is $ds.truncate_sql(), $sql, ':sql option works for .truncate_sql';
-}
+};
sub throws_exception(&block, $expected-type, $message = '') {
try {
@@ -298,7 +302,7 @@ $dataset = Squerl::Dataset.new(undef).from('t1', 't2');
throws_exception { $dataset.insert_sql() },
'Squerl::InvalidOperation',
'multi-table dataset dies on .insert_sql';
-}
+};
{
is $dataset.select_sql, 'SELECT * FROM t1, t2',

0 comments on commit a22061c

Please sign in to comment.