Bringing perlish DB handling to the unwashed masses

DBIx::Perlish

Anton Berezin

tobez@tobez.org

Erlang's list comprehensions


qsort([]) -> [];

qsort([P|R]) ->

	qsort([ X || X <- R, X < P]) ++
"all X, such that X belong to R and X less than P" 

	[P] ++

	qsort([ X || X <- R, X >= P]).
"all X, such that X belong to R and X not less than P"

Generators and filters.

Erlang's parse transforms

Erlang has a mechanism called "parse transforms", that enables the programmer to customize the Erlang compiler.

After the compiler has finished scanning and parsing phases, a parse tranform module has a chance to modify the result.

Mnemosyne query language

Parse transforms are used by Mnemosyne, the query language for Erlang's database Mnesia, to hijack list comprehension syntax to represent database queries.

Mnesia query example


    Q = query [X ||

        X <- table(fft_entry),
        Y <- table(fft_in_feed),

        X.id = Y.entry_id,
        Y.id = FeedId].

Again, generators and filters.

Mnesia's main point

 

Use Erlang's own syntax to construct declarative style queries.

Easy on the programmer.

Same thing in Perl?

 

How would it look?


    my @r = db_fetch {
        my $e : fft_entry;
        my $f : fft_in_feed;

        $e->id == $f->entry_id;
        $f->id == $feed_id;
    };

Same example as with Mnesia. Generators (kinda implicit) and filters.

Main point

 

Use Perl's own syntax to construct declarative style queries.

Easy on the programmer.

Although it won't be Perl.

Not Perl

 

Possible approaches

 

Optree parsing

B::Terse


perl -MO=Terse,x -e \
  'sub x {\
     my $t : table; \
     $t->id == 42; \
   }'

my $t : table


OP (0x81b9680) pushmark 
UNOP (0x8106060) entersub [2] 
  OP (0x81b9728) pushmark 
  SVOP (0x81e0740) const  PV (0x8100bec) "attributes" 
  SVOP (0x81e1720) const  PV (0x8100ca0) "main" 
  UNOP (0x81e5240) srefgen 
    UNOP (0x81063c0) null [141] 
      OP (0x81b9650) padsv [1] 
  SVOP (0x8106400) const  PV (0x8100c1c) "table" 
  SVOP (0x81e5160) method_named  PVIV (0x81e2310) "import" 
OP (0x8118008) padsv [1]

$t->id == 42


BINOP (0x81e5020) eq 
  UNOP (0x81e4fc0) entersub [3] 
    OP (0x81b96f8) pushmark 
    OP (0x81b96e0) padsv [1] 
    SVOP (0x81e4fe0) method_named  PVIV (0x81e22a4) "id" 
  SVOP (0x81e53a0) const  IV (0x81e20b8) 42

B::Concise

The rest is easy

Now that we can parse optree, what's left to do is to

Piece of cake!

Usage

A "query sub" supplied to each of those except db_insert(). Since db_xxx are prototyped, one does not need to say "sub". Query subs are never executed.

Code example


    my @r = db_fetch {
        my $e : fft_entry;
        my $f : fft_in_feed;

        $e->id == $f->entry_id;
        $f->id == $feed_id;
    };

SELECT FROM fft_entry, fft_in_feed WHERE
  fft_entry.id = fft_in_feed.entry_id AND
  fft_in_feed.id = ?

What DB handle?

$dbh


use DBI;
use DBIx::Perlish;

my $dbh = DBI->connect(...);

# this works just fine
my @rows = db_fetch { ... };

Syntax - tables


my $var : tablename;

tablename->field ...

my $var : table = $vartable;

Syntax - columns


$tabvar->colname;

tabname->colname;

$tabvar->$colvar;

tabname->$colvar;

Syntax - other terms

Operators - all the usual bunch

+, -, *, /, ==, eq, !=, ne, <, lt, >, gt, <=, le, >=, ge, . (concat)

Regular expressions


$t->col =~ /^abc/;

... WHERE col LIKE 'abc%';

String interpolation


"abc $t->name xyz"  # legal!

"abc $t->{name} xyz"  # also fine

