The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
 / 
HTML-Seamstress-2.91
River stage one • 1 direct dependent • 1 total dependent
++
/ HTML::Seamstress

NAME

HTML::Seamstress - Perl extension for HTML generation via tree rewriting

SYNOPSIS

HTML "adulterated" with id attributes

 <html>
 <head>
   <title>Hello World</title>
 </head>
 <body>
 <h1>Hello World</h1>
   <p>Hello, my name is <span id="name">ah, Clem</span>.
   <p>Today's date is <span id="date">Oct 6, 2001</span>.
 </body>
 </html>

Perl finds nodes in the tree and rewrites them:

  use HTML::Seamstress; # HTML::Seamstress HTML::TreeBuilder :)
  my $tree = HTML::Seamstress->new_from_file($html_file);
  $tree->name_handler('bob');
  $tree->date_handler(`date`);
  
  sub name_handler {
    my ($tree, $name) = @_;

    my $name_tag = $tree->look_down('id', 'name');
    $name_tag->detach_content; # delete dummy content ("ah, Clem")
    $name_tag->push_content($name);
  }

  sub date_handler {
    my ($tree, $date) = @_;

    my $name_tag = $tree->look_down('id', 'date');
    $name_tag->detach_content; # delete dummy content ("Oct 6, 2001")
    $name_tag->push_content($date);
  }

Or with convenience methods:

  use HTML::Seamstress; 
  my $tree = HTML::Seamstress->new_from_file($html_file);
  $tree->content_handler(name => 'bob');
  $tree->content_handler(date => `date`);

DESCRIPTION

From reading HTML::Tree::Scanning, we know that HTML has a tree structure. HTML::Seamstress is a subclass of HTML::TreeBuilder which makes it a little easier to perform common HTML templating operations as tree rewriting.

Text Substitution == Node rewriting

The "SYNOPSIS" gave an example of text substitution. From a tree-writing perspective, text substitution involves an in-place change to the content of a node of an HTML tree.

There are two methods for rewriting the content of a node. The more powerful method is set_child_content. The more convenient is content_handler.

$tree->set_child_content(@look_down, $content)

This method looks down $tree using the criteria specified in @look_down using the the HTML::Element look_down() method.

After finding the node, it detaches the node's content and pushes $content as the node's content.

$tree->content_handler($sid_value , $content)

This is a convenience method. Because the look_down criteria will often simply be:

   sid => 'fixup'

to find things like:

   <a sid=fixup href=http://www.somesite.org>replace_content</a>

You can call this method to shorten your typing a bit:

   $tree->content_handler( fixup => 'new text' )

Instead of typing:

  $tree->set_child_content(sid => 'fixup', 'new text')

set_content()

Conditional Processing (aka if/unless) == Node Deletion

In tree rewriting terms, an if directive is used to decide whether a particular node of the HTML tree is preserved or deleted.

For example, given this Template-style HTML:

 [% IF age < 10 %]
       Hello, does your mother know you're 
       using her AOL account?
 [% ELSIF age < 18 %]
       Sorry, you're not old enough to enter 
       (and too dumb to lie about your age)
 [% ELSE %]
       Welcome
 [% END %]

Here is the HTML and Perl for Seamstress:

  <span id=age_handler>
    <span id="under10">
       Hello, does your mother know you're 
       using her AOL account?
    </span>
    <span id="under18">
       Sorry, you're not old enough to enter 
       (and too dumb to lie about your age)
    </span>
    <span id="welcome">
       Welcome
    </span>
  </span>

 package HTML::Seamstress
 use HTML::Seamstress;
 my $tree = HTML::Seamstress->new();
 $tree->parse_file($filename);
 $tree->age_handler($age);
 print $tree->as_HTML;

 sub age_handler {
   my ($tree, $age) = @_;
   my $SPAN = $tree->look_down('id', 'age_handler');
   if ($age < 10) {
    $SPAN->look_down('id', $_)->detach for qw(under18 welcome);
   } elsif ($age < 18) {
    $SPAN->look_down('id', $_)->detach for qw(under10 welcome);
  } else {
        $SPAN->look_down('id', $_)->detach for qw(under10 under18);
  }

 }

Looping (e.g. Table Unrolling) == Child Replication

