Note: I edited the title to reflect my intent better. This module doesn't focus on the SQL creation, but on the storage of it and on the access on said storage.
Hello monks,
Today i decided would be a good day to remove the SQL code mingled in with my Perl code. I wanted this to happen in the form of having all queries in a list in their own module, with the main code only executing a single call with their name to get the query for DBI functions.
However that leaves a problem: Some queries, like inserts, need to be generated programmatically. As such there was need for a templating system, but i wanted to keep it lightweight. So i tagged on the system used in wakaba, which allows scalars or arrays of hashes to be forwarded to the template.
I'm pretty happy with how it works now and am considering submitting it to CPAN. Before trying to do that however I'd like to get some general input. Am i needlessly duplicating other efforts? Is my interface crap? Could i do things better? Did i overlook something entirely? Any feedback along these lines is greatly welcome. :)
And now, the code.
Let's assume an App, which stores the queries in App::Queries. A possible structure would look like this:
App/Queries.pm :
package App::Queries;
use base 'Exporter';
our @EXPORT_OK = (qw( get_query_hash ));
sub get_query_hash {
return \%queries;
}
my %queries = (
get_reprocessing_list => {
type => 'simple',
source => q( SELECT typeID FROM typeAM; ),
},
get_blueprintTypeID => {
type => 'complex',
source => q( SELECT [% var $extract %], bpID FROM invBpT; ),
}
);
App.pm :
package App;
use App::Queries qw( get_query_hash );
use SQL::Template qw( load_query_hash get_query );
load_query_hash( get_query_hash() );
my $simple_query = get_query( 'get_reprocessing_list' );
my $input = { extract => 'productTypeID' };
my $complex_query = get_query( 'get_blueprintTypeID', $input );
print "$simple_query\n$complex_query";
and result in this:
SELECT typeID FROM typeAM;
SELECT productTypeID, bpID FROM invBpT;
The code for SQL::Template is as follows:
package SQL::Template;
use 5.010;
use strict;
use warnings;
use base 'Exporter';
our @EXPORT_OK = qw( load_query_hash get_query );
use Carp qw( cluck confess );
my $queries;
my $eval_methods = {
simple => \&eval_simple,
complex => \&eval_complex,
};
sub load_query_hash {
my ($import) = @_;
for my $name ( keys %{$import} ) {
cluck "Existing query template redefined: $name"
if ( $queries->{$name} );
$queries->{$name} = $import->{$name};
}
return;
}
sub get_query {
my ( $name, $input ) = @_;
my $error;
my $query = $queries->{$name};
$error = "Query template unknown for: $name" if ( !$query );
$error = "Eval method $query->{type} unknown for: $name"
if ( !$error and !$eval_methods->{ $query->{type} } );
if ($error) {
confess $error;
return;
}
$eval_methods->{ $query->{type} }->( $query, $input );
return $query->{target};
}
sub eval_simple {
my ($query) = @_;
return if ( $query->{target} );
$query->{target} = $query->{source};
return;
}
sub eval_complex {
my ( $query, $input ) = @_;
$query->{sub} = compile_template( $query->{source} ) if ( !$query-
+>{sub} );
$query->{target} = $query->{sub}->( %{$input} );
return;
}
sub compile_template {
my ($str) = @_;
my $code;
local $SIG{__WARN__} = sub { confess "Template Error: ", @_; };
$str =~ s/^\s+//;
$str =~ s/\s+$//;
while (
$str =~
m@(.*?)(\[% (/?)(var|const|if|loop)(?:|\s+(.*?[^\\])) %\]|$)@s
+g
) {
my ( $content, $tag, $closing, $name, $args ) = ( $1, $2, $3,
+$4, $5 );
$content =~ s/(['\\])/\\$1/g;
$code .= "\$res.='$content';" if ( length $content );
$args =~ s/\\>/>/g if ( defined $args );
if ($tag) {
if ($closing) {
if ( $name eq 'if' ) {
$code .= '}';
}
elsif ( $name eq 'loop' ) {
$code .= '$$_=$__ov{$_} for(keys %__ov);
}
}
}';
}
}
else {
if ( $name eq 'var' ) {
$code .= '$res.=eval{' . $args . '};';
}
elsif ( $name eq 'const' ) {
my $const = eval $args;
$const =~ s/(['\\])/\\$1/g;
$code .= '$res.=\'' . $const . '\';';
}
elsif ( $name eq 'if' ) {
$code .= 'if (eval{' . $args . '} ) {';
}
elsif ( $name eq 'loop' ) {
$code .= '{'
. 'my $__a=eval{ '
. $args . '}; '
. 'if ($__a) { '
. ' for (@$__a) { '
. ' my %__v=%{$_}; '
. ' my %__ov; '
. ' for (keys %__v) { '
. ' $__ov{$_}=$$_; '
. ' $$_=$__v{$_}; '
. ' }';
}
}
}
}
$code =
'no strict; '
. 'sub { '
. ' my %__v=@_; '
. ' my %__ov; '
. ' for (keys %__v) { '
. ' $__ov{$_}=$$_; '
. ' $$_=$__v{$_}; ' . ' }'
. ' my $res = "";'
. $code
. ' $$_=$__ov{$_} for(keys %__ov);'
. ' return $res; ' . '} ';
my $sub = eval $code;
confess "Template format error: $@" if ( !$sub );
return $sub;
}
1;
