view release on metacpan or  search on metacpan

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

  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;
  
  $$ref =~ s/(\$Response\->End)/return $1/gs;
  
  $$ref = ';$Response->Write(q~' . $$ref . '~);';
  
  # Now do the final ~ substitution:
  $$ref =~ s{(\(q~)(.*?)(~\);)}{
    my $pre = $1;
    my $post = $3;
    (my $txt = $2) =~ s/~/\\~/g;
    "$pre$txt$post"
  }xsge;
}# end _parse_scriptlet_tags()


sub _get_directives
{
  my ($s) = @_;
  
  my $ref = $s->source_code;
  my %directives = ( );
  while( my ($tag, $directive, $attr_str) = $$ref =~ m/(<%@\s*(.*?)\s+(.*?)\s*%>)/ )
  {
    my $attrs = $s->_parse_tag_attrs( $attr_str );
    $$ref =~ s/\Q$tag\E//;
    $directives{ lc($directive) } = $attrs;
  }# end while()
  
  $directives{page} ||= { };
  
  return \%directives;
}# end _get_directives()


sub _parse_tag_attrs
{
  my ($s, $str) = @_;
  
  my $attr = { };
  while( $str =~ m@([^\s\=\"\']+)(\s*=\s*(?:(")(.*?)"|(')(.*?)'|([^'"\s=]+)['"]*))?@sg ) #@
  {
    my $key = $1;
    my $test = $2;
    my $val  = ( $3 ? $4 : ( $5 ? $6 : $7 ));
    if( $test )
    {
      $attr->{ lc($key) } = $val;
    }
    else
    {
      $attr->{ lc($key) } = $key;
    }# end if()
  }# end while()
  
  return $attr;
}# end _parse_tag_attrs()


sub DESTROY
{
  my $s = shift;
  undef(%$s);
}# end DESTROY()

1;# return true: