misc/translator/TTParser.pm

   1 #!/usr/bin/env perl
   2 #simple parser for HTML with Template Toolkit directives. Tokens are put into @tokens and are accesible via next_token and peep_token
   3 package TTParser;
   4 use base qw(HTML::Parser);
   5 use TmplToken;
   6 use strict;
   7 use warnings;
   8
   9 #seems to be handled post tokenizer
  10 ##hash where key is tag we are interested in and the value is a hash of the attributes we want
  11 #my %interesting_tags = (
  12 #    img => { alt => 1 },
  13 #);
  14
  15 #tokens found so far (used like a stack)
  16 my ( @tokens );
  17
  18 #shiftnext token or undef
  19 sub next_token{
  20     return shift @tokens;
  21 }
  22
  23 #unshift token back on @tokens
  24 sub unshift_token{
  25     my $self = shift;
  26     unshift @tokens, shift;
  27 }
  28
  29 #have a peep at next token
  30 sub peep_token{
  31     return $tokens[0];
  32 }
  33
  34 #wrapper for parse
  35 #please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
  36 #signature build_tokens( self, filename)
  37 sub build_tokens{
  38     my ($self, $filename) = @_;
  39     $self->{filename} = $filename;
  40     $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
  41     $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
  42     $self->handler(end => "end", "self, line, tag, text"); #signature is end( self, linenumber, tagename, origional text )
  43     $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a TmplTokenType::CDATA
  44     $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
  45     $self->parse_file($filename);
  46     return $self;
  47 }
  48
  49 #handle parsing of text
  50 sub text{
  51     my $self = shift;
  52     my $line = shift;
  53     my $work = shift; # original text
  54     my $is_cdata = shift;
  55     while($work){
  56 #        return if $work =~ m/^\s*$/;
  57         # if there is a template_toolkit tag
  58         if( $work =~ m/\[%.*?\]/ ){
  59             #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
  60             if( $` ){
  61                 my $t = TmplToken->new( $`, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
  62                 push @tokens, $t;
  63             }
  64
  65             #the match itself is a DIRECTIVE $&
  66             my $t = TmplToken->new( $&, TmplTokenType::DIRECTIVE, $line, $self->{filename} );
  67             push @tokens, $t;
  68
  69             #put work still to do back into work
  70             $work = $' ? $' : 0;
  71         } else {
  72             #If there is some left over work, treat it as text token
  73             my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
  74             push @tokens, $t;
  75             last;
  76         }
  77     }
  78 }
  79
  80 #handle opening html tags
  81 sub start{
  82     my $self = shift;
  83     my $line = shift;
  84     my $tag = shift;
  85     my $hash = shift; #hash of attr/value pairs
  86     my $text = shift; #origional text
  87     #return if ! $interesting_tags{$tag};
  88     # was $hash->{$key}
  89     # print "#### " . $self->{filename}  . " " . $tag . "####\n";
  90     my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename});
  91     my %attr;
  92     # tags seem to be uses in an 'interesting' way elsewhere..
  93     for my $key( %$hash ) {
  94         next unless defined $hash->{$key};
  95         $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
  96     }
  97     $t->set_attributes( \%attr );
  98     push @tokens, $t;
  99 }
 100
 101 #handle closing html tags
 102 sub end{
 103   my $self = shift;
 104   my $line = shift;
 105   my $tag = shift;
 106   my $text = shift;
 107   # what format should this be in?
 108   my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename} );
 109 }
 110
 111 1;