view release on metacpan or  search on metacpan

lib/Template/PSP.pm  view on Meta::CPAN

package Template::PSP;

require 5.005;

use strict;

use Carp;

use HTML::Parser;
use IO::Scalar;
use DBI; 
use vars qw($VERSION);

$VERSION = 1.00;

# %tags        - list of special HTML tags defined in Template.pm
# %global_tags - list of HTML tags, accessible by all pages
#
# $page       - scalar reference to script being created from template
# $frags      - html fragments
# $outputflag - process '$' variables
# $perlflag   - perl code
# $package    - template is being placed in $package
# %tagdata    - data associated with tag being created
# %Cache      - file time stamps for loaded psp pages
# %Handler    - pointers to subroutines for psp pages
# %type       - subroutines for handling output types

use vars qw (%tags %global_tags $page $parsefile $frags $outputflag $perlflag
	     $handlerflag $package %tagdata %Cache %Handler %type $lineno
	     $top_package $escapeflag $space
	    );

use vars qw(%QUERY %CGI %FILENAMES %AUTH %COOKIE);

%tags = map {$_ => 1} 
	( "tag", "loop", "if", "else", "elseif", "perl", "fetch", "output", 
	"handler", "return", "include", "pspescape" );

sub cleanup
{
  no strict 'refs';
  push(@{$top_package . "::cleanup_handler"}, shift);
}

sub cleanup_handler
{
  my $handlers = shift(@_);
  
  for (my $i=0;$handlers->[$i];$i++)
  {
    &{$handlers->[$i]}();
  }
}

sub setpvar
{
  my $item = shift;
  my $value = shift;
  if ($item)
  {
    no strict 'refs';
    ${$top_package . "::" . $item} = $value;
  }
}

sub getpvar
{
  my $item = shift;
  no strict 'refs';
  return ${$top_package . "::" . $item};
}

# derive the absolute path based on a
# relative filename and the current file
# 
# thanks to Scott Kiehn
#
sub abs_path
{
  my $file = shift(@_);
  
  my $prefix = substr($file, 0, 1);
  
  # if this is not an absolute path, 
  # create an absolute path from it
  if ($prefix ne '/')          
  {
    # check for document root abbreviation
    if ($prefix eq '~')     
    {
      $file = substr($file, 1);
      $file = $ENV{DOCUMENT_ROOT} . $file;
    }
    # otherwise use relative path based on the current file
    else                        
    {
      $file = substr( $parsefile, 0, rindex($parsefile, '/') ) . "/" . $file;
    }
  }

  return $file;
}


################################################################
# pspload
# pspload reloads psp pages that have changed on disk and 
# puts the code for those pages into their own package based
# on the name of the file being loaded.  We run the file
# name passed to pspload through abs_path to be certain that
# the file name is uniquely defined.

sub pspload
{
  my ($data, $pkg, $topflag) = @_;
  my $parseflag = 0;
  my $handler;
  my $file;
  my ($oldpage, $oldpkg, $oldfrags, $pg, $oldfile, $oldlineno);

  if (!ref($data))
  {
    # data is a file name, not the code 
    # This file name may have . ../.. or a relative path
    # that makes it not uniquely defined
    $file = abs_path($data);
  
    if (newfile($file))
    {
      # we've not loaded the file before, or it
      # has changed on disk.  Load it.
      if (!defined($pkg))
      {
        $pkg = valid_package_name($file);
      }
      $parseflag = 1;
    }
    else
    {
      $handler = $Handler{$file};
    }
  }
  else
  {
    $parseflag = 1;
    $file = $ENV{SCRIPT_FILENAME};
  }
  
  if ($parseflag)
  {
    my $parser;
    my $token;
    
    # we need to create a temporary place
    # to store the page as it is building it
    $oldlineno = $lineno;
    $oldfile = $parsefile;
    $oldfrags = $frags;
    $oldpage = $page;
    $oldpkg = $package;
    $frags = 0;
    $lineno = 1;
    $package = $pkg;
    $page = \$pg;
    $parsefile = $file;
    
    my $eval =  "package $pkg;\n" .
		'*getpvar = \&Template::PSP::getpvar;' . "\n" .
	        '*setpvar = \&Template::PSP::setpvar;' . "\n" .
		'*cleanup = \&Template::PSP::cleanup;' . "\n" .
		'use CGI::Minimal;' . "\n" .
		'use vars qw(%QUERY %CGI %FILENAMES %AUTH %COOKIE);' . "\n";
    
    eval $eval;
    
    append_page("package $pkg;\n");
    append_page("no strict;\n");
    append_page("sub {\n");
    if ($topflag)
    {
      append_page('$Template::PSP::top_package = ' . $pkg . ";\n");
	    append_page('Template::PSP::set_hashes(*CGI, *COOKIE, *QUERY, *FILENAMES, *AUTH);' . "\n");    }
    else
    {
      append_page(
	  '*QUERY = *{$Template::PSP::top_package . "::QUERY"};' . "\n" .
	  '*CGI = *{$Template::PSP::top_package . "::CGI"};' . "\n" .
	  '*FILENAMES = *{$Template::PSP::top_package . "::FILENAMES"};' . "\n" .
	  '*AUTH = *{$Template::PSP::top_package . "::AUTH"};' . "\n" .
	  '*COOKIE = *{$Template::PSP::top_package . "::COOKIE"};' . "\n");
    }
    
    $parser = HTML::Parser->new( api_version => 3,
				 start_h => [\&start, "tagname,attr,text"],
				 end_h => [\&end, "tagname,text"],
				 text_h => [\&text, "text,is_cdata"],
				 comment_h => [\&comment, "text"],
				 default_h => [\&default, "text"]
			       );
    
    # send unbroken text instead of chunks to improve performance
    # by reducing the number of function calls 
    $parser->unbroken_text(1);
    $parser->xml_mode(1);
    
    if (ref($data))
    {
      $parser->parse($$data) || croak "$! in pspload()";
    }
    else
    {
      $parser->parse_file($data) || croak "$! while loading file '$data'";
    }
    
    if ($topflag)
    {
      append_page('&Template::PSP::cleanup_handler(\@cleanup_handler);' . "\n");
      append_page('select(STDOUT);' . "\n");
    }
    append_page("return 1;\n");
    append_page("}\n");
    
    $handler = eval $$page;
        
    if ($@)
    {
      psperror($file);
    }
    
    if ($file)
    {
      $Handler{$file} = $handler;
    }
    
    no strict 'refs';
    
    # restore globals
    $lineno = $oldlineno;
    $parsefile = $oldfile;
    $frags = $oldfrags;
    $page = $oldpage;
    $package = $oldpkg;
  }

  # import export_tags from loaded page
  if (defined($package))
  {
    if (!defined($pkg))
    {
      $pkg = valid_package_name($file);
    }
    
    no strict 'refs';
    
    foreach my $tag (keys %{$pkg . "::export_tags"})
    {
      ${$package . "::custom_tags"}{$tag} = ${$pkg . "::export_tags"}{$tag};
    }
  }

  return $handler;
}


