perltutorial
princepawn
<h3>Highly Orthogonal Web Application Development with HTML_Tree</h3>
Update: the new CPAN distribution with similar and improved functionality is [cpan://HTML::Seamstress]
<blockquote>
<b>update:</b> if you do a distribution search on
<a href=http://kobesearch.cpan.org>kobesearch.cpan.org</a>
then you will find <I>HTML_Tree</I>.
<P>
However, on <a href=http://search.cpan.org>search.cpan.org</a>
you had better search for
[cpan://Apache::HTML::ClassParser] which is part of the HTML_Tree distribution
</blockquote>
<blockquote>
[cpan://HTML_Tree] is supposedly yet another
templating module. However, as far as I know, it is the only one in
which the HTML to be templated is a completely syntactically valid
HTML file, meaning no tags exist which lead to a syntacticaly invalid
HTML file.
<P>
The way that [cpan://HTML_Tree] works its magic is by parsing the
HTML file to be templated and searching for <code>CLASS</code>
attributes within HTML tags. It presumes the <code>CLASS</code> attribute to
be a pointer to a method in a module with the same name as the html
file, sans <code>.chtml</code>, plus <code>.pm</code>. Four examples of this type
of usage will be explained in detail. For now, a bit more on what
[cpan://HTML_Tree] has to offer and how.
<P>
For me, the big win of [cpan://HTML_Tree] is that it allows me to
build a complete site and then have a graphic artist come behind and
work with pure HTML to beautify it.
<P>
[cpan://HTML_Tree] is supposedly
[cpan://Apache::Filter]-aware, but I had to fix a small bug in how
it handled such filter chains. Add the recreation of <code>$r</code>
and you are set:
<code>
if ( lc( $r->dir_config( 'Filter' ) ) eq 'on' ) {
$r = $r->filter_register; ## add this line
$r->filter_input();
</code>
I tried emailing the author at his advertised CPAN email about this,
but it bounced.
<P>
And another neat thing is that it uses it's own HTML parser which is
written entirely in C++ and is several orders of magnitude faster
[cpan://HTML::Parser] as a result.
<P>
The final thing that I like about this module is that I can write
Perl classes that I can run from the shell (meaning, without a
webserver). Thus my Perl code is runnable and testable in terms of its
text generation for the webserver without having to debug via Apache
error logs.
<P>
Now that the introductions are done, let's work through
some examples using [cpan://HTML_Tree]. For your reference, for
the next few days from <code>Fri Aug 24 09:36:41 EDT 2001</code>,
the examples are at:
<a href="http://princepawn.perlmonk.org:8229/index.chtml">this link</a>.
</blockquote>
<READMORE>
<h3>Example One: dyanmic display of date and time</h3>
<code>
<html>
<head>
<h3>Date Time Page</h3>
</head>
<body>
<h3>Date Time Page</h3>
The current date and time is
<span class="date_time">4:44pm on the dot</span>
</body>
</html>
</code>
<code>
package index;
sub new {
my $that = shift;
my $class = ref( $that ) || $that;
my $this = {
class_map => {
date_time => \&amp;amp;amp;date_time,
},
# other stuff you want here ...
};
return bless $this, $class;
}
sub date_time {
my( $this, $node, $class, $is_end_tag ) = @_;
($node->children())[0]->text( `date` );
}
</code>
1;
</code>
<p>
Ok, note in the HTML there is a <code>CLASS</code> attribute whose value is
<code>date_time</code>. When [cpan://HTML_Tree] sees this attribute, it
uses the <code>class_map</code> of the object associated with this HTML file
to find the method to call. In this method, we set the text aspect of
the <code>SPAN</code> to the date. And we are done.
</p>
<h3>Conditional HTML</h3>
<code>
HTML
<html>
<head>
<h3>Conditional HTML</h3>
</head>
<body>
<h1>Conditional HTML</h1>
This page will show a table when the calculated random numer is odd.
Here is what we calculated :
<B class="calc_random">
<span class="show_random">dummy text</span>
</B> which has a modulus of
<I CLASS="text::display">dummy text</I>
<table class="if::display">
<tr><th>yo<th>ho<th>ho
<tr><td>and<td>a<td>bottle
<tr><td>of<td>rum,<td>son
<tr><td>let's<td>have<td>fun!
</table>
</body>
</html>
Perl
package index;
srand (time ^ $$ );
sub new {
my $that = shift;
my $class = ref( $that ) || $that;
my $this = {
class_map => {
calc_random => \&amp;amp;amp;calc_random,
show_random => \&amp;amp;amp;show_random,
show_tab => \&amp;amp;amp;show_tab,
},
# other stuff you want here ...
};
return bless $this, $class;
}
sub calc_random {
my( $this, $node, $class, $is_end_tag ) = @_;
return 0 if $is_end_tag;
$this->{random} = sprintf '%d', rand(1000);
return 1;
}
sub show_random {
my( $this, $node, $class, $is_end_tag ) = @_;
return 0 if $is_end_tag;
$this->{display} = ($this->{random} % 2);
($node->children())[0]->text( $this->{random});
return 1;
}
1;
</code>
<p>
The calling of method subroutines via <code>class_map</code> should be
old-hat to you by now. However, two shortcut methods from
[cpan://HTML_Tree] were used in this case to simplify the coding.
<code>text::display</code> is a shorthand for accessing the key
<code>display</code> in the object and setting the text field to it's
value. <code>if::display</code> access the <code>display</code> key
and then includes the encapsulated HTML if that key returns true.
</p>
<h3>Dynamic Table Row Expansion</h3>
<p>One of the neat things about [cpan://HTML::Embperl] is that you
can load up an array with some data and have it loop across the data
to create table rows. In [cpan://HTML_Tree] I will only show parts
of the HTML here, so you can get an idea of how [cpan://HTML_Tree]
allows you to do the same thing.
<code>
<tr class="next_row">
<td class=text::USER>billy_bob
<td class=text::PID>123
<td class=text::CPU>456
<td class=text::MEM>789
<td class=text::TIME>101
<td class=text::COMMAND>666
</tr>
sub next_row {
my( $this, $node, $class, $is_end_tag ) = @_;
return 1 if $is_end_tag;
my $row = shift @{$this->{ps_table}};
return 0 if !$row;
my @row = split /\s+/, $row;
@{$this}{qw(USER PID CPU MEM TIME COMMAND)} =
(@row[0..3],@row[9,10]);
return 1;
}
</code>
Basically the way this gets unrolled out into a bunch of table rows is
handled by a few keys line. First
<code> return 1 if $is_end_tag;</code>
What this is saying is: "When you, the HTML parser sees at tr end tag,
reparse the tr tag, thus recalling the CLASS attribute. This way, I
can get another crack at creating another table row". Next:
<code>
my $row = shift @{$this->{ps_table}};
return 0 if !$row;
</code>
Here we try to get another line from the ps command. If there are no
more lines, then we return 0 and the HTML parser knows that this
element can now be skipped and document processing can continue.
<p>Otherwise, we simply load the fields of the ps command into parts
of the hashref so that we can print them as individual td elements.</p>
</p>
<p>
So now you should have a good feel for how table rows can be expanded
dynamically. By dynamic, I mean that the HTML and webserver had no
predefined notions of how many rows were going to come back. It was
only by using <code>next_row()</code> in a callback fashion that it
finally gave [cpan://HTML_Tree] the go-ahead to quit churning out rows.
</p>
<h3>Dynamic Table Rows and Data via Reformed Lists</h3>
<p>Our final example in this set extends this idea one step
further. In this case, not only are the number of rows dynamically
determined but the number of elements <I>within a row</I>. And this is
trivial with [cpan://HTML_Tree] we simply make the td callback
return 0 when we have no more row elements and the tr callback do the
same.</p>
<code>
HTML
<html>
<head>
<h3>The Reformed Data</h3>
</head>
<body>
<h1>The Reformed Data</h1>
<P>You requested to have your data formatted into
<B CLASS=show_no_rows>300,00</B> columns:
<P>And here is your wonderful data:
<B CLASS=show_data>blah blah blah</B>
<P>And now displayed as a table:
<table class=reform_data>
<tr class=table_row><td class=td>HOHOHO</td></tr>
</table>
</body>
</html>
Perl
package index;
sub new {
my $that = shift;
my $class = ref( $that ) || $that;
my $this = {
class_map => {
show_no_rows => \&amp;amp;amp;show_no_rows,
show_data => \&amp;amp;amp;show_data,
reform_data => \&amp;amp;amp;reform_data,
table_row => \&amp;amp;amp;table_row,
td => \&amp;amp;amp;td,
},
# other stuff you want here ...
};
return bless $this, $class;
}
sub show_no_rows {
my( $this, $node, $class, $is_end_tag ) = @_;
return 0 if $is_end_tag;
$this->{rows} = $this->{ r }->param('no_rows');
($node->children())[0]->text( $this->{rows} );
return 1;
}
sub show_data {
my( $this, $node, $class, $is_end_tag ) = @_;
return 0 if $is_end_tag;
$this->{data} = [ split /\s+/, $this->{ r }->param('data') ];
($node->children())[0]->text( $this->{r}->param('data' ) );
return 1;
}
sub reform_data {
use Array::Reform;
my( $this, $node, $class, $is_end_tag ) = @_;
return 0 if $is_end_tag;
warn "no_rows: $this->{rows}";
$this->{reform_data} =
[ Array::Reform->reform($this->{rows}, $this->{data} ) ];
use Data::Dumper;
warn Data::Dumper->Dump([$this->{reform_data}],['reform_data']);
return 1;
}
sub table_row {
my( $this, $node, $class, $is_end_tag ) = @_;
warn 'table_row';
return 1 if $is_end_tag;
my $rows= $this->{rows};
$this->{td} = shift @{$this->{reform_data}};
warn "THIS_TD: @{$this->{td}}";
return 0 if !$this->{td};
return 1;
}
sub td {
my( $this, $node, $class, $is_end_tag ) = @_;
warn 'td';
return 1 if $is_end_tag;
my $rows= $this->{rows};
my $td = shift @{$this->{td}};
return 0 if !$td;
($node->children())[0]->text($td);
return 1;
}
1;
</code>