File Coverage

File:C4/TmplToken.pm
Coverage:70.6%

linestmtbrancondsubtimecode
1package C4::TmplToken;
2
3
4
4
4
43716
102
124
use strict;
4#use warnings; FIXME - Bug 2505
5
4
4
4
434
46
242
use C4::TmplTokenType;
6require Exporter;
7
8
4
4
4
54
38
4751
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
9
10###############################################################################
11
12 - 20
=head1 NAME

TmplToken.pm - Object representing a scanner token for .tmpl files

=head1 DESCRIPTION

This is a class representing a token scanned from an HTML::Template .tmpl file.

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