File Coverage

lib/HTML/Object/XPath/Literal.pm
Criterion Covered Total %
statement 40 63 63.4
branch 0 8 0.0
condition 1 5 20.0
subroutine 16 25 64.0
pod 15 15 100.0
total 72 116 62.0


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/XPath/Literal.pm
3             ## Version v0.2.1
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/05
7             ## Modified 2022/11/11
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::XPath::Literal;
15             BEGIN
16             {
17 8     8   50 use strict;
  8         14  
  8         232  
18 8     8   37 use warnings;
  8         17  
  8         212  
19 8     8   39 use parent qw( Module::Generic );
  8         25  
  8         39  
20 8     8   493 use vars qw( $TRUE $FALSE $BASE_CLASS $DEBUG $VERSION );
  8         28  
  8         514  
21 8     8   47 use HTML::Object::XPath::Boolean;
  8         16  
  8         715  
22 8     8   618 our $TRUE = HTML::Object::XPath::Boolean->True;
23 8         32 our $FALSE = HTML::Object::XPath::Boolean->False;
24 8         20 our $BASE_CLASS = 'HTML::Object::XPath';
25 8         13 our $DEBUG = 0;
26             use overload (
27 8         73 '""' => \&value,
28             'cmp' => \&cmp
29 8     8   57 );
  8         26  
30 8         196 our $VERSION = 'v0.2.1';
31             };
32              
33 8     8   47 use strict;
  8         15  
  8         166  
34 8     8   40 use warnings;
  8         28  
  8         4589  
