Hello monks,

reading various nodes here I begun thinking again about perl vs. PHP and such. Bottom line for random web stuff:

One day somebody of our staff walked up to me, saying:

"We need a web interface for our SAP ticket system, here are the specs. Here's the link to the HTML prototype files. You have five days, the service is already sold to customer X. Be sure to deliver it as a package in format $pkg_foo. If you need additional software packages for this, them as well. Ah, and don't change those HTML files. It's likely they get revised after the app is finished."

I had a look at web related perl modules for the next two hours. Oh yes, HTML::Template, Template Toolkit, Mason and so on.. uhm, complete frameworks, oodles of additional modules.

No way - as those are "not invented here" I would spend too much time getting a grip on them. I know I'm slow at learning new things, sometimes.

Besides, HTML::Template is almost rabid forbidding perl code in templates. Template::Toolkt has an own mini-language, hmm. Mason works with non- standard <% %> tags. Ah well.

So, what basics would I expect of some template processing?

Am I missing something?
The perl builtin for templates are formats, but they don't cover points 3, 4 and 5 above. Ok, templating toolkits out there provide much more - besides chaining, inclusion, session management, fancy restrictions resembling the strive between strong and loosely typed languages etc - but as far as I can see there is no "generic" solution yet adressing the five points above in perl, i.e. templating without a templating system.

By necessity, I hacked something maybe close to that goal dealing with that web app.

First I inserted comments in those files in places where I need control statements (loops, if-elses and such). I duplicated sample data blocks and marked one of each with start/end comments, the other got variables. The files looked the same in the browser. Values in input elements to be filled in via servlet showed up as perl variables, though.

Then I wrote a simple parser which turned the file inside out. Three substitutions to free the perl code from its comments, wrap all non-perl stuff in print statements (here-document syntax) and enclose it all in a sub.

Where should I put them? There is AutoSplit and AutoLoader with its nifty *.al files providing some standard. I only use AutoLoader, since the autosplit equivalent is dones with my converting sub.

Each template rendering sub is now stuffed into auto/__PACKAGE__/template.al, of course My::Special::View gets it's stuff from auto/My/Special/View. Insert "use Servlet qw(AUTOLOAD)" in view packages and call your views by name. The package global Servlet::dir is '.' by default an can be set prior or after importing the module to some value, e.g. the path in a "use lib $path" statement.

Differences to AutoSplit *.al files: each sub is written as an anonymous sub, and require'ing Servlet *.al files returns not just 'some true value' but a reference to the sub required. That way the function name doesn't show up in the caller's symbol table, if Servlet is used in OO fashion.

By default, 'use strict' is written to the AutoLoader files. Variables in @_ to the servlet functions are passed into the servlet constructor via an arrayref of variables in the style of 'use vars'.

Back to the app - the controller (as per MVC) was hand-crufted via CGI; CGI::Prototype is a good thing, but then I am supposed to understand Class::Prototyped - see above. Sometimes I'm just lazy at the wrong time.

Done that, I could begin fiddling with getting data from SAP - the "Model". Later, I could give back my templates saying "the HTML files are almost the same - I inserted only comments. Don't touch the comments which have 'perl' in them or the app fails."

Upon delivery, the templates source files could be removed and the *.al files be bundled with the calling packages *.pm after the __END__token - to be processed with AutoSplit upon installation, if AutoSplit had some way of dealing with anonymous subs.

Below are an example, the module, which I called 'Servlet' for now - that name surprisingly is not used at CPAN, and the subs are just that - a bunch of print statements, with a bit of flow control around, and variables inside, wrapped into a subroutine to be autoloaded by its package or called in either a functional or OO fashion.

The servlet pages are created follwing these rules: 

All Perl code within source HTML files has to be embedded into
standard HTML comment tags of one of the following forms:

<!-- perl -->
    This tag allows arbitrary perl code to be included between the
    opening '<!-- perl' and the closing '-->' tags. The current
    implementation uses a non-greedy pattern matching, so HTML
    comment tags inside the perl comment tags will produce unexpected
    results.

