view release on metacpan or  search on metacpan

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

  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
  my $cgi = CGI::Minimal->new();
#  %QUERY = map { my $x = [$cgi->param($_)]; $_ => scalar(@{$x}) > 1 ? \@{$x} : $$x[0] } ($cgi->param);
  # canonically-correct (and possibly temporary) expansion
  %QUERY = ();
  my @params = $cgi->param();
  foreach my $p (@params)
  {
    my @items = $cgi->param($p);
    if (scalar(@items) > 1)
    {
      $QUERY{$p} = \@items;
    }
    else
    {
      $QUERY{$p} = $items[0];
    }
  }

  
  # process cookies for this request
  my $cgi = CGI::Minimal->new();
  %COOKIE = ();
  my @cookies = split(/; ?/,$ENV{HTTP_COOKIE});
  foreach my $item (@cookies) 
  {
    my ($name, $value) = split('=', $item);
    $COOKIE{$name} = $cgi->url_decode($value);
  }
  
  # leave authorization for another time
#  if ($ENV->{HTTP_AUTHORIZATION}) 
#  {
#    my @list = split(/ /, $ENV{HTTP_AUTHORIZATION});
#    if (lc($list[0]) eq "basic") 
#    {
#      my $encoded = pop(@list);
#      my $decoded = decode_base64($encoded);
#  
#      ($AUTH->{username}, $AUTH->{password}) = split(/:/, $decoded);
#    }
#  }
  
  return 1;
}

#########################################
# Template::PSP::Parser
# used to process psp pages using HTML::Parser

sub start
{
  my $tagname = lc(shift);
  my $attr = shift;
  my $text = shift;

  no strict 'refs';

  default($text);

  if ($escapeflag || $tagname eq $tagdata{name} || $perlflag)
  {
    text($space . $text);
    $space = "";
    return;
  }

  # start tag
  if ($tags{$tagname})
  {
    no strict 'refs';
    &{$tagname}($attr);
    return;
  }

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

  if ($fn)
  {
    append_page('&' . $fn . '({');
    
    foreach my $item (keys %{$attr})
    {
      my $s;
      my $s2;
      my $arg = ${$attr}{$item};
      $s2 = substr($arg,0,1);
      $s = substr($arg,1,1);
      
      if (($s2 eq '$') ||
          (($s2 eq "\\") &&
           ($s eq '@') ||
           ($s eq '%') ||
           ($s eq '&')
          )
         )
      {
        # don't quote because arg is a reference
        append_page("'$item'", '=>', $arg . ',');
      }