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 under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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 our $VERSION = 3.07.00.049;
  36
  37
  38 sub new {
  39     my $this = shift;
  40     my $class = ref($this) || $this;
  41     my $self = {};
  42     bless $self, $class;
  43     ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
  44     return $self;
  45 }
  46
  47 sub string {
  48     my $this = shift;
  49     return $this->{'_string'}
  50 }
  51
  52 sub type {
  53     my $this = shift;
  54     return $this->{'_type'}
  55 }
  56
  57 sub pathname {
  58     my $this = shift;
  59     return $this->{'_path'}
  60 }
  61
  62 sub line_number {
  63     my $this = shift;
  64     return $this->{'_lc'}
  65 }
  66
  67 sub attributes {
  68     my $this = shift;
  69     return $this->{'_attr'};
  70 }
  71
  72 sub set_attributes {
  73     my $this = shift;
  74     $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
  75     return $this;
  76 }
  77
  78 # only meaningful for TEXT_PARAMETRIZED tokens
  79 sub children {
  80     my $this = shift;
  81     return $this->{'_kids'};
  82 }
  83
  84 # only meaningful for TEXT_PARAMETRIZED tokens
  85 sub set_children {
  86     my $this = shift;
  87     $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
  88     return $this;
  89 }
  90
  91 # only meaningful for TEXT_PARAMETRIZED tokens
  92 # FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
  93 sub parameters_and_fields {
  94     my $this = shift;
  95     return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
  96                 ($_->type == C4::TmplTokenType::TAG
  97                         && $_->string =~ /^<input\b/is)? $_: ()}
  98             @{$this->{'_kids'}};
  99 }
 100
 101 # only meaningful for TEXT_PARAMETRIZED tokens
 102 sub anchors {
 103     my $this = shift;
 104     return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
 105 }
 106
 107 # only meaningful for TEXT_PARAMETRIZED tokens
 108 sub form {
 109     my $this = shift;
 110     return $this->{'_form'};
 111 }
 112
 113 # only meaningful for TEXT_PARAMETRIZED tokens
 114 sub set_form {
 115     my $this = shift;
 116     $this->{'_form'} = $_[0];
 117     return $this;
 118 }
 119
 120 sub has_js_data {
 121     my $this = shift;
 122     return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
 123 }
 124
 125 sub js_data {
 126     my $this = shift;
 127     return $this->{'_js_data'};
 128 }
 129
 130 sub set_js_data {
 131     my $this = shift;
 132     $this->{'_js_data'} = $_[0];
 133     return $this;
 134 }
 135
 136 # predefined tests
 137
 138 sub tag_p {
 139     my $this = shift;
 140     return $this->type == C4::TmplTokenType::TAG;
 141 }
 142
 143 sub cdata_p {
 144     my $this = shift;
 145     return $this->type == C4::TmplTokenType::CDATA;
 146 }
 147
 148 sub text_p {
 149     my $this = shift;
 150     return $this->type == C4::TmplTokenType::TEXT;
 151 }
 152
 153 sub text_parametrized_p {
 154     my $this = shift;
 155     return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
 156 }
 157
 158 sub directive_p {
 159     my $this = shift;
 160     return $this->type == C4::TmplTokenType::DIRECTIVE;
 161 }
 162
 163 ###############################################################################
 164
 165 1;