<!-- =perl $var -->
    This form allows the interpolation of a single variable between
    the opening '<!-- perl' and the closing '-->' tags.
    These tags don't break up a print statement.

<!-- =perl -->Placeholder text<!-- /perl --->
    As above, additionally "Placeholder text" and the closing tags
    are removed

<!-- perl dummy start --> <!-- perl dummy end -->
    These tags and all characters in between are weeded out.

[download]
Here is a sample servlet template. 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "xhtml1-transitional.dtd">
<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html;
        charset=iso-8859-1"/>
    <meta name="GENERATOR"
        content="vim (X11; I; OpenBSD 3.5 i386) [UNIX]"/>
    <title>
      <!-- =perl $title -->page title<!-- /perl -->
    </title>
  </head>

  <body>
    <h1><!-- =perl $header1 -->Caption<!-- /perl --></h1>
    <!-- perl
    unless($ref) { -->
    <!-- =perl No data provided.<br> --><!-- /perl -->
    <!-- perl
    } else { -->
    <table>
    <!-- perl
        foreach my $ary(@$ref) { -->
      <tr>
          <!-- perl map { -->
          <td><!-- =perl $_ --><!-- /perl -->
          <!-- perl } @$ary;
        } -->
    </table>
    <!-- perl } -->
    <!-- perl dummy start -->
    <table>
      <tr><td>1<td>foo
      <tr><td>2<td>bar
    </table>
    <!-- perl dummy end -->
  </body>
</html>

[download]
Make it a servlet via 
#!/usr/bin/perl
package My::Special::View;
use Servlet qw(servlet);
my $s = servlet(
    in => "example.html",
    # nostrict => 1, # ah, no, never :-)
    args => [ qw($title $header1 $arrayref) ],
);
$s->(
    "sample servlet page",
    "Servlet Heading for a table",
    [[1,a],[2,b]]
);

[download]
or OO-style 
#!/usr/bin/perl
package My::Special::View;
use Servlet;

my $s = Servlet->new(
    in => "example.html",
    args => [ qw($title $header1 $ref) ],
);
$s->render("page","heading",[['foo',1,2],[bar,3,4],[quux,5,6]]);
my @lines = $s->output;
# or
# @lines = $s->render->output;
# then postproess, whatever..
# and finally print them
print @lines;
# direkt render & print
$s->display("page","heading",[['foo',1,2],[bar,3,4],[quux,5,6]]);

[download]
Once the servlet is created, it can be used via AUTOLOAD as well: 
#!/usr/bin/perl
package My::Special::View;
use Servlet qw(AUTOLOAD);
example("sample servlet page","Servlet Heading for a table",
    [[1,a],[2,b]]);

[download]
The servlet is created as auto/My/Special/View/example.al as follows: 
#!/usr/bin/perl
package My::Special::View;
use strict;
# File generated by Servlet 0.01 at Sat Jun 17 13:55:02 2006
# from source: example.html
# WARNING: changes made here will be overwritten upon re-creation.
use File::Temp qw( tempfile ); # required once in My::Special::View
return sub {
    my ($title, $header1, $ref) = @_;;
    my ($___example_fh,$___example_fn,$___example_oldfh);
    my $wantarray = wantarray();
    if(wantarray) {
        ($___example_fh,$___example_fn) = tempfile() or die "can't tem
+pfile: $!\n";
        $___example_oldfh = select ($___example_fh); $| = 1;
    } 

print <<"E0000";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "xhtml1
+-transitional.dtd">
<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=iso-88
+59-1">
    <meta name="GENERATOR" content="vim (X11; I; OpenBSD 3.5 i386) [UN
+IX]">
    <title>
      $title
    </title>
  </head>
  <body>
    <h1>$header1</h1>
E0000
unless($ref) {
print <<"E0001";
    No data provided.<br>
E0001
} else {
print <<"E0002";
    <table>
E0002
foreach my $ary(@$ref) {
print <<"E0003";
      <tr>
E0003
map {
print <<"E0004";
          <td>$_
E0004
} @$ary;
        }
print <<"E0005";
    </table>
E0005
}
print <<"E0006";
    
  </body>
