C4/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 C4::TTParser;
   4 use base qw(HTML::Parser);
   5 use C4::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     unshift @tokens, shift;
  26 }
  27
  28 #have a peep at next token
  29 sub peep_token{
  30     return $tokens[0];
  31 }
  32
  33 #wrapper for parse
  34 #please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
  35 #signature build_tokens( self, filename)
  36 sub build_tokens{
  37     my ($self, $filename) = @_;
  38     $self->{filename} = $filename;
  39     $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
  40     $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
  41     $self->handler(end => "end", "self, line, tag, attr, text"); #signature is end( self, linenumber, tagename, origional text )
  42     $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
  43     $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
  44 #    $self->handler(default => "default", "self, line, text, is_cdata"); # anything else
  45     $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a C4::TmplTokenType::CDATA
  46     $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
  47     $self->parse_file($filename);
  48     return $self;
  49 }
  50
  51 #handle parsing of text
  52 sub text{
  53     my $self = shift;
  54     my $line = shift;
  55     my $work = shift; # original text
  56     my $is_cdata = shift;
  57     while($work){
  58         # if there is a template_toolkit tag
  59         if( $work =~ m/\[%.*?\]/ ){
  60             #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
  61             if( $` ){
  62                 my $t = C4::TmplToken->new( $`, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
  63                 push @tokens, $t;
  64             }
  65
  66             #the match itself is a DIRECTIVE $&
  67             my $t = C4::TmplToken->new( $&, C4::TmplTokenType::DIRECTIVE, $line, $self->{filename} );
  68             push @tokens, $t;
  69
  70             # put work still to do back into work
  71             $work = $' ? $' : 0;
  72         } else {
  73             # If there is some left over work, treat it as text token
  74             my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
  75
  76             push @tokens, $t;
  77             last;
  78         }
  79     }
  80 }
  81
  82 sub declaration {
  83     my $self = shift;
  84     my $line = shift;
  85     my $work = shift; #original text
  86     my $is_cdata = shift;
  87     my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
  88     push @tokens, $t;
  89 }
  90
  91 sub comment {
  92     my $self = shift;
  93     my $line = shift;
  94     my $work = shift; #original text
  95     my $is_cdata = shift;
  96     my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
  97     push @tokens, $t;
  98 }
  99
 100 sub default {
 101     my $self = shift;
 102     my $line = shift;
 103     my $work = shift; #original text
 104     my $is_cdata = shift;
 105     my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
 106     push @tokens, $t;
 107 }
 108
 109
 110 #handle opening html tags
 111 sub start{
 112     my $self = shift;
 113     my $line = shift;
 114     my $tag = shift;
 115     my $hash = shift; #hash of attr/value pairs
 116     my $text = shift; #origional text
 117     my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename});
 118     my %attr;
 119     # tags seem to be uses in an 'interesting' way elsewhere..
 120     for my $key( %$hash ) {
 121         next unless defined $hash->{$key};
 122         if ($key eq "/"){
 123             $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 1 ];
 124             }
 125         else {
 126         $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
 127             }
 128     }
 129     $t->set_attributes( \%attr );
 130     push @tokens, $t;
 131 }
 132
 133 #handle closing html tags
 134 sub end{
 135     my $self = shift;
 136     my $line = shift;
 137     my $tag = shift;
 138     my $hash = shift;
 139     my $text = shift;
 140     # what format should this be in?
 141     my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename} );
 142     my %attr;
 143     # tags seem to be uses in an 'interesting' way elsewhere..
 144     for my $key( %$hash ) {
 145         next unless defined $hash->{$key};
 146         $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
 147     }
 148     $t->set_attributes( \%attr );
 149     push @tokens, $t;
 150 }
 151
 152 1;