C4/TmplToken.pm

   1 package C4::TmplToken;
   2
   3 # Copyright Tamil 2011
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20
  21 use strict;
  22 use warnings;
  23 use C4::TmplTokenType;
  24
  25 =head1 NAME
  26
  27 TmplToken.pm - Object representing a scanner token for .tmpl files
  28
  29 =head1 DESCRIPTION
  30
  31 This is a class representing a token scanned from an HTML::Template .tmpl file.
  32
  33 =cut
  34
  35
  36
  37 sub new {
  38     my $this = shift;
  39     my $class = ref($this) || $this;
  40     my $self = {};
  41     bless $self, $class;
  42     ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
  43     return $self;
  44 }
  45
  46 sub string {
  47     my $this = shift;
  48     return $this->{'_string'}
  49 }
  50
  51 sub type {
  52     my $this = shift;
  53     return $this->{'_type'}
  54 }
  55
  56 sub pathname {
  57     my $this = shift;
  58     return $this->{'_path'}
  59 }
  60
  61 sub line_number {
  62     my $this = shift;
  63     return $this->{'_lc'}
  64 }
  65
  66 sub attributes {
  67     my $this = shift;
  68     return $this->{'_attr'};
  69 }
  70
  71 sub set_attributes {
  72     my $this = shift;
  73     $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
  74     return $this;
  75 }
  76
  77 # only meaningful for TEXT_PARAMETRIZED tokens
  78 sub children {
  79     my $this = shift;
  80     return $this->{'_kids'};
  81 }
  82
  83 # only meaningful for TEXT_PARAMETRIZED tokens
  84 sub set_children {
  85     my $this = shift;
  86     $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
  87     return $this;
  88 }
  89
  90 # only meaningful for TEXT_PARAMETRIZED tokens
  91 # FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
  92 sub parameters_and_fields {
  93     my $this = shift;
  94     return map { $_->type == C4::TmplTokenType::DIRECTIVE() ? $_:
  95                 ($_->type == C4::TmplTokenType::TAG
  96                         && $_->string =~ /^<input\b/is)? $_: ()}
  97             @{$this->{'_kids'}};
  98 }
  99
 100 # only meaningful for TEXT_PARAMETRIZED tokens
 101 sub anchors {
 102     my $this = shift;
 103     return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
 104 }
 105
 106 # only meaningful for TEXT_PARAMETRIZED tokens
 107 sub form {
 108     my $this = shift;
 109     return $this->{'_form'};
 110 }
 111
 112 # only meaningful for TEXT_PARAMETRIZED tokens
 113 sub set_form {
 114     my $this = shift;
 115     $this->{'_form'} = $_[0];
 116     return $this;
 117 }
 118
 119 sub has_js_data {
 120     my $this = shift;
 121     return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
 122 }
 123
 124 sub js_data {
 125     my $this = shift;
 126     return $this->{'_js_data'};
 127 }
 128
 129 sub set_js_data {
 130     my $this = shift;
 131     $this->{'_js_data'} = $_[0];
 132     return $this;
 133 }
 134
 135 # predefined tests
 136
 137 sub tag_p {
 138     my $this = shift;
 139     return $this->type == C4::TmplTokenType::TAG;
 140 }
 141
 142 sub cdata_p {
 143     my $this = shift;
 144     return $this->type == C4::TmplTokenType::CDATA;
 145 }
 146
 147 sub text_p {
 148     my $this = shift;
 149     return $this->type == C4::TmplTokenType::TEXT;
 150 }
 151
 152 sub text_parametrized_p {
 153     my $this = shift;
 154     return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
 155 }
 156
 157 sub directive_p {
 158     my $this = shift;
 159     return $this->type == C4::TmplTokenType::DIRECTIVE;
 160 }
 161
 162 ###############################################################################
 163
 164 1;