misc/translator/TmplToken.pm

   1 package TmplToken;
   2
   3 use strict;
   4 use TmplTokenType;
   5 require Exporter;
   6
   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
   8
   9 ###############################################################################
  10
  11 =head1 NAME
  12
  13 TmplToken.pm - Object representing a scanner token for .tmpl files
  14
  15 =head1 DESCRIPTION
  16
  17 This is a class representing a token scanned from an HTML::Template .tmpl file.
  18
  19 =cut
  20
  21 ###############################################################################
  22
  23 $VERSION = 0.01;
  24
  25 @ISA = qw(Exporter);
  26 @EXPORT_OK = qw();
  27
  28 ###############################################################################
  29
  30 sub new {
  31     my $this = shift;
  32     my $class = ref($this) || $this;
  33     my $self = {};
  34     bless $self, $class;
  35     ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
  36     return $self;
  37 }
  38
  39 sub string {
  40     my $this = shift;
  41     return $this->{'_string'}
  42 }
  43
  44 sub type {
  45     my $this = shift;
  46     return $this->{'_type'}
  47 }
  48
  49 sub pathname {
  50     my $this = shift;
  51     return $this->{'_path'}
  52 }
  53
  54 sub line_number {
  55     my $this = shift;
  56     return $this->{'_lc'}
  57 }
  58
  59 sub attributes {
  60     my $this = shift;
  61     return $this->{'_attr'};
  62 }
  63
  64 sub set_attributes {
  65     my $this = shift;
  66     $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
  67     return $this;
  68 }
  69
  70 # only meaningful for TEXT_PARAMETRIZED tokens
  71 sub children {
  72     my $this = shift;
  73     return $this->{'_kids'};
  74 }
  75
  76 # only meaningful for TEXT_PARAMETRIZED tokens
  77 sub set_children {
  78     my $this = shift;
  79     $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
  80     return $this;
  81 }
  82
  83 # only meaningful for TEXT_PARAMETRIZED tokens
  84 # FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
  85 sub parameters_and_fields {
  86     my $this = shift;
  87     return map { $_->type == TmplTokenType::DIRECTIVE? $_:
  88                 ($_->type == TmplTokenType::TAG
  89                         && $_->string =~ /^<input\b/is)? $_: ()}
  90             @{$this->{'_kids'}};
  91 }
  92
  93 # only meaningful for TEXT_PARAMETRIZED tokens
  94 sub anchors {
  95     my $this = shift;
  96     return map { $_->type == TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
  97 }
  98
  99 # only meaningful for TEXT_PARAMETRIZED tokens
 100 sub form {
 101     my $this = shift;
 102     return $this->{'_form'};
 103 }
 104
 105 # only meaningful for TEXT_PARAMETRIZED tokens
 106 sub set_form {
 107     my $this = shift;
 108     $this->{'_form'} = $_[0];
 109     return $this;
 110 }
 111
 112 sub has_js_data {
 113     my $this = shift;
 114     return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
 115 }
 116
 117 sub js_data {
 118     my $this = shift;
 119     return $this->{'_js_data'};
 120 }
 121
 122 sub set_js_data {
 123     my $this = shift;
 124     $this->{'_js_data'} = $_[0];
 125     return $this;
 126 }
 127
 128 # predefined tests
 129
 130 sub tag_p {
 131     my $this = shift;
 132     return $this->type == TmplTokenType::TAG;
 133 }
 134
 135 sub cdata_p {
 136     my $this = shift;
 137     return $this->type == TmplTokenType::CDATA;
 138 }
 139
 140 sub text_p {
 141     my $this = shift;
 142     return $this->type == TmplTokenType::TEXT;
 143 }
 144
 145 sub text_parametrized_p {
 146     my $this = shift;
 147     return $this->type == TmplTokenType::TEXT_PARAMETRIZED;
 148 }
 149
 150 sub directive_p {
 151     my $this = shift;
 152     return $this->type == TmplTokenType::DIRECTIVE;
 153 }
 154
 155 ###############################################################################
 156
 157 1;