,
I, or I. Only one parameter with a given number is processed, for example
sqln1, sqln2, sqls3, sqln4. It substitutes the corresponding values for instances
of %%sqlxn%%.
=over 4
=item sqln1..n
Substitutes the corresponding values for instances of
%%sqln1%% etcetera after validating that
the supplied values are numeric.
=item sqls1..n
Similar to the preceding, except the parameter value is subjected to database
quotation prior to insertion within the SQL statement(s). If inserted elsewhere
it is not quoted.
=item sqlp1..n
Similar to the preceding, except the parameter value is inserted raw. Be careful
with this one unless you trust your (ab)users.
=back
=head2 SQL Statement
The SQL statement is presumed to be a SELECT statement. As noted, substitutions
can be performed into it with a one-to-one correspondence between CGI parameters of the
form sqlx1..n and cliches within the SQL statement of the form %%sqlx1..n%%.
=head2 Templates
Insertions occur into the template according to the following syntax. The
syntax of a substitution tag is %%tag%%.
=over 4
=item sqlx1..n
For each corresponding CGI parameter, the found value will be reinserted back into
the template. sqlsn parameters will be subjected to database quotation before being
inserted into the SQL statement. If inserted elsewhere in the template they are
not quoted.
=item liststart, listend
These tags can occur raw or enclosed like HTML tags.
Brackets a list of records. The form for nested subqueries is CI where
n starts at 1 for the first level of subqueries.
The following parameters are repeated for each record.
=item sqlf1..n
For each column in the result set, a substitution of this form is performed. The
numbering is independent of the numbering for CGI parameters. Substitutions of fields
from subqueries are of the form CIC<_n>, where x is 1 for the first level
of subqueries, and so on.
Fields from outer queries are available for substitution into subqueries.
=back
=head2 Usage Notes
Typical usage is to create an HTML template with several elements.
=over 4
=item *
A POST method form with query parameters which will
be returned as CGI parameters named sqlx1..n.
=item *
Some hidden inputs which contain context information.
=item *
A TABLE with a single row, bracketed by the %%liststart%% and %%listend%% directives,
and containing substitutions for the column in the result set.
=back
This object is generally called from some other enclosing CGI handler. This handler
is designed to be called initially, and when it sees that this is the case it
calls SqlHtmlRpt->format( ..., ..., 1 ), that is with init set to true. What ends up
happening is that the user sees a blank (or defaulted) form and an empty result set.
At this point the user fills in query information and clicks the submit button. This
time the enclosing handler sees that this is not an initial call. It validates the
user (and perhaps the CGI parameters), and allocates a database handle. It then calls
SqlHtmlRpt->format( ... ).
format() now scans the template to locate (and strip) the SQL statement. It then
iterates over sqlx1..n until it finds an undef and performs the appropriate substitutions
into the SQL statement. It also goes back to the template and substitutes the values
back in as desired, so that the user will see the values that she entered when
the result set is returned.
It then calls dbh->selectall_arrayref() to query the database.
Provided the result status indicates success, clones everything between the liststart
and listend tags and substitutes columns for the appropriate sqlf1..n tags, and repeats
this for every row in the array.
You should find a sample report template accompanying this module.
=head2 A Message From Our Sponsor
Want help? Fred Morris has been a licensed business in Seattle Washington since
1984. I have extensive experience writing and using reporting tools. I helped write
Park Software's I report writer for I (and the mother of I report
wizards), working on its development off and on
for about 8 years. Not only have I used XENTIS in production environments, I have
extensive experience with a variety of SQL (and other) databases as well as with
ACI's I<4th Dimension> and Microsoft's I.
We can provide training, consulting and even do it all for you: contact us!
=cut
use strict;
package SqlHtmlRpt;
use DBI;
use CGI;
# -=-=-=- PRIVATE METHODS -=-=-=-
# Clone a new SqlHtmlRpt object from this one.
sub clone( $ ) {
my $obj = shift;
my $formatter = undef;
$formatter = $obj->{formatter} if (defined $obj->{formatter});
my $clone = { cgi => $obj->{cgi},
dbh => $obj->{dbh},
formatter => $formatter,
mode => $obj->{mode},
init => $obj->{init}
};
return bless $clone, "SqlHtmlRpt";
} # &clone
# Parse the source and build the query tree.
sub parse( $$$ ) {
my $obj = shift;
my $level = shift;
my $text = shift;
# Chunk the template. If the parse fails, we assume there's nothing to do here
# and return false.
my $presql;
my $sql;
my $postsql;
my $list;
my $tail;
my $start_tag = 'liststart';
my $end_tag = 'listend';
if ($level) {
$start_tag .= $level;
$end_tag .= $level;
}
if ($obj->{mode} eq 'tag') { # tag mode
(($presql,$sql,$postsql,$list,$tail) =
$text =~ m|(.*?)(.*?)(.*?)?(.*?)?(.*)|si)
or return 0;
}
else { # comment mode
# Check for whitespace after the tag opener now. This is for better
# compatibility with extensions such as OptParamRpt. FWM, 12-Jun-2005
(($presql,$sql,$postsql,$list,$tail) =
$text =~ m|(.*?)(.*?)?(.*?)?(.*)|si)
or return 0;
}
# Save the results of the parse in our object.
$obj->{presql} = $presql;
$obj->{sql} = $sql;
$obj->{postsql} = $postsql;
$obj->{list} = $list;
$obj->{tail} = $tail;
# All done, and we got something so return true.
return 1;
} # &parse
# Build the parse tree recursively.
sub build_tree( $$$ ) {
my $obj = shift;
my $level = shift;
my $text = shift; # If undef, parsed at outer level.
# Parse all queries at this level.
my $last_query = undef;
my $current_query = $obj;
while ((! defined $text) || $current_query->parse( $level, $text )) {
# Recurse, looking for subqueries.
my $sub_query = $current_query->clone();
if ($sub_query->parse( $level+1, $current_query->{list} )) {
# This query now has a child.
$current_query->{subq} = $sub_query;
# This query's list has become the subquery.
$current_query->{list} = undef;
# Flesh out the subquery.
$sub_query->build_tree( $level+1, undef );
}
# The previous query needs to point to this one as the next query.
$last_query->{next} = $current_query if ($last_query);
# The last query's tail has become this query.
$last_query->{tail} = undef if ($last_query);
# This query's tail will become the text for the next query.
$text = $current_query->{tail};
# This query becomes the last query...
$last_query = $current_query;
# ... and we make a new query object for the next pass at this level.
$current_query = $current_query->clone();
}
} # &build_tree
# Perform queries recursively.
sub query( $$$ ) {
my $obj = shift;
my $outer_fields = shift;
my $level = shift;
my $dbh = $obj->{dbh};
my $formatter = undef;
$formatter = $obj->{formatter} if (defined $obj->{formatter});
my $text = '';
# Process queries at this level.
for ( my $current_query = $obj;
defined $current_query;
$current_query = $current_query->{next}
) {
my $sql = $current_query->{sql};
my $presql = $current_query->{presql};
my $postsql = $current_query->{postsql};
my $tail = ''; $tail = $current_query->{tail} if (defined $current_query->{tail});
# If init..
if ($obj->{init}) {
# Reassemble it without the list and be done.
my $qtext = $presql . $postsql . $tail;
# Substitute (none) for any parameters.
$qtext =~ s/%%sql[nsp]\d+%%/(none)/gsio;
# Next query at this level, skip recursion.
$text .= $qtext;
next;
}
# Substitute into the SQL statement and all parts of the template at this level.
foreach my $key (keys %{$outer_fields}) {
my $kv = $outer_fields->{$key};
my $quoted = $dbh->quote( $kv );
my $formatted = $kv;
if (!($key =~ m/^sql(?:psn)/io)) {
$formatted = &$formatter( $kv ) if (defined $formatter);
}
if ($key =~ m/^sqls/io) {
$sql =~ s/'?%%$key%%'?/$quoted/gis;
}
else {
$sql =~ s/'%%$key%%'/$quoted/gis;
$sql =~ s/%%$key%%/$kv/gis;
}
$presql =~ s/%%$key%%/$formatted/gis;
$postsql =~ s/%%$key%%/$formatted/gis;
$tail =~ s/%%$key%%/$formatted/gis;
}
$text .= $presql . $postsql;
# Perform the query.
my $aref = $dbh->selectall_arrayref( $sql );
if (!$aref) {
$obj->{errstr} = "Failed executing SQL statement: $DBI::errstr";
return undef;
}
# Clone rows and substitute the query set into them.
foreach my $row (@{$aref}) {
# Get all of our substitutions into one hash.
my %fields;
foreach my $key (keys %{$outer_fields}) {
$fields{$key} = $outer_fields->{$key};
}
my $len = @{$row};
my $prefix = 'sqlf';
$prefix .= $level . '_' if ($level);
for ( my $i = 1; $i <= $len; $i++ ) {
$fields{"$prefix$i"} = $row->[$i-1];
}
# Perform subqueries/substitutions.
my $l;
if ($current_query->{subq}) {
# Process subqueries.
my $sub_query = $current_query->{subq};
if (! defined ($l = $sub_query->query( \%fields, $level+1 )) ) {
$obj->{errstr} = $sub_query->{errstr};
return undef;
}
}
else {
# Substitute in at this level.
$l = $current_query->{list};
foreach my $key (keys %fields) {
my $kv = $fields{$key};
$kv = '' if (! defined $kv); # FWM, 12-May-2003
$kv = &$formatter( $kv ) if (defined $formatter);
$l =~ s/%%$key%%/$kv/gsi;
}
}
$text .= $l;
} # foreach row
$text .= $tail;
} # for current_query->next
# All done, return the fully-substituted text.
return $text;
} # &query
# This is a little convenience method for errors.
sub bad_undef( $$ ) {
my $self = shift;
my $msg = shift;
$self->{errstr} = $msg;
return undef;
} # &bad_undef
# -=-=-=- SUBCLASSABLE METHODS -=-=-=-
# Prior to CGI processing.
sub fmt_init( $$ ) {
my $self = shift;
my $init = shift;
return undef;
} # &fmt_init
# CGI parameter processing wrapper.
sub fmt_param( $$$ ) {
my $self = shift;
my $fields = shift;
my $init = shift;
my $cgi = $self->{cgi};
my $i;
return undef if ($init);
for ( $i = 1; 1; $i++ ) {
my $pv;
my $p;
if ( defined($pv = $cgi->param( $p = "sqln$i" )) ) {
(defined($pv = $self->fmt_param_n( $pv )))
or return "$p (a query parameter) $self->{errstr}";
}
elsif ( defined($pv = $cgi->param( $p = "sqls$i" )) ) {
(defined($pv = $self->fmt_param_s( $pv )))
or return "$p (a query parameter) $self->{errstr}";
}
elsif ( defined($pv = $cgi->param( $p = "sqlp$i" )) ) {
(defined($pv = $self->fmt_param_p( $pv )))
or return "$p (a query parameter) $self->{errstr}";
}
else {
last;
}
# Make sure that it doesn't have a bare quote in it.
if ($pv =~ m/"/sio) { # " is bad in HTML value attributes
return "I'm sorry but I can't allow you to put a '"' in $p";
}
# Add it to our fields.
$fields->{$p} = $pv;
}
# All done.
return undef;
} # &fmt_param
# Numeric parameter
sub fmt_param_n( $$ ) {
my $self = shift;
my $pv = shift;
# Check for digits.
$pv =~ m/(\d*)/o;
(length($1) != length($pv))
and return $self->bad_undef( 'must be an unsigned integer value' );
return $pv;
} # &fmt_param_n
# String parameter
sub fmt_param_s( $$ ) {
my $self = shift;
my $pv = shift;
return $pv;
} # &fmt_param_s
# Raw parameter
sub fmt_param_p( $$ ) {
my $self = shift;
my $pv = shift;
return $pv;
} # &fmt_param_p
# Prepare the report.
sub fmt_report( $$ ) {
my $self = shift;
my $template = shift;
my $fields = shift;
# Parse.
$self->build_tree( 0, $template );
# Query.
return $self->query( $fields, 0 );
} # &fmt_report
# -=-=-=- PUBLIC METHODS -=-=-=-
# Instantiates the object.
sub new( $;$$& ) {
my $class = shift;
my $cgi = undef; $cgi = shift if (@_ >= 1);
my $dbh = undef; $dbh = shift if (@_ >= 1);
my $fmttr = undef; $fmttr = shift if (@_ >= 1);
# Allocate the object which will be us.
my $obj = { cgi => $cgi, dbh => $dbh, formatter => $fmttr };
bless $obj, $class;
# All done.
return $obj;
} # &new
# Calls disconnect() on the dbh.
sub disconnect( $ ) {
my $obj = shift;
$obj->{dbh}->disconnect();
} # &disconnect
# Where everything important happens...
sub format( $$$;$ ) {
my $obj = shift;
my $mode = shift;
my $template = shift;
my $init = 0; $init = shift if (@_ >= 1);
my $status; # FWM, 11-Jun-2005
my %fields;
$obj->{template} = $template; # FWM, 11-Jun-2005
# Bozo-check the mode.
(! (($mode eq 'tag') || ($mode eq 'comment')) )
and return $obj->bad_undef( "'$mode' is not a recognized mode." );
# Better bozo-check cgi and dbh.
my $cgi = $obj->{cgi};
(!(($init) || (defined $cgi))) # FWM, 17-Aug-2003
and return $obj->bad_undef( "cgi is undefined!" );
my $dbh = $obj->{dbh};
(!(($init) || (defined $dbh))) # FWM, 17-Aug-2003
and return $obj->bad_undef( "dbh is undefined!" );
# Chance to initialize. FWM, 11-Jun-2005
(!($status = $obj->fmt_init( $init )))
or return $obj->bad_undef( "initialize: $status" );
# Read the CGIs... Now in a separate wrapper method. FWM, 11-Jun-2005
(!($status = $obj->fmt_param( \%fields, $init )))
or return $obj->bad_undef( "CGI parameters: $status" );
# Add a couple more things to the hash...
$obj->{mode} = $mode;
$obj->{init} = $init;
# Making the report is moved to a wrapper method. FWM, 11-Jun-2005
$template = $obj->{template}; $obj->{template} = undef;
return $obj->fmt_report( $template, \%fields );
} # &format
1;