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