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.
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:
Here is a sample servlet template.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.
Make it a servlet via<!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>
or OO-style#!/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]] );
Once the servlet is created, it can be used via AUTOLOAD as well:#!/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]]);
The servlet is created as auto/My/Special/View/example.al as follows:#!/usr/bin/perl package My::Special::View; use Servlet qw(AUTOLOAD); example("sample servlet page","Servlet Heading for a table", [[1,a],[2,b]]);
Here's the output:#!/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; } };
Here's the module. The AUTOLOAD is borrowed from AutoLoader.<!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>
Update: changed title to include RFC; cleanuppackage 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__
Would be nice to know wether this makes (non)sense to you. Any critics and enhancement sugesstions are greatly welcome.
regards,
shmem
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: RFC: Templating without a System
by perrin (Chancellor) on Jun 17, 2006 at 16:14 UTC | |
Re: RFC: Templating without a System
by chromatic (Archbishop) on Jun 18, 2006 at 05:39 UTC | |
by shmem (Chancellor) on Jun 18, 2006 at 14:22 UTC | |
by chromatic (Archbishop) on Jun 18, 2006 at 21:23 UTC | |
by shmem (Chancellor) on Jun 20, 2006 at 01:04 UTC | |
by chromatic (Archbishop) on Jun 20, 2006 at 08:27 UTC | |
| |
Re: RFC: Templating without a System
by davidrw (Prior) on Jun 17, 2006 at 14:30 UTC | |
by shmem (Chancellor) on Jun 17, 2006 at 14:47 UTC | |
by merlyn (Sage) on Jun 17, 2006 at 15:47 UTC | |
by Anonymous Monk on Jun 18, 2006 at 15:19 UTC | |
by merlyn (Sage) on Jul 01, 2006 at 15:16 UTC | |
| |
Re: RFC: Templating without a System
by xdg (Monsignor) on Jun 17, 2006 at 14:50 UTC | |
by shmem (Chancellor) on Jun 17, 2006 at 15:02 UTC | |
by tinita (Parson) on Jun 18, 2006 at 13:28 UTC | |
by shmem (Chancellor) on Jun 18, 2006 at 15:01 UTC | |
Re: RFC: Templating without a System
by wazoox (Prior) on Jun 18, 2006 at 08:14 UTC | |
Re: RFC: Templating without a System
by tilly (Archbishop) on Jun 21, 2006 at 02:29 UTC | |
by shmem (Chancellor) on Jun 22, 2006 at 10:11 UTC | |
Re: RFC: Templating without a System (your system)
by tye (Sage) on Jul 01, 2006 at 16:07 UTC | |
by shmem (Chancellor) on Jul 02, 2006 at 23:48 UTC | |
by tye (Sage) on Jul 03, 2006 at 00:50 UTC | |
by shmem (Chancellor) on Jul 03, 2006 at 16:15 UTC | |
Re: RFC: Templating without a System
by jdtoronto (Prior) on Jun 20, 2006 at 06:10 UTC | |
by shmem (Chancellor) on Jun 20, 2006 at 07:38 UTC | |
Re: RFC: Templating without a System
by metaperl (Curate) on Jun 20, 2006 at 16:27 UTC | |
by shmem (Chancellor) on Jun 20, 2006 at 23:34 UTC | |
by metaperl (Curate) on Jun 23, 2006 at 13:46 UTC | |
by shmem (Chancellor) on Jun 23, 2006 at 15:13 UTC | |
Re: RFC: Templating without a System
by Aristotle (Chancellor) on Jul 24, 2006 at 23:26 UTC | |
by shmem (Chancellor) on Jul 25, 2006 at 00:15 UTC | |
by Aristotle (Chancellor) on Sep 08, 2006 at 12:34 UTC | |
by shmem (Chancellor) on Oct 22, 2006 at 22:39 UTC | |
by Aristotle (Chancellor) on Oct 24, 2006 at 07:41 UTC |