File Coverage

blib/lib/HTML/Parser/Simple/Attributes.pm
Criterion Covered Total %
statement 31 47 65.9
branch 3 14 21.4
condition 4 7 57.1
subroutine 5 7 71.4
pod 4 4 100.0
total 47 79 59.4


line stmt bran cond sub pod time code
1             package HTML::Parser::Simple::Attributes;
2              
3 3     3   15905 use strict;
  3         4  
  3         102  
4 3     3   13 use warnings;
  3         6  
  3         65  
5              
6 3     3   1423 use Moo;
  3         33349  
  3         12  
7              
8             has a_hashref =>
9             (
10             default => sub{return {} },
11             is => 'rw',
12             );
13              
14             has a_string =>
15             (
16             default => sub{return ''},
17             is => 'rw',
18             );
19              
20             has parsed =>
21             (
22             default => sub{return 0},
23             is => 'rw',
24             );
25              
26             our $VERSION = '2.02';
27              
28             # -----------------------------------------------
29              
30             sub get
31             {
32 0     0 1 0 my($self, $key) = @_;
33              
34 0 0       0 $self -> parse if ($self -> parsed == 0);
35              
36 0         0 my($attrs) = $self -> a_hashref;
37              
38 0 0       0 return $key ? $$attrs{$key} : $$attrs;
39              
40             } # End of get.
41              
42             # -----------------------------------------------
43              
44             sub hashref2string
45             {
46 21     21 1 18 my($self, $h) = @_;
47 21   50     29 $h ||= {};
48              
49 21         82 return '{' . join(', ', map{"$_ => $$h{$_}"} sort keys %$h) . '}';
  4         13  
50              
51             } # End of hashref2string.
52              
53             # -----------------------------------------------
54              
55             our(@quote) =
56             (
57             qr{^([a-zA-Z0-9_-]+)\s*=\s*["]([^"]+)["]\s*(.*)$}so, # Double quotes.
58             qr{^([a-zA-Z0-9_-]+)\s*=\s*[']([^']+)[']\s*(.*)$}so, # Single quotes.
59             qr{^([a-zA-Z0-9_-]+)\s*=\s*([^\s'"]+)\s*(.*)$}so, # Unquoted.
60             );
61              
62             sub parse
63             {
64 23     23 1 46 my($self, $string) = @_;
65 23   100     88 $string ||= $self -> a_string;
66 23         55 $string =~ s/^\s+|\s+$//g;
67 23         27 my($attrs) = {};
68              
69 23         55 $self -> a_string($string);
70              
71 22         42 while (length $string)
72             {
73 3         5 my($i) = - 1;
74 3         5 my($original) = $string;
75              
76 3         11 while ($i < $#quote)
77             {
78 25         20 $i++;
79              
80 25 100       104 if ($string =~ $quote[$i])
81             {
82 9         22 $$attrs{$1} = $2;
83 9         11 $string = $3;
84 9         15 $i = - 1;
85             }
86             }
87              
88 3 50       11 die "Can't parse $string - not a properly formed attribute string\n" if ($string eq $original);
89             }
90              
91 22         30 $self -> a_hashref($attrs);
92 22         27 $self -> parsed(1);
93              
94 22         33 return $attrs;
95              
96             } # End of parse.
97              
98             # -----------------------------------------------
99              
100             sub string2hashref
101             {
102 0     0 1   my($self, $s) = @_;
103 0   0       $s ||= '';
104 0           my($result) = {};
105              
106 0 0         if ($s)
107             {
108 0 0         if ($s =~ m/^\{\s*([^}]*)\}$/)
109             {
110 0           my(@attr) = map{s/([\"\'])(.*)\1/$2/; $_} map{split(/\s*=>\s*/)} split(/\s*,\s*/, $1);
  0            
  0            
  0            
111 0 0         $result = {@attr} if (@attr);
112             }
113             else
114             {
115 0           die "Invalid syntax for hashref: $s";
116             }
117             }
118              
119 0           return $result;
120              
121             } # End of string2hashref.
122              
123             # -----------------------------------------------
124              
125             1;
126              
127             =head1 NAME
128              
129             C - A simple HTML attribute parser
130              
131             =head1 Synopsis
132              
133             #!/usr/bin/env perl
134              
135             use strict;
136             use warnings;
137              
138             use HTML::Parser::Simple::Attributes;
139              
140             # -------------------------
141              
142             # Method 1:
143              
144             my($parser) = HTML::Parser::Simple::Attributes -> new(' height="20" width=20 ');
145              
146             # Get all the attributes as a hashref.
147             # This triggers a call to parse(), if necessary.
148              
149             my($attr_href) = $parser -> get;
150              
151             # Get the value of a specific attribute.
152             # This triggers a call to parse(), if necessary.
153              
154             my($height) = $parser -> get('height');
155              
156             # Method 2:
157              
158             my($parser) = HTML::Parser::Simple::Attributes -> new;
159              
160             $parser -> parse(' height="20" width=20 ');
161              
162             # Get all attributes, or 1, as above.
163              
164             my($attr_href) = $parser -> get;
165             my($height) = $parser -> get('height');
166              
167             # Get the attribute string passed to new() or to parse().
168              
169             my($a_string) = $parser -> a_string;
170              
171             # Get the parsed attributes as a hashref, if parse() has been called.
172             # If parse() has not been called, this returns {}.
173              
174             my($a_hashref) = $parser -> a_hashref;
175              
176              
177             =head1 Description
178              
179             C is a pure Perl module.
180              
181             It parses HTML V 4 attribute strings, and turns them into a hashrefs.
182              
183             Also, convenience methods L and L are provided,
184             which deal with Perl hashrefs formatted as strings.
185              
186             See also L and L.
187              
188             =head1 Distributions
189              
190             This module is available as a Unix-style distro (*.tgz).
191              
192             See L for details.
193              
194             See L for
195             help on unpacking and installing.
196              
197             =head1 Constructor and initialization
198              
199             new(...) returns an object of type C.
200              
201             This is the class contructor.
202              
203             Usage: C<< HTML::Parser::Simple::Attributes -> new >>.
204              
205             This method takes a hash of options.
206              
207             Call C<< new() >> as C<< new(option_1 => value_1, option_2 => value_2, ...) >>.
208              
209             Available options (each one of which is also a method):
210              
211             =over 4
212              
213             =item o a_string => $a_HTML_attribute_string
214              
215             This takes a string as formatted for HTML attribites.
216              
217             E.g.: ' height="20" width=20 '.
218              
219             Default: '' (the empty string).
220              
221             =back
222              
223             =head1 Methods
224              
225             =head2 a_hashref()
226              
227             Returns a hashref of parsed attributes, if C<< parse() >> has been called.
228              
229             Returns {} if C<< parse() >> has not been called.
230              
231             =head2 a_string()
232              
233             Returns the attribute string passed to C<< new() >>, or to L.
234              
235             Returns '' (the empty string) if C<< parse() >> has not been called.
236              
237             'a_string' is a parameter to L. See L for details.
238              
239             =head2 get([$name])
240              
241             Here, the [] indicate an optional parameter.
242              
243             my($hashref) = $parser -> get;
244             my($value) = $parser -> get('attr_name');
245              
246             If you do not pass in an attribute name, this returns a hashref with the attribute names as keys
247             and the attribute values as the values.
248              
249             If you pass in an attribute name, it will return the value for just that attribute.
250              
251             Returns undef if you supply the name of a non-existant attribute.
252              
253             =head2 hashref2string($hashref)
254              
255             Returns a string suitable for printing.
256              
257             Warning: The hashref is formatted as we would normally do in Perl, i.e. with commas and fat commas.
258              
259             {height => 20, width => 20} is returned as 'height => 20, width => 20'
260              
261             This is not how HTML attributes are written.
262              
263             The output string can be parsed by L.
264              
265             This is a convenience method.
266              
267             =head2 new()
268              
269             This is the constructor. See L for details.
270              
271             =head2 parse($attr_string)
272              
273             $attr_href = $parser -> parse($attr_string);
274              
275             Or
276              
277             $parser = HTML::Parser::Simple::Attributes -> new(a_string => $attr_string);
278             $attr_href = $parser -> parse;
279              
280             Parses a string of HTML attributes and returns the result as a hashref, or
281             dies if the string is not a valid attribute string.
282              
283             Attribute values may be quoted with double quotes or single quotes.
284             Quotes may be omitted if there are no spaces in the value.
285              
286             Returns an empty hashref if $attr_string was not supplied to C<< new() >>, nor to C<< parse() >>.
287              
288             =head2 string2hashref($string)
289              
290             Returns a hashref by (simplistically) parsing the string.
291              
292             'height => 20, width => 20' is returned as {height => 20, width => 20}
293              
294             Warning: This string must have been output by L, because it deals with a
295             string of hashrefs as we normally think of them in Perl, i.e. with commas and fat commas.
296              
297             This is not how HTML deals with a string of attributes.
298              
299             This is a convenience method.
300              
301             =head1 Author
302              
303             C was written by Mark Stosberg Imark@summersault.comE> in 2009.
304              
305             The code has be re-worked by Ron Savage.
306              
307             Home page: L.
308              
309             =head1 Copyright
310              
311             Copyright (c) 2009 Mark Stosberg.
312              
313             All Programs of mine are 'OSI Certified Open Source Software';
314             you can redistribute them and/or modify them under the terms of
315             The Artistic License, a copy of which is available at:
316             http://www.opensource.org/licenses/index.html
317              
318             =cut