35              
36             sub new
37             {
38 51     51 1 137 my $this = shift( @_ );
39 51         146 my $str = shift( @_ );
40 51   33     474 return( bless( \$str => ( ref( $this ) || $this ) ) );
41             }
42              
43             sub as_string
44             {
45 0     0 1 0 my $self = shift( @_ );
46 0         0 my $string = $$self;
47 0         0 $string =~ s/'/&apos;/g;
48 0         0 return( "'$string'" );
49             }
50              
51             sub as_xml
52             {
53 0     0 1 0 my $self = shift( @_ );
54 0         0 my $string = $$self;
55 0         0 return( "<Literal>$string</Literal>\n" );
56             }
57              
58             sub cmp
59             {
60 0     0 1 0 my $self = shift( @_ );
61 0         0 my( $cmp, $swap ) = @_;
62 0 0       0 return( $swap ? $cmp cmp $$self : $$self cmp $cmp );
63             }
64              
65             sub evaluate
66             {
67 164     164 1 285 my $self = shift( @_ );
68 164         334 return( $self );
69             }
70              
71 1     1 1 11 sub getChildNodes { die( "cannot get child nodes of a literal" ); }
72              
73 1     1 1 27 sub getAttributes { die( "cannot get attributes of a literal" ); }
74              
75 1     1 1 10 sub getParentNode { die( "cannot get parent node of a literal" ); }
76              
77 0     0 1 0 sub new_number { return( shift->_class_for( 'Number' )->new( @_ ) ); }
78              
79 93     93 1 285 sub string_value { return( $_[0]->value ); }
80              
81             sub to_boolean
82             {
83 0     0 1 0 my $self = shift( @_ );
84 0 0       0 return( ( length( $$self ) > 0 ) ? $TRUE : $FALSE );
85             }
86              
87 0     0 1 0 sub to_literal { return( $_[0] ); }
88              
89 0     0 1 0 sub to_number { return( $_[0]->new_number( $_[0]->value ) ); }
90              
91             sub value
92             {
93 164     164 1 9393 my $self = shift( @_ );
94 164         935 return( $$self );
95             }
96              
97             sub value_as_number
98             {
99 0     0 1   my $self = shift( @_ );
100 0 0         warnings::warn( "numifying '" . $$self . "' to '" . +$$self . "'\n" ) if( warnings::enabled( $BASE_CLASS ) );
101 0           return( +$$self );
102             }
103              
104             sub _class_for
105             {
106 0     0     my( $self, $mod ) = @_;
107 0           eval( "require ${BASE_CLASS}\::${mod};" );
108 0 0         die( $@ ) if( $@ );
109             # ${"${BASE_CLASS}\::${mod}\::DEBUG"} = $DEBUG;
110 0   0       eval( "\$${BASE_CLASS}\::${mod}\::DEBUG = " . ( $DEBUG // 0 ) );
111 0           return( "${BASE_CLASS}::${mod}" );
112             }
113              
114             1;
115             # NOTE: POD
116             __END__
117              
118             =encoding utf-8
119              
120             =head1 NAME
121              
122             HTML::Object::XPath::Literal - HTML Object XPath Literal
123              
124             =head1 SYNOPSIS
125              
126             use HTML::Object::XPath::Literal;
127             my $this = HTML::Object::XPath::Literal->new ||
128             die( HTML::Object::XPath::Literal->error, "\n" );
129              
130             =head1 VERSION
131              
132             v0.2.1
133              
134             =head1 DESCRIPTION
135              
136             This module implements the equivalent of a string in XPath parlance.
137              
138             =head1 METHODS
139              
140             =head2 new
141              
142             Provided with a C<string> and this creates a new L<HTML::Object::XPath::Literal> object with the value providedd. Note that &quot; and
143             &apos; will be converted to " and ' respectively. That is not part of the XPath specification, but I consider it useful. Note though that you have to go to extraordinary lengths in an XML template file (be it XSLT or whatever) to
144             make use of this:
145              
146             <input type="text" value="&quot;I am feeling &amp;quot;perplex&amp;quot;&quot;" />
147              
148             Which produces a Literal of:
149              
150             I am feeling "perplex"
151              
152             =head2 as_string
153              
154             Returns a string representation of the literal.
155              
156             =head2 as_xml
157              
158             Returns a string representation of the literal as xml.
159              
160             =head2 cmp
161              
162             This is a method used for overload. Provided with another object or string and this will return the same value as L<perlop/cmp>, that is it "returns -1, 0, or 1 depending on whether the left argument is stringwise less than, equal to, or greater than the right argument".
163              
164             =head2 evaluate
165              
166             It returns the current object.
167              
168             =head2 getChildNodes
169              
170             This raises an exception, as it cannot be used.
171              
172             =head2 getAttributes
173              
174             This raises an exception, as it cannot be used.
175              
176             =head2 getParentNode
177              
178             This raises an exception, as it cannot be used.
179              
180             =head2 new_number
181              
182             Returns a new L<number object|HTML::Object::XPath::Number> based on the value provided.
183              
184             =head2 string_value
185              
186             Returns the value of the literal as returned by L</value>
187              
188             =head2 to_boolean
189              
190             Returns L<true|HTML::Object::XPath::Boolean> if the literal value is true, or L<false|HTML::Object::XPath::Boolean> otherwise.
191              
192             =head2 to_literal
193              
194             Returns the current object.
195              
196             =head2 to_number
197              
198             Returns a new L<number object|HTML::Object::XPath::Number> from the value of the literal.
199              
200             =head2 value
201              
202             This returns the literal string value. It is also called upon stringification.
203              
204             =head2 value_as_number
205              
206             Returns the literal value as a number (not a number object), but forcing perl to treat it as a number, i.e. prepending it with a plus sign.
207              
208             =head1 AUTHOR
209              
210             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
211              
212             =head1 SEE ALSO
213              
214             L<HTML::Object::XPath>, L<HTML::Object::XPath::Boolean>, L<HTML::Object::XPath::Expr>, L<HTML::Object::XPath::Function>, L<HTML::Object::XPath::Literal>, L<HTML::Object::XPath::LocationPath>, L<HTML::Object::XPath::NodeSet>, L<HTML::Object::XPath::Number>, L<HTML::Object::XPath::Root>, L<HTML::Object::XPath::Step>, L<HTML::Object::XPath::Variable>
215              
216             =head1 COPYRIGHT & LICENSE
217              
218             Copyright(c) 2021 DEGUEST Pte. Ltd.
219              
220             All rights reserved
221              
222             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
223              
224             =cut