Verbatim SQL


tab->id = sql "some_seq.nextval";

tab->id = `some_seq.nextval`;

"comes from" notation


tab->id  <- [1,2,3];

# ... WHERE tab.id IN (1,2,3);

"comes from" notation


my @list = (1,2,3);
my @rows = db_fetch {
   tab->id  <- @list;
}
# ... WHERE tab.id IN (1,2,3);
Also used for sub-queries.

Return statements


db_fetch { tab->id == 42; };

# SELECT * FROM tab WHERE id = 42;

Return statements


db_fetch {
    my $t : tab;
    $t->id == 42;
    return ($t->id, $t->name);
};

# SELECT id,name FROM tab WHERE id = 42;

Named returns


db_fetch {
    my $t : tab;
    $t->id == 42;
    return ($t->id, loname => lc($t->name));
};

# SELECT id,LOWER(name) as loname FROM tab WHERE id = 42;

db_fetch

Context-dependant, return-dependant:

scalar context, returns one


my $somename = db_fetch { return user->name };

my $somename = $dbh->selectrow_array("select name from user");

list context, returns one


my @allnames = db_fetch { return user->name };

my @r = @{$dbh->selectcol_arrayref("select name from user")};

scalar context, returns more than one


my $h = db_fetch { my $u : user };
print "name: $h->{name}, id: $h->{id}\n";

my $h = $dbh->selectrow_hashref("select * from user");
print "name: $h->{name}, id: $h->{id}\n";

list context, returns more than one


my @users = db_fetch { my $u : user };
print "name: $_->{name}, id: $_->{id}\n" for @users;

my @users = @{$dbh->selectall_arrayref("select * from user",
    {Slice=>{}})};
print "name: $_->{name}, id: $_->{id}\n" for @users;

db_update and assignments


db_update {
   my $t : tab;
   $t->id = 42;
   $t->cnt = $t->cnt + 1;
};

db_update and bulk assignments


db_update {
   my $t : tab;
   $t = {
      id  => 42,
      cnt => $t->cnt + 1,
   }
};

Result limiting


last;

... LIMIT 1;

Result limiting


last unless 5..20;

... OFFSET 5 LIMIT 16;

Parse-time conditionals


my $type = "ICBM";
db_fetch {
   my $p : products;
   $p->type eq $type if $type;
};

SELECT * FROM products where type = 'ICBM';

Parse-time conditionals


my $type = "";
db_fetch {
   my $p : products;
   $p->type eq $type if $type;
};

SELECT * FROM products;

Labels

Implicit GROUP BY


db_fetch {
   my $t : tab;
   return $t->name, $t->type, count($t->age);
};

SELECT name, type, COUNT(age) FROM tab GROUP BY name, type
Aggregates: avg(), count(), max(), min()

Automatic joins


db_fetch {
   my $t1 : tab1;
   my $t2 : tab2;
   $t1->id == $t2->tab1_id;
};

SELECT * FROM tab1,tab2 WHERE tab1.id = tab2.tab1_id;

Compound queries


db_fetch {
   {
      my $t1 : tab1;
      $t1->id == 42;
   } union {
      my $t2 : tab2;
      $t2->id == 666;
   }
};
union, intersect, except

Sub-queries, EXISTS


db_delete {
    my $t : table1;
    db_fetch {
        $t->id == table2->table1_id;
    };
};

DELETE FROM table1 WHERE EXISTS
  (SELECT * FROM table2 WHERE
   table1.id = table2.table1_id)

Sub-queries, IN


db_delete {
    my $t : table1;
    $t->id  <-  db_fetch {
        return table2->table1_id;
    };
};

DELETE FROM table1 WHERE id IN
  (SELECT table1_id FROM table2)
This form must return a single value.

Joins


db_fetch {
    my $x : x;
    my $y : y;
    join $y * $x  <=
      db_fetch { $y->id == $x->id }
};

Joins

DBD specific things

Some functionality is implemented differently for different DBD drivers.

Regular expressions; pseudo-functions. More in the future (LIMIT/OFFSET, aggregates).

Thank you.

 

Thank you!

 

Any questions?