File Coverage

blib/lib/Rose/HTML/Image.pm
Criterion Covered Total %
statement 47 61 77.0
branch 10 18 55.5
condition 5 16 31.2
subroutine 15 18 83.3
pod 8 9 88.8
total 85 122 69.6


line stmt bran cond sub pod time code
1             package Rose::HTML::Image;
2              
3 3     3   7842 use strict;
  3         8  
  3         91  
4              
5 3     3   1292 use Image::Size;
  3         10397  
  3         208  
6              
7 3     3   20 use base 'Rose::HTML::Object';
  3         7  
  3         1134  
8              
9             our $DOC_ROOT;
10              
11             our $VERSION = '0.606';
12              
13             __PACKAGE__->add_required_html_attrs(
14             {
15             'alt', => '',
16             'src', => '',
17             });
18              
19              
20             __PACKAGE__->add_valid_html_attrs
21             (
22             'src', # %URI; #REQUIRED -- URI of image to embed --
23             'alt', # %Text; #REQUIRED -- short description --
24             'longdesc', # %URI; #IMPLIED -- link to long description --
25             'name', # CDATA #IMPLIED -- name of image for scripting --
26             'height', # %Length; #IMPLIED -- override height --
27             'width', # %Length; #IMPLIED -- override width --
28             'usemap', # %URI; #IMPLIED -- use client-side image map --
29             'ismap', # (ismap) #IMPLIED -- use server-side image map --
30             );
31              
32             __PACKAGE__->add_boolean_html_attrs
33             (
34             'ismap',
35             );
36              
37 12     12 1 54 sub is_self_closing { 1 }
38              
39 0     0 1 0 sub element { 'img' }
40 6     6 1 47 sub html_element { 'img' }
41 6     6 1 30 sub xhtml_element { 'img' }
42              
43             QUIET:
44             {
45 3     3   23 no warnings 'uninitialized';
  3         7  
  3         218  
46 3 50 33 3   20 use constant MOD_PERL_1 => ($ENV{'MOD_PERL'} && !$ENV{'MOD_PERL_API_VERSION'}) ? 1 : 0;
  3         14  
  3         319  
47 3 50 33 3   25 use constant MOD_PERL_2 => ($ENV{'MOD_PERL'} && $ENV{'MOD_PERL_API_VERSION'} == 2) ? 1 : 0;
  3         11  
  3         287  
48              
49 3 50 33 3   21 use constant TRY_MOD_PERL_2 => eval { require Apache2::RequestUtil } && !$@ ? 1 : 0;
  3         17  
  3         7  
50             }
51              
52             sub init_document_root
53             {
54 4     4 0 7 if(MOD_PERL_1)
55             {
56             return Apache->request->document_root;
57             }
58              
59 4         6 if(TRY_MOD_PERL_2)
60             {
61             my $r;
62              
63             TRY:
64             {
65             local $@;
66             eval { $r = Apache2::RequestUtil->request };
67             }
68              
69             if($r)
70             {
71             return $r->document_root;
72             }
73             }
74              
75 4   50     33 return $DOC_ROOT || '';
76             }
77              
78             sub src
79             {
80 8     8 1 51 my($self) = shift;
81 8         23 my $src = $self->html_attr('src', @_);
82 8 100       28 $self->_new_src_or_document_root($src) if(@_);
83 8         38 return $src;
84             }
85              
86             sub path
87             {
88 0     0 1 0 my($self) = shift;
89 0 0       0 return $self->{'path'} unless(@_);
90 0         0 $self->_new_path($self->{'path'} = shift);
91 0         0 return $self->{'path'};
92             }
93              
94             sub document_root
95             {
96 11     11 1 36 my($self) = shift;
97              
98 11 100       25 if(@_)
99             {
100 3         7 $self->{'document_root'} = shift;
101 3         6 $self->_new_src_or_document_root($self->src);
102 3         13 return $self->{'document_root'};
103             }
104              
105             $self->{'document_root'} = $self->init_document_root
106 8 100       32 unless(defined $self->{'document_root'});
107              
108 8         39 return $self->{'document_root'};
109             }
110              
111             sub _new_src_or_document_root
112             {
113 8     8   15 my($self, $src) = @_;
114              
115 8 50       203 if(-e $src)
116             {
117 0         0 $self->{'path'} = $src;
118             }
119             else
120             {
121 8         46 $self->{'path'} = $self->document_root . $src;
122             }
123              
124 8         24 $self->init_size($self->{'path'});
125             }
126              
127             sub _new_path
128             {
129 0     0   0 my($self, $path) = @_;
130              
131 0 0       0 unless($self->{'document_root'})
132             {
133 0         0 $self->init_size;
134 0         0 return;
135             }
136              
137 0         0 my $src = $path;
138              
139 0         0 $src =~ s/^$self->{'document_root'}//;
140              
141 0         0 $self->html_attr('src' => $src);
142              
143 0         0 $self->init_size;
144             }
145              
146             sub init_size
147             {
148 8     8 1 15 my($self, $path) = @_;
149              
150 8   0     18 $path ||= $self->{'path'} || return;
      33        
151              
152 8         36 my($w, $h) = Image::Size::imgsize($path);
153              
154 8         11719 $self->html_attr(width => $w);
155 8         22 $self->html_attr(height => $h);
156             }
157              
158             1;
159              
160             __END__
161              
162             =head1 NAME
163              
164             Rose::HTML::Image - Object representation of the "img" HTML tag.
165              
166             =head1 SYNOPSIS
167              
168             $img = Rose::HTML::Image->new(src => '/logo.png',
169             alt => 'Logo');
170              
171             $img->document_root('/var/web/htdocs');
172              
173             # <img alt="Logo" height="48" src="/logo.png" width="72">
174             print $img->html;
175              
176             $img->alt(undef);
177              
178             # <img alt="" height="48" src="/logo.png" width="72" />
179             print $img->xhtml;
180              
181             ...
182              
183             =head1 DESCRIPTION
184              
185             L<Rose::HTML::Image> is an object representation of the E<lt>imgE<gt> HTML tag. It includes the ability to automatically fill in the "width" and "height" HTML attributes with the correct values, provided it is given enough information to find the actual image file on disk. The L<Image::Size> module is used to read the file and determine the correct dimensions.
186              
187             This class inherits from, and follows the conventions of, L<Rose::HTML::Object>. Inherited methods that are not overridden will not be documented a second time here. See the L<Rose::HTML::Object> documentation for more information.
188              
189             =head1 HTML ATTRIBUTES
190              
191             Valid attributes:
192              
193             alt
194             class
195             dir
196             height
197             id
198             ismap
199             lang
200             longdesc
201             name
202             onclick
203             ondblclick
204             onkeydown
205             onkeypress
206             onkeyup
207             onmousedown
208             onmousemove
209             onmouseout
210             onmouseover
211             onmouseup
212             src
213             style
214             title
215             usemap
216             width
217             xml:lang
218              
219             Required attributes:
220              
221             alt
222             src
223              
224             Boolean attributes:
225              
226             ismap
227              
228             =head1 CONSTRUCTOR
229              
230             =over 4
231              
232             =item B<new PARAMS>
233              
234             Constructs a new L<Rose::HTML::Image> object based on PARAMS, where PARAMS are name/value pairs. Any object method is a valid parameter name.
235              
236             =back
237              
238             =head1 OBJECT METHODS
239              
240             =over 4
241              
242             =item B<document_root [PATH]>
243              
244             Get or set the web site document root. This is combined with the value of the "src" HTML attribute to build the path to the actual image file on disk.
245              
246             If running in a mod_perl 1.x environment, the document root defaults to the value returned by:
247              
248             Apache->request->document_root
249              
250             If running in a mod_perl 2.x environment, the document root defaults to the value returned by:
251              
252             Apache2::RequestUtil->request->document_root
253              
254             Note that you must have the C<GlobalRequest> option set for this to work. If you do not, the document root defaults to undef.
255              
256             These calls are made once for each L<Rose::HTML::Image> object that needs to use the document root.
257              
258             =item B<init_size [PATH]>
259              
260             Try to set the "width" and "height" HTML attributes but using L<Image::Size> to read the image file on disk. If a PATH argument is passed, the image file is read at that location. Otherwise, if the L<path()|/path> attribute is set, that path is used. Failing that, the width and height HTML attributes are simply not modified.
261              
262             =item B<path [PATH]>
263              
264             Get or set the path to the image file on disk.
265              
266             If a PATH argument is passed and L<document_root()|/document_root> is defined, then PATH has L<document_root()|/document_root> removed from the front of it (substitution anchored at the start of PATH) and the resulting string is set as the value of the "src" HTML attribute. Regardless of the value of L<document_root()|/document_root>, L<init_size()|/init_size> is called in an attempt to set the "height" and "width" HTML attributes.
267              
268             The current value of the C<path> object attribute is returned.
269              
270             =item B<src [SRC]>
271              
272             Get or set the value of the "src" HTML attribute.
273              
274             If a SRC argument is passed and a file is found at the path specified by SRC, then L<path()|/path> is set to SRC. Otherwise, L<path()|/path> is set to the concatenation of L<document_root()|/document_root> and SRC. In either case, L<init_size()|/init_size> is called in an attempt to set the "height" and "width" HTML attributes.
275              
276             The current value of the "src" HTML attribute is returned.
277              
278             =back
279              
280             =head1 AUTHOR
281              
282             John C. Siracusa (siracusa@gmail.com)
283              
284             =head1 LICENSE
285              
286             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.