C4/TmplToken.pm

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