# displays psp page with line numbers
sub pspdebug
{
  no strict 'refs';
  my @lines = split("\n", $$page);
  for (my $i = 1; $i <= $#lines + 1;$i++)
  {
    print STDERR "<$i> " . $lines[$i-1] . "\n";
  }
}

# output error
sub psperror
{
  my $tag = shift;

  #    pspdebug();
  #    croak "failed when processing " . $tagdata{name} . ": $@\n";
  croak $@;
}

# appends code to page
sub append_page
{
  no strict 'refs';
  ${$page} .= join(" ", @_);
}

sub set_hashes (%%%%%)
{
  local(*CGI, *COOKIE, *QUERY, *FILENAMES, *AUTH) =  @_;
  
  # duplicate environment variables in %CGI
  %CGI = %ENV;
  
  # fill %QUERY with query values

lib/Template/PSP.pm  view on Meta::CPAN

  no strict 'refs';

  my $fn = $global_tags{$tagname . "_"} ||
           ${$package . "::custom_tags"}{$tagname . "_"};

  if ($fn)
  {
    no strict 'refs';
    append_page('&' . $fn .'();' . "\n");
    return;
  }
  
  text($space . $text);
  $space = "";
  return;
}

# for comments,
# display the comment as provided
sub comment
{
  my ($text) = @_;
  default($text);

  text($space . $text);
  $space = "";
  return;
  
  return;
}

sub default
{
  my ($text) = @_;
  $lineno += count_lines($text);
}

# handles all text that is read by the parser
sub text
{
  my ($text) = @_;

  if (!$escapeflag && $text =~ /^\s*$/s)
  {
    $space = $text;
    return;
  }
  if ($perlflag)
  {
    append_page($text);
  }
  elsif ($outputflag)
  {
    $text =~ s/\@/\\\@/g;
    append_page('print qq{' . $text . '};' . "\n");
  }
  else
  {
    no strict 'refs';
    $frags++;
    ${$package . '::__html_' . $frags} = $text;
    append_page("print \$" . $package . '::__html_' . $frags . ";\n");;
  }
}


#########################################
# BEGIN TAG DEFINITIONS
#
# The tag TAG allows building of non-looping tags.
# three parameters can be passed:
# name - name of tag to create
# body - if set to nonzero, the tag being defined contains
#     a body
# output - if set to nonzero, the tag being defined will
#     evaluate variables that begin with '$' 


sub tag
{
  my ($attr) = @_;
  my (@attrs) = split(/,/, $attr->{accepts});

  # Try to hide global variables for building tag in
  # %Template::PSP::tagdata

  $tagdata{body} = $attr->{body};
  if ($tagdata{body})
  {
    push(@attrs, "body");
  }
  $tagdata{global} = $attr->{global};
  $tagdata{name} = lc($attr->{name});
  $tagdata{oldpage} = $page;
  $page = \$tagdata{page};

  # For each new tag, create a Perl function 
  # which will be called when the start tag is 
  # encountered

  append_page('package', $package . ";\n");
  append_page("no strict 'refs';\n");
  append_page('sub', $tagdata{name}, "{\n");
  append_page('my ($attr) = @_;' . "\n");
  
  foreach my $item (@attrs)
  {
    append_page('my', "\$" . $item, "=", '$attr->{' . $item . "};\n");
  }

  append_page("#line $lineno $parsefile\n"); 

  # If the tag we are defining will have a body,
  # redirect the output from processing the body
  # to a Perl scalar ($body).  Create a Perl function
  # which will be called when the end tag is encountered

  if ($tagdata{body})
  {
    # save all variables
    append_page('push(@Template::PSP::attrs, $attr);' . "\n");