File Coverage

blib/lib/HTTP/Size.pm
Criterion Covered Total %
statement 70 73 95.8
branch 12 18 66.6
condition 10 16 62.5
subroutine 12 12 100.0
pod 1 1 100.0
total 105 120 87.5


line stmt bran cond sub pod time code
1             package HTTP::Size;
2 2     2   1229 use strict;
  2         4  
  2         47  
3 2     2   9 use warnings;
  2         2  
  2         44  
4 2     2   8 no warnings;
  2         2  
  2         90  
5              
6             =encoding utf8
7              
8             =head1 NAME
9              
10             HTTP::Size - Get the byte size of an internet resource
11              
12             =head1 SYNOPSIS
13              
14             THIS IS AN ABANDONED MODULE. YOU CAN ADOPT IT.
15             https://pause.perl.org/pause/authenquery?ACTION=pause_04about#takeover
16              
17             use HTTP::Size
18              
19             my $size = HTTP::Size::get_size( $url );
20              
21             if( defined $size ) {
22             print "$url size was $size";
23             }
24             elsif( $HTTP::Size::ERROR == $HTTP::Size::INVALID_URL ) {
25             print "$url is not a valid absolute URL";
26             }
27             elsif( $HTTP::Size::ERROR == $HTTP::Size::COULD_NOT_FETCH ) {
28             print "Could not fetch $url\nHTTP status is $HTTP::Size::HTTP_STATUS";
29             }
30             elsif( $HTTP::Size::ERROR == $HTTP::Size::BAD_CONTENT_LENGTH ) {
31             print "Could not determine content length of $url";
32             }
33              
34             =head1 DESCRIPTION
35              
36             =head1 VARIABLES
37              
38             The following global variables describes conditions from the last
39             function call:
40              
41             $ERROR
42             $HTTP_STATUS
43              
44             The C<$ERROR> variable may be set to any of these values:
45              
46             $INVALID_URL - the URL is not a valid absolute URL
47             $COULD_NOT_FETCH - the function encountered an HTTP error
48             $BAD_CONTENT_LENGTH - could not determine a content type
49              
50             The module does not export these variables, so you need to use
51             the full package specification outside of the HTTP::Size
52             package.
53              
54             =cut
55              
56 2     2   968 use subs qw( get_size _request );
  2         42  
  2         9  
57 2         191 use vars qw(
58             $ERROR $HTTP_STATUS $VERSION
59             $INVALID_URL $COULD_NOT_FETCH $BAD_CONTENT_LENGTH
60             $CONTENT $CONTENT_TYPE
61 2     2   97 );
  2         3  
62              
63 2     2   1151 use LWP::UserAgent;
  2         74251  
  2         61  
64 2     2   16 use URI;
  2         5  
  2         40  
65 2     2   8 use HTTP::Request;
  2         4  
  2         912  
