File Coverage

File:C4/TmplToken.pm
Coverage:70.6%

linestmtbrancondsubtimecode
1package C4::TmplToken;
2
3
2
2
2
732
12
55
use strict;
4#use warnings; FIXME - Bug 2505
5
2
2
2
216
2
124
use C4::TmplTokenType;
6require Exporter;
7
8
2
2
2
10
3
2115
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
1
28
    my $this = shift;
33
1
32
    my $class = ref($this) || $this;
34
1
24
    my $self = {};
35
1
31
    bless $self, $class;
36
1
72
    ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
37
1
28
    return $self;
38}
39
40sub string {
41
1
8
    my $this = shift;
42
1
14
    return $this->{'_string'}
43}
44
45sub type {
46
6
44
    my $this = shift;
47
6
81
    return $this->{'_type'}
48}
49
50sub pathname {
51
1
2
    my $this = shift;
52
1
10
    return $this->{'_path'}
53}
54
55sub line_number {
56
1
2
    my $this = shift;
57
1
7
    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
1
2
    my $this = shift;
74
1
7
    return $this->{'_kids'};
75}
76
77# only meaningful for TEXT_PARAMETRIZED tokens
78sub set_children {
79
1
0
    my $this = shift;
80
1
0
    $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
81
1
0
    return $this;
82}
83
84# only meaningful for TEXT_PARAMETRIZED tokens
85# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
86sub parameters_and_fields {
87
1
2
    my $this = shift;
88
0
1
0
8
    return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
89                ($_->type == C4::TmplTokenType::TAG
90                        && $_->string =~ /^<input\b/is)? $_: ()}
91
1
2
            @{$this->{'_kids'}};
92}
93
94# only meaningful for TEXT_PARAMETRIZED tokens
95sub anchors {
96
1
3
    my $this = shift;
97
1
0
1
2
0
7
    return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
98}
99
100# only meaningful for TEXT_PARAMETRIZED tokens
101sub form {
102
1
2
    my $this = shift;
103
1
6
    return $this->{'_form'};
104}
105
106# only meaningful for TEXT_PARAMETRIZED tokens
107sub set_form {
108
1
1
    my $this = shift;
109
1
3
    $this->{'_form'} = $_[0];
110
1
6
    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
1
2
    my $this = shift;
120
1
6
    return $this->{'_js_data'};
121}
122
123sub set_js_data {
124
1
2
    my $this = shift;
125
1
2
    $this->{'_js_data'} = $_[0];
126
1
6
    return $this;
127}
128
129# predefined tests
130
131sub tag_p {
132
1
2
    my $this = shift;
133
1
3
    return $this->type == C4::TmplTokenType::TAG;
134}
135
136sub cdata_p {
137
1
21
    my $this = shift;
138
1
20
    return $this->type == C4::TmplTokenType::CDATA;
139}
140
141sub text_p {
142
1
2
    my $this = shift;
143
1
3
    return $this->type == C4::TmplTokenType::TEXT;
144}
145
146sub text_parametrized_p {
147
1
15
    my $this = shift;
148
1
14
    return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
149}
150
151sub directive_p {
152
1
10
    my $this = shift;
153
1
9
    return $this->type == C4::TmplTokenType::DIRECTIVE;
154}
155
156###############################################################################
157
1581;