File Coverage

lib/HTML/Object/XPath/Number.pm
Criterion Covered Total %
statement 35 55 63.6
branch 1 16 6.2
condition 1 5 20.0
subroutine 12 22 54.5
pod 13 13 100.0
total 62 111 55.8


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/XPath/Number.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/05
7             ## Modified 2022/09/18
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::Number;
15             BEGIN
16             {
17 8     8   56 use strict;
  8         17  
  8         308  
18 8     8   40 use warnings;
  8         31  
  8         243  
19 8     8   39 use parent qw( Module::Generic );
  8         11  
  8         65  
20 8     8   596 use vars qw( $TRUE $FALSE $BASE_CLASS $DEBUG $VERSION );
  8         18  
  8         549  
21 8     8   54 use HTML::Object::XPath::Boolean;
  8         16  
  8         603  
22 8     8   56 our $TRUE = HTML::Object::XPath::Boolean->True;
23 8         31 our $FALSE = HTML::Object::XPath::Boolean->False;
24 8         15 our $BASE_CLASS = 'HTML::Object::XPath';
25 8         17 our $DEBUG = 0;
26 8         360 our $VERSION = 'v0.2.0';
27             };
28              
29 8     8   52 use strict;
  8         13  
  8         190  
30 8     8   44 use warnings;
  8         12  
  8         4838  
31              
32             sub new
33             {
34 32     32 1 85 my $this = shift( @_ );
35 32         64 my $number = shift( @_ );
36 32 50       245 if( $number !~ /^[[:blank:]\h]*[+-]?(\d+(\.\d*)?|\.\d+)[[:blank:]\h]*$/ )
37             {
38 0         0 $number = undef;
39             }
40             else
41             {
42 32         169 $number =~ s/^[[:blank:]\h]*(.*)[[:blank:]\h]*$/$1/;
43             }
44 32   33     274 return( bless( \$number => ( ref( $this ) || $this ) ) );
45             }
46              
47             sub as_string
48             {
49 0     0 1 0 my $self = shift( @_ );
50 0 0       0 return( defined( $$self ) ? $$self : 'NaN' );
51             }
52              
53             sub as_xml
54             {
55 0     0 1 0 my $self = shift( @_ );
56 0 0       0 return( "<Number>" . ( defined( $$self ) ? $$self : 'NaN' ) . "</Number>\n" );
57             }
58              
59             sub cmp
60             {
61 0     0 1 0 my $self = shift( @_ );
62 0         0 my( $other, $swap ) = @_;
63 0 0       0 return( $swap ? $other <=> $$self : $$self <=> $other );
64             }
65              
66 46     46 1 101 sub evaluate { return( $_[0] ); }
67              
68 0 0   0 1 0 sub getAttributes { return( wantarray() ? () : [] ); }
69              
70 0 0   0 1 0 sub getChildNodes { return( wantarray() ? () : [] ); }
71              
72 0     0 1 0 sub new_literal { return( shift->_class_for( 'Literal' )->new( @_ ) ); }
73              
74 0     0 1 0 sub string_value { return $_[0]->value }
75              
76 0 0   0 1 0 sub to_boolean { return( ${$_[0]} ? $TRUE : $FALSE ); }
  0         0  
77              
78 0     0 1 0 sub to_literal { $_[0]->new_literal( $_[0]->as_string ); }
79              
80 16     16 1 36 sub to_number { $_[0]; }
81              
82 66     66 1 130 sub value { return( ${$_[0]} ); }
  66         414  
83              
84             sub _class_for
85             {
86 0     0     my( $self, $mod ) = @_;
87 0           eval( "require ${BASE_CLASS}\::${mod};" );
88 0 0         die( $@ ) if( $@ );
89             # ${"${BASE_CLASS}\::${mod}\::DEBUG"} = $DEBUG;
90 0   0       eval( "\$${BASE_CLASS}\::${mod}\::DEBUG = " . ( $DEBUG // 0 ) );
91 0           return( "${BASE_CLASS}::${mod}" );
92             }
93              
94             1;
95             # NOTE: POD
96             __END__
97              
98             =encoding utf-8
99              
100             =head1 NAME
101              
102             HTML::Object::XPath::Number - HTML Object XPath Number Class
103              
104             =head1 SYNOPSIS
105              
106             use HTML::Object::XPath::Number;
107             my $num = HTML::Object::XPath::Number->new ||
108             die( HTML::Object::XPath::Number->error, "\n" );
109              
110             =head1 VERSION
111              
112             v0.2.0
113              
114             =head1 DESCRIPTION
115              
116             This module holds simple numeric values. It doesn't support -0, +/- Infinity, or NaN, as the XPath spec says it should.
117              
118             =head1 METHODS
119              
120             =head2 new
121              
122             Provided with a C<number> and this creates a new L<HTML::Object::XPath::Number> object, with the value in C<number>. Does some
123             rudimentary numeric checking on C<number> to ensure it actually is a number.
124              
125             =head2 as_string
126              
127             Returns a string representation of the number, or C<NaN> is undefined.
128              
129             =head2 as_xml
130              
131             Same as L</as_string>, but in xml format.
132              
133             =head2 cmp
134              
135             Returns the equivalent of perl's own L<perlop/cmp> operation.
136              
137             =head2 evaluate
138              
139             Returns the current object.
140              
141             =head2 getAttributes
142              
143             Returns an empty array reference in scalar context and an empty list in list context.
144              
145             =head2 getChildNodes
146              
147             Returns an empty array reference in scalar context and an empty list in list context.
148              
149             =head2 new_literal
150              
151             Returns a new L<HTML::Object::XPath::Literal> object, passing it whatever arguments was provided.
152              
153             =head2 string_value
154              
155             Returns the value of the current object by calling L</value>
156              
157             =head2 to_boolean
158              
159             Returns true if the current object has a L<true|HTML::Object::XPath::Boolean> value, or L<false|HTML::Object::XPath::Boolean> otherwise.
160              
161             =head2 to_literal
162              
163             Returns a new L<HTML::Object::XPath::Litteral> object of the stringification of the current object.
164              
165             =head2 to_number
166              
167             Returns the current object.
168              
169             =head2 value
170              
171             This returns the numeric value held. This is also the method used to return the value from strinfgification.
172              
173             =head1 AUTHOR
174              
175             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
176              
177             =head1 SEE ALSO
178              
179             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>
180              
181             =head1 COPYRIGHT & LICENSE
182              
183             Copyright(c) 2021 DEGUEST Pte. Ltd.
184              
185             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
186              
187             =cut