perlmeditation
gav^
I find [CPAN://HTML::Template] great and in my personal mission to encourage people not to embed HTML in perl scripts, here is a few examples to get you started. I've tried to cover things I didn't get when I first started and could have saved me some work.<readmore>
<h1>Lazy form handling with associate</h1>
[CPAN://HTML::Template] has a cunning feature which I didn't notice in my first few passes through the documentation. You can give it your CGI object and it will fill in template values with them.
<h2>color1.tmpl:</h2>
<code>
<form action="color.pl" method="post">
<p>Your name: <input type="text" name="name"
value="<TMPL_VAR NAME=NAME>"></p>
<p>Your favorite color: <input type="text" name="color"
value="<TMPL_VAR NAME=COLOR>"></p>
<p><input type="submit"></p>
</form>
</code>
<h2>color2.tmpl:</h2>
<code>
<p>Hello, <b><TMPL_VAR NAME=NAME></b>. A little
birdy told me your favorite color is <b><TMPL_VAR NAME=COLOR></b>.
</code>
<h2>color.pl:</h2>
<code>
use CGI;
use HTML::Template;
my $cgi = CGI->new;
my $template;
print $cgi->header;
if ($cgi->param('name') && $cgi->param('color')) {
$template = 'color2';
} else {
$template = 'color1';
}
my $t = HTML::Template->new(filename => "$template.tmpl", associate => $cgi);
print $t->output;
</code>
<h1>Cheap Database Output</h1>
You want to output a table but are too lazy to code something? [CPAN://HTML::Template] to the rescue! <tt>param()</tt> needs hashrefs and arrayrefs and the DBI functions <tt>selectall_hashref</tt> and <tt>fetchrow_hashref</tt> come in very handy.
<h2>Perl code:</h2>
<code>
use DBI;
use CGI;
use HTML::Template;
my $cgi = CGI->new;
my $dbh = DBI->connect('dbi:mysql:xxxx:localhost', 'xxxx', 'xxxx');
my $t = HTML::Template->new(filename => 'db.tmpl');
$t->param(ROWS => $dbh->selectall_hashref('select id, name, price from products'));
$dbh->disconnect;
print $cgi->header;
print $t->output;
</code>
<h2>Template code:</h2>
<code>
<table border="1">
<tr><th>ID</th><th>NAME</th><th>PRICE</th></tr>
<TMPL_LOOP ROWS>
<tr>
<td><TMPL_VAR NAME=ID></td>
<td><TMPL_VAR NAME=NAME></td>
<td><TMPL_VAR NAME=PRICE></td>
</tr>
</TMPL_LOOP>
</table>
</code>
<h1>Doing a little bit more...</h1>
<h2>Perl code:</h2>
<code>
[snip]
my $rows = $dbh->selectall_hashref('select id, name, price from products');
$dbh->disconnect;
my $sum = 0;
my $i = 0;
foreach (@$rows) {
$_->{odd} = $i++ % 2;
$sum += $_->{price};
}
$t->param(ROWS => $rows, TOTAL => $sum);
</code>
<h2>Template:</h2>
<code>
<table border="1">
<tr><th>ID</th><th>NAME</th><th>PRICE</th></tr>
<TMPL_LOOP ROWS>
<tr bgcolor="#<TMPL_IF ODD>666666<TMPL_ELSE>EEEEEE</TMPL_IF>">
<td><TMPL_VAR NAME=ID></td>
<td><TMPL_VAR NAME=NAME></td>
<td><TMPL_VAR NAME=PRICE></td>
</tr>
</TMPL_LOOP>
</table>
<p>The total is <TMPL_VAR NAME=TOTAL></p>
</code>
<h1>But I need to process my db output!</h1>
I often find I need to do a little work on what's in the database and handling it row by row is easier.<p> Note the array created so I can pass the same thing every time I create a template. I usually have <tt>cache</tt> on as I am running under mod_perl and this speeds things up a bit, I tend to turn off <tt>strict</tt> and <tt>die_on_bad_params</tt> as I'd rather things looked a bit funky than the script die (especially if it isn't me editing it).
<h2>Perl code:</h2>
<code>
use DBI;
use CGI;
use HTML::Template;
my $cgi = CGI->new;
my $dbh = DBI->connect('dbi:mysql:xxxx:localhost', 'xxxxx', 'xxxx');
my @tmpl_opts = (cache => 1, die_on_bad_params => 0, associate => $cgi);
my $sth = $dbh->prepare('select id, name, price, saleprice from products');
my ($id, $name, $price, $saleprice);
my $i = 0;
my $sum = 0;
$sth->execute;
$sth->bind_columns(\($id, $name, $price, $saleprice));
while ($sth->fetch) {
my $real_price = $price < $saleprice ? $price : $saleprice;
$name =~ s/\b(\w)(\w+)\b/\U$1\L$2/g;
push @rows, { ID => lc($id), PRICE => $real_price, NAME => $name, ODD => $i++ %2 };
$sum += $real_price;
}
$sth->finish;
my $t = HTML::Template->new(filename => 'db2.tmpl', @tmpl_opts);
$t->param(ROWS => \@rows, TOTAL => $sum);
print $cgi->header;
print $t->output;
$dbh->disconnect;
</code>
<h2>Fin</h2>
Hope you liked it :)
<p>gav^