66              
67             $VERSION = '1.153';
68              
69             my $User_agent = LWP::UserAgent->new();
70              
71             $INVALID_URL = -1;
72             $COULD_NOT_FETCH = -2;
73             $BAD_CONTENT_LENGTH = -3;
74              
75             =head1 FUNCTIONS
76              
77             =over 4
78              
79             =item get_size( URL )
80              
81             Fetch the specified absolute URL and return its content length.
82             The URL can be a string or an URI object. The function tries
83             the HEAD HTTP method first, and on failure, tries the GET method.
84             In either case it sets $HTTP_STATUS to the HTTP response code.
85             If the response does not contain a Content-Length header, the
86             function takes the size of the message body. If the HEAD method
87             returned a good status, but no Content-Length header, it retries
88             with the GET method.
89              
90             On error, the function set $ERROR to one of these values:
91              
92             $INVALID_URL - the URL is not a valid absolute URL
93             $COULD_NOT_FETCH - the function encountered an HTTP error
94             $BAD_CONTENT_LENGTH - could not determine a content type
95              
96             =cut
97              
98             sub get_size {
99 7     7   203346 my $url = shift;
100 7   100     46 my $method = shift || 0;
101 7         30 _init();
102              
103 7 50       32 unless( ref $url eq 'URI' ) {
104 7         25 $url = URI->new( $url );
105             }
106              
107 7 100       4814 unless( $url->scheme ) {
108 2         82 $ERROR = $INVALID_URL;
109 2         9 return;
110             };
111              
112 5         171 my $response = '';
113 5         12 my $size = 0;
114              
115 5 100       24 unless( $method ) {
116 4         41 my $request = HTTP::Request->new( HEAD => $url->as_string );
117              
118 4         514 $response = _request( $request );
119 4         15 $HTTP_STATUS = $response->code;
120 4         35 $size = $response->content_length;
121             }
122              
123 5 100 100     159 unless( not $method and $response->is_success and $size ) {
      66        
124 3         22 my $request = HTTP::Request->new( GET => $url->as_string );
125 3         302 $response = _request( $request );
126 3         20 $HTTP_STATUS = $response->code;
127 3         38 $CONTENT = $response->content;
128              
129 3 50 33     35 unless( $response->is_success ) {
    100          
130 2         13 $ERROR = $COULD_NOT_FETCH;
131 2         11 return;
132             }
133 0         0 elsif( not $response->content_length ) {
134 0         0 $size = length $CONTENT;
135             }
136             elsif( $response->content_length ) {
137             $size = $response->content_length;
138             }
139              
140             }
141              
142 3         96 $CONTENT_TYPE = lc $response->content_type;
143              
144 3         95 return $size;
145             }
146              
147             =item get_sizes( URL, BASE_URL )
148              
149             The get_sizes function is like get_size, although for HTML pages
150             it also fetches all of the images then sums the sizes of the
151             original page and image sizes. It returns a total download size.
152             In list context it returns the total download size and a hash
153             reference whose keys are the URLs that a browser should download
154             automatically (images):
155              
156             size
157             ERROR
158             HTTP_STATUS
159              
160             The ERROR and HTTP_STATUS correspond to the values of $ERROR and
161             $HTTP_STATUS for that URL.
162              
163             my ( $total, $hash ) = HTTP::Size::get_sizes( $url );
164              
165             foreach my $key ( keys %$hash )
166             {
167             print "$key had an error" unless defined $size;
168             }
169              
170             The hash is always returned in list context (a change from
171             version 0.4).
172              
173             Relative image links resolve according to BASE_URL, or by
174             a found BASE tag. See L.
175              
176             Javascript and style sheet links are unimplemented right now.
177              
178             =cut
179              
180             sub get_sizes {
181 1     1 1 1527 my $url = shift;
182 1         7 my $base = shift;
183              
184 1         2 my %hash;
185              
186 1         5 my $size = get_size( $url, 'GET' );
187              
188 1         4 @{$hash{$url}}{ qw(size ERROR HTTP_STATUS) }
  1         4  
189             = ($size, $ERROR, $HTTP_STATUS);
190              
191 1 50 33     24 unless( $size and $CONTENT_TYPE eq 'text/html' ) {
192 0 0       0 return wantarray ? ( $size, \%hash ) : $size;
193             }
194              
195 1         561 require HTML::SimpleLinkExtor;
196              
197 1         6926 my $total = $size;
198              
199 1         12 my $extor = HTML::SimpleLinkExtor->new( $url );
200              
201 1         460 $extor->parse( $CONTENT );
202              
203 1         128 foreach my $img ( $extor->img ) {
204 1   50     825 my $size = get_size( $img ) || 0;
205              
206 1         3 @{$hash{$img}}{ qw(size ERROR HTTP_STATUS) }
  1         4  
207             = ( $size, $ERROR, $HTTP_STATUS );
208              
209 1         8 $total += $size;
210             }
211              
212 1 50       7 return wantarray ? ( $total, \%hash ) : $total;
213             }
214              
215             sub _init {
216 7     7   36 $ERROR = $CONTENT_TYPE = $CONTENT = $HTTP_STATUS = '';
217             }
218              
219             sub _request {
220 7     7   36 my $response = $User_agent->request( shift );
221              
222 7         26304 $HTTP_STATUS = $response->code;
223              
224 7         56 return $response;
225             }
226              
227             =back
228              
229             =head1 TO DO
230              
231             * if i have to use GET, i should use Byte-Ranges to avoid
232             downloading the whole thing
233              
234             * add a way to specify Basic Auth credentials
235              
236             * download javascript and style sheets too.
237              
238             =head1 SEE ALSO
239              
240             L
241              
242             =head1 SOURCE AVAILABILITY
243              
244             This source is part of a GitHub project:
245              
246             https://github.com/CPAN-Adoptable-Modules/http-size
247              
248             =head1 AUTHOR
249              
250             brian d foy, C<< >>
251              
252             =head1 COPYRIGHT AND LICENSE
253              
254             Copyright © 2000-2021, brian d foy . All rights reserved.
255              
256             This program is free software; you can redistribute it and/or modify
257             it under the terms of the Artistic License 2.0.
258              
259             =cut
260              
261             1;