</html>
E0006

    if($wantarray) {
        local *I;
        open(I,"<",$___example_fn) or warn "My::Special::View::example
+: Can't open $___example_fn for reading: $!\n";
        my @text = <I>;
        close(I); unlink($___example_fn);
        select($___example_oldfh);
        return @text;
    } 
};

[download]
Here's the output: 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "xhtml1
+-transitional.dtd">
<html>
  <head>
    <meta http-equiv="Content-Type" content="text/html; charset=iso-88
+59-1">
    <meta name="GENERATOR" content="vim (X11; I; OpenBSD 3.5 i386) [UN
+IX]">
    <title>
      sample servlet page
    </title>
  </head>
  <body>
    <h1>Servlet Heading for a table</h1>
    <table>
      <tr>
          <td>1
          <td>a
      <tr>
          <td>2
          <td>b
    </table>
    
  </body>
</html>

[download]
Here's the module. The AUTOLOAD is borrowed from AutoLoader.
For now the processing only covers HTML, but I'll move that part into a subclass and leave only a stub in the module. 
package Servlet;

use Carp;
use strict;
use 5.006_001;

our($VERSION, $AUTOLOAD, $exported,$debug);

my $is_dosish;
my $is_epoc;
my $is_vms;
my $is_macos;

BEGIN {
    $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32' || $
+^O eq 'NetWare';
    $is_epoc = $^O eq 'epoc';
    $is_vms = $^O eq 'VMS';
    $is_macos = $^O eq 'MacOS';
    $VERSION = '0.01';
}

$Servlet::dir ||= '';

my @export_ok = qw(AUTOLOAD servlet);

my %T;  # timestamps
my %S;  # subs - our own %INC...

sub new {
    my $class = shift;
    my $caller = caller;
    bless { 'sub' => servlet($caller,@_) }, $class;
} 

# Output the servlet.
# At this point, the timestamps of the servlets source and its
# sub could be checked, and the sub recreated and reloaded.
sub display {
    my $self = shift;
    if($self->{'output'}) {
        print @{$self->{'output'}};
    } else {
        $self->{'sub'}->(@_);
    }
    $self;
} 

# get the output from the servlet.
sub output {
    @{$_[0]->{'output'}};
} 

# just render the servlet, store it's output.
# we use the value of wantarray() in the servlet function to
# determine if the output should be printed or returned.
sub render {
    my $self = shift;
    my @l = $self->{'sub'}->(@_);
    $self->{'output'} = [@l];
    $self;
} 

