view release on metacpan or  search on metacpan

lib/ASP4/PageParser.pm  view on Meta::CPAN

  my $code = <<"CODE";
package $s->{package};

use strict;
use warnings 'all';
no warnings 'redefine';
use base '$s->{base_class}';
use vars __PACKAGE__->VARS;
use ASP4::PageLoader;

sub _init {
  my (\$s) = \@_;
  \$s->{script_name} = q<$s->{script_name}>;
  \$s->{filename}    = q<$s->{filename}>;
  \$s->{base_class}  = q<$s->{base_class}>;
  \$s->{compiled_as} = q<$s->{compiled_as}>;
  \$s->{package}     = q<$s->{package}>;
@{[
  $s->{masterpage} ?
    "  \$s->{masterpage}  = ASP4::PageLoader->load( script_name => q<$s->{masterpage}->{script_name}> );"
    : ""
]}
  return;
}

CODE

  unless( $s->{masterpage} )
  {
    $code .= <<"CODE";
sub run {
use warnings 'all';
my (\$__self, \$__context) = \@_;
\$__self->init_asp_objects(\$__context) unless defined(\$Response);
#line 1
$$ref
}
CODE
  }# end unless()
  
  foreach( reverse ( @content_tags, @placeholder_tags ) )
  {
    $code .= <<"SUB";

sub $_->{id} {
my (\$__self, \$__context) = \@_;
if( \$__context->did_end() ){\$__context->response->Clear(); return; }
#line $_->{line}
$_->{contents}
}# end $_->{id}

SUB
  }# end foreach()
  
  $code .= "\n1;# return true:\n";
  
  open my $ofh, '>', $s->{saved_to}
    or die "Cannot open '$s->{saved_to}' for writing: $!";
  print $ofh $code;
  close($ofh);
  chmod(0766, $s->{saved_to});

  my $config = ASP4::ConfigLoader->load();
  $config->load_class( $s->{package} );
  return $s->{package}->new();
}# end parse()


sub _tag_line_number
{
  my ($s, $tag) = @_;
  
  my $number = 1;
  for( split /\r?\n/, ${ $s->source_code } )
  {
    if( m/\Q$tag\E/s )
    {
      return $number;
    }# end if()
    $number++;
  }# end for()
  
  return;
}# end _tag_line_number()


sub _parse_include_tags
{
  my ($s) = @_;
  
  my $ref = $s->source_code;
  
  $$ref =~ s{
    \<\!\-\-\s*\#include\s+virtual\="(.*?)"\s*\-\-\>
  }{~); \$Response->Include(\$Server->MapPath("$1")); \$Response->Write(q~}xsg;
}# end _parse_include_tags()


sub _parse_scriptlet_tags
{
  my ($s) = @_;
  
  my $ref = $s->source_code;
  
  # Parse <%= %> items:
  $$ref =~ s{
    <%\=(.*?)%>
  }{
    '~);$Response->Write(' . $1 . ');$Response->Write(q~'
  }xgse;
  
  # TODO: Add <%& HTMLEncode($str) %>
  
  # TODO: Add <%% URLEncode($str) %>

  $$ref =~ s{
    <%\s*([^\@\#\=]?.*?)%>
  }{
    my $txt = $1; '~);' . $txt . ';$Response->Write(q~'
  }gxse;