Sample Model

 package Simple::Class;
 
 use Set::Array;
 
 my @name   = qw(bob bill brian babette bobo bix);
 my @age    = qw(99  12   44    52      12   43);
 my @weight = qw(99  52   80   124     120  230);
 
 
 sub new {
     my $this = shift;
     bless {}, ref($this) || $this;
 }
 
 sub load_data {
     my @data;
 
     for (0 .. 5) {
        push @data, { 
            age    => $age[rand $#age] + int rand 20,
            name   => shift @name,
            weight => $weight[rand $#weight] + int rand 40
            }
     }
 
   Set::Array->new(@data);
 }
 
 
 1;

Sample Usage:

       my $data = Simple::Class->load_data;
       ++$_->{age} for @$data

Inline Code to Unroll a Table

HTML

 <html>
 
   <table id="load_data">
 
     <tr>  <th>name</th><th>age</th><th>weight</th> </tr>
 
     <tr id="iterate">
 
         <td id="name">   NATURE BOY RIC FLAIR  </td>
         <td id="age">    35                    </td>
         <td id="weight"> 220                   </td>
 
     </tr>
 
   </table>
 
 </html>

Perl

 require 'simple-class.pl';
 use HTML::Seamstress;
 
 # load the view
 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
 
 # load the model
 my $o = Simple::Class->new;
 my $data = $o->load_data;
 
 # find the <table> and <tr> 
 my $table_node = $seamstress->look_down('id', 'load_data');
 my $iter_node  = $table_node->look_down('id', 'iterate');
 my $table_parent = $table_node->parent;
 
 
 # drop the sample <table> and <tr> from the HTML
 # only add them in if there is data in the model
 # this is achieved via the $add_table flag
 
 $table_node->detach;
 $iter_node->detach;
 my $add_table;
 
 # Get a row of model data
 while (my $row = shift @$data) {
 
   # We got row data. Set the flag indicating ok to hook the table into the HTML
   ++$add_table;
 
   # clone the sample <tr>
   my $new_iter_node = $iter_node->clone;
 
   # find the tags labeled name age and weight and 
   # set their content to the row data
   $new_iter_node->content_handler($_ => $row->{$_}) 
     for qw(name age weight);
 
   $table_node->push_content($new_iter_node);
 
 }
 
 # reattach the table to the HTML tree if we loaded data into some table rows
 
 $table_parent->push_content($table_node) if $add_table;
 
 print $seamstress->as_HTML;

Seamstress API call to Unroll a Table

 require 'simple-class.pl';
 use HTML::Seamstress;
 
 # load the view
 my $seamstress = HTML::Seamstress->new_from_file('simple.html');
 # load the model
 my $o = Simple::Class->new;
 
 $seamstress->table
   (
    # tell seamstress where to find the table, via the method call
    # ->look_down('id', $gi_table). Seamstress detaches the table from the
    # HTML tree automatically if no table rows can be built
 
      gi_table    => 'load_data',
 
    # tell seamstress where to find the tr. This is a bit useless as
    # the <tr> usually can be found as the first child of the parent
 
      gi_tr       => 'iterate',
      
    # the model data to be pushed into the table
 
      table_data  => $o->load_data,
 
    # the way to take the model data and obtain one row
    # if the table data were a hashref, we would do:
    # my $key = (keys %$data)[0]; my $val = $data->{$key}; delete $data->{$key}
 
      tr_data     => sub { my ($self, $data) = @_;
                          shift(@{$data}) ;
                        },
 
    # the way to take a row of data and fill the <td> tags
 
      td_data     => sub { my ($tr_node, $tr_data) = @_;
                          $tr_node->content_handler($_ => $tr_data->{$_})
                            for qw(name age weight) }
 
   );
 
 
 print $seamstress->as_HTML;

Looping over Multiple Sample Rows

* HTML

 <html>
 
   <table id="load_data" CELLPADDING=8 BORDER=2>
 
     <tr>  <th>name</th><th>age</th><th>weight</th> </tr>
 
     <tr id="iterate1" BGCOLOR="white" >
 
         <td id="name">   NATURE BOY RIC FLAIR  </td>
         <td id="age">    35                    </td>
         <td id="weight"> 220                   </td>
 
     </tr>
     <tr id="iterate2" BGCOLOR="#CCCC99">
 
         <td id="name">   NATURE BOY RIC FLAIR  </td>
         <td id="age">    35                    </td>
         <td id="weight"> 220                   </td>
 
     </tr>
 
   </table>
 
 </html>

* Only one change to last API call.

This:

        gi_tr       => 'iterate',

becomes this:

        gi_tr       => ['iterate1', 'iterate2']

Whither a Table with No Rows

Often when a table has no rows, we want to display a message indicating this to the view. Use conditional processing to decide what to display:

        <span id=no_data>
                <table><tr><td>No Data is Good Data</td></tr></table>
        </span>
        <span id=load_data>
 <html>
 
   <table id="load_data">
 
     <tr>  <th>name</th><th>age</th><th>weight</th> </tr>
 
     <tr id="iterate">
 
         <td id="name">   NATURE BOY RIC FLAIR  </td>
         <td id="age">    35                    </td>
         <td id="weight"> 220                   </td>
 
     </tr>
 
   </table>
 
 </html>

        </span>

EXPORT

None by default.

SEE ALSO

HTML Templating as Tree Rewriting: Part I: "If Statements"

http://perlmonks.org/index.pl?node_id=302606

HTATR II: HTML table generation via DWIM tree rewriting

http://perlmonks.org/index.pl?node_id=303188

Los Angeles Perl Mongers Talk on HTML::Seamstress

http://www.metaperl.com

XMLC, A similar framework for Java

http://xmlc.enhydra.org

Similar Frameworks for Perl

Two other frameworks come to mind. Both are stricter with regard to the correctness of the HTML and both use a different means for node lookup and rewrite.

For me, Seamstress was a natural extension of my love for HTML::TreeBuilder, but if I had an XML job to do, I really think I would reach for Petal. It is quite sweet.

  • Petal

    Based on Zope's TAL, this is a very nice and complete framework that is the basis of MkDoc, a XML application server.

  • XML::LibXML

    By the XML guru Matt Sergeant, who is also the author of AxKit, another XML application server.

AUTHOR

Terrence Brannon, <tbone@cpan.org<gt>

COPYRIGHT AND LICENSE

Copyright 2002-2004 by Terrence Brannon.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.