# get the servlet's stored subroutine,
# require the servlet.al file 
# or create it and require then
sub servlet {
    my $callpkg = caller;
    my $class = $callpkg eq __PACKAGE__ ? shift : $callpkg;
    confess __PACKAGE__.' class wants no servlet! -'
        if $class eq __PACKAGE__;
    my %a = @_;
    $a{'in'} or $a{'code'}
        or confess __PACKAGE__.'::servlet: '
            ."provide at least one of argument for 'in' and 'code'\n";
    -f $a{'in'} or confess "Can't find file '$a{in}' - $!\n" if define
+d($a{'in'});

    # if we have 'in' and no 'code', process into standard path auto/_
+_PACKAGE__
    # if we have 'in' and 'code', name function & file after 'code'.
    # if we have 'code' and no 'in', load that file, function is named
+ after 'code'.

    my ($sub, $function, $outfile);

    if($a{'in'}) {
        my $infile = $a{'code'} || $a{'in'};
            
        ($outfile = $infile ) =~ s/\.\w+$//;
        (my $classpath = $class ) =~ s#::#/#g;

        my $dir = "auto/$classpath";
        substr($dir,0,0) = $servlet::dir .'/' if $Servlet::dir;
        _mkdir_p($dir) unless -d $dir;
        $outfile =~ s#.*/##;
        substr($outfile,0,0) = $dir.'/';
        $outfile .= '.al';
    } else {
        $outfile = $a{'code'};
    } 
    ($function = $outfile) =~ s#^.*/|\.\w+$##g;

    if( ($function eq 'servlet') && $exported) {
        carp "function for '$a{in}' resolves to servlet,\n"
            ."which is exported from ".__PACKAGE__."\n"
            .'pointing gun at left foot. shooting...';
    } 
    # check time of source & servlet.al
    if(_time_ok($a{'in'},$outfile) || (!$a{'in'} && -f $outfile)) {
        return $S{$outfile} if $S{$outfile}; # already known
        # we use eval EXPR because we need to switch package
        $S{$outfile} = $sub = eval "package $class; require '$outfile'
+;";
    } else {
        # get rid of the old stuff, so we can require again.
        delete $INC{$outfile};

        local *O; # we could use Symbol and such, but what for?
        local $/; # slurp
        local *I;
        open(I,"<$a{in}")   or confess "can't read '$a{in}': $!";
        open(O,">$outfile") or confess "Can't write $outfile: $!";
        my $oldfh = select O;
        local $\;       # reset -l  switch locally
        my $text = <I>;

        # first weed out sample content
        $text =~ s/<!-- perl dummy start -->.*?<!-- perl dummy end -->
+//gs;
        # then strip variables of enclosing tags
        $text =~ s/<\!-- =perl\s*(.+?)\s*-->(.*?<\!--\s*\/perl\s*-->)?
+/$1/g;
        # then, convert all into print <<"Exxxx" statements
        # and leave perl code as is
        my $t = "E0000"; # tag for here-document print statements
        my $s = '';
        $text =~ s/(.+?)?<\!-- perl\s*(.*?)?\s*-->|(.+)/
            my $a = $1 if $1;
            $a .= $3 if $3;
            my $b = $2 || '';
            $a =~ s#[\s*\n]*$#\n#;
            ($s = "\nprint <<\"$t\";\n".$a.$t++."\n".$b)=~s#\n+#\n#g;
            $s
        /ges;

        # The output of the servlet is delivered straight to the
        # selected filehandle or returned to the caller.
        # We use wantarray() to determine the current context.
        # If wantarray() returnes true, the output is captured into
        # a temporary file which filehandle we select(). Thus all
        # print() without explicit filehandle ends up in the tempfile
        # and we can return its content as a list of lines.
        #
        # This mess is necessary because servlets may be chained, and
        # we don't want output going unadverted into STDOUT or such.

        my $strict = 'use strict;' unless $a{'nostrict'};
        my $args;
        $args = 'my ('.join(', ',@{$a{'args'}}).') = @_;' if ($a{'args
+'});
        my $pkg = __PACKAGE__;
        my $t = scalar(localtime(time));
        print <<"EOH";
#!$^X
package $class;
$strict
# File generated by $pkg $VERSION at $t
# from source: $a{in}
# WARNING: changes made here will be overwritten upon re-creation.
use File::Temp qw( tempfile ); # required once in $class
return sub {
    $args;
    my (\$___${function}_fh,\$___${function}_fn,\$___${function}_oldfh
+);
    my \$wantarray = wantarray();
    if(wantarray) {
        (\$___${function}_fh,\$___${function}_fn) = tempfile() or die 
+"can't tempfile: \$!\\n";
        \$___${function}_oldfh = select (\$___${function}_fh); \$| = 1
+;
    } 
$text
    if(\$wantarray) {
        local *I;
        open(I,"<",\$___${function}_fn) or warn "$class\::$function: C
+an't open \$___${function}_fn for reading: \$!\\n";
        my \@text = <I>;
        close(I); unlink(\$___${function}_fn);
        select(\$___${function}_oldfh);
        return \@text;
    } 
};
EOH
        close(O);
        select $oldfh;
        $sub = eval "package $class; require '$outfile';";
        confess $@ if $@;
        $S{$outfile} = $sub;
    } 
    no strict 'refs';
    if ($a{'import'}) {
        *{$class.'::'.$function} = $sub;
    } 
    $sub;
} 
# ====================================================================
+==========
# private subs
# ====================================================================
+==========
# timestamp
sub _time_ok {
    if ($_[0] and  $_[1]) {
        (stat($_[0]))[9] <= (stat($_[1]))[9] if -f $_[0] and -f $_[1];
    }
} 

# mkdir -p
sub _mkdir_p {
    my @l = split(/\//,$_[0]);
    my $dir = shift(@l);
    mkdir($dir,0755) unless -d $dir;
    foreach my $d(@l) {
        $dir .= "/$d";
        unless(-d $dir) {
            mkdir($dir,0755) or confess "huh? - mkdir($dir,0755): $!\n
+";
        }
    } 
} 
1;
# From here on slightly modified AutoLoader.pm
AUTOLOAD {
    my $sub = shift;
    if ($sub =~ /.*::servlet$/) {
        require Carp;
        Carp::confess("servlet may not be autoloaded");
    } 
    my $filename;
    # Braces used to preserve $1 et al.
    {
        # [ AutoLoader comments deleted ]

        my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/);
        $pkg =~ s#::#/#g;
        if (defined($filename = $INC{"$pkg.pm"})) {
            if ($is_macos) {
                $pkg =~ tr#/#:#;
                $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s;
            } else {
                $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s;
            }

            # # [ AutoLoader comments deleted ]

            if (-r $filename) {
                unless ($filename =~ m|^/|s) {
                    if ($is_dosish) {
                        unless ($filename =~ m{^([a-z]:)?[\\/]}is) {
                             if ($^O ne 'NetWare') {
                                        $filename = "./$filename";
                                } else {
                                        $filename = "$filename";
                                }
                        }
                    }
                    elsif ($is_epoc) {
                        unless ($filename =~ m{^([a-z?]:)?[\\/]}is) {
                             $filename = "./$filename";
                        }
                    }
                    elsif ($is_vms) {
                        # XXX todo by VMSmiths
                        $filename = "./$filename";
                    }
                    elsif (!$is_macos) {
                        $filename = "./$filename";
                    }
                }
            }
            else {
                $filename = undef;
            }
        }
        unless (defined $filename) {
            # let C<require> do the searching
            $filename = "auto/$sub.al";
            $filename =~ s#::#/#g;
        }
    }
    my $save = $@;
    local $!; # Do not munge the value. 
    # BEGIN changes
    my $ref;
    $ref = eval { local $SIG{__DIE__}; require $filename };
    # END changes
    if ($@) {
        if (substr($sub,-9) eq '::DESTROY') {
            no strict 'refs';
            *$sub = sub {};
            $@ = undef;
        } elsif ($@ =~ /^Can't locate/) {
            # [ AutoLoader comments deleted ]
            if ($filename =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e)
+{
                $ref = eval { local $SIG{__DIE__}; require $filename }
+;
            }
        }
        if ($@){
            # $@ =~ s/ at .*\n//; # why???
            my $error = $@;
            require Carp;
            Carp::croak($error);
        }
    }
    $@ = $save;
    goto ref($ref) eq 'CODE' ? $ref : &$sub;
}

sub import {
    my $pkg = shift;
    my $callpkg = caller;

    #
    # Export symbols, but not by accident of inheritance.
    #
    my %a;
    @a{@_} = @_;
    if ($pkg eq 'Servlet') {
        no strict 'refs';
        foreach my $symbol(@export_ok){
            *{ $callpkg . '::' . $symbol } = \&$symbol
                if $a{$symbol};
            $exported++ if $symbol eq 'servlet';
        }
    }

    # I've left out the autosplit searching.
}

sub unimport {
    my $callpkg = caller;

    no strict 'refs';
    my $symname = $callpkg . '::AUTOLOAD';
    undef *{ $symname } if \&{ $symname } == \&AUTOLOAD;
    *{ $symname } = \&{ $symname };
}

1;

__END__

[download]
Update: changed title to include RFC; cleanup

Would be nice to know wether this makes (non)sense to you. Any critics and enhancement sugesstions are greatly welcome.

regards,

shmem

In reply to RFC: Templating without a System by shmem

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.