File Coverage

blib/lib/App/cdnget/Downloader.pm
Criterion Covered Total %
statement 33 35 94.2
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 45 47 95.7


line stmt bran cond sub pod time code
1             package App::cdnget::Downloader;
2 1     1   4 use Object::Base;
  1         0  
  1         8  
3 1     1   459 use v5.14;
  1         2  
4 1     1   4 use feature qw(switch);
  1         1  
  1         97  
5 1     1   582 no if ($] >= 5.018), 'warnings' => 'experimental';
  1         8  
  1         5  
6 1     1   56 use bytes;
  1         0  
  1         9  
7 1     1   16 use IO::Handle;
  1         1  
  1         16  
8 1     1   60 use FileHandle;
  1         1  
  1         4  
9 1     1   407 use Time::HiRes qw(sleep usleep);
  1         1  
  1         7  
10 1     1   187 use Thread::Semaphore;
  1         2  
  1         17  
11 1     1   446 use HTTP::Headers;
  1         2506  
  1         31  
12 1     1   644 use LWP::UserAgent;
  1         24669  
  1         36  
13 1     1   394 use GD;
  0            
  0            
14             use Lazy::Utils;
15              
16             use App::cdnget;
17             use App::cdnget::Exception;
18              
19              
20             BEGIN
21             {
22             our $VERSION = '0.04';
23             }
24              
25              
26             my $maxCount;
27              
28             my $terminating :shared = 0;
29             my $terminated :shared = 0;
30             my $downloaderSemaphore :shared;
31              
32             our %uids :shared;
33              
34              
35             attributes qw(:shared uid path url hook tid);
36              
37              
38             sub init
39             {
40             my ($_maxCount) = @_;
41             $maxCount = $_maxCount;
42             $downloaderSemaphore = Thread::Semaphore->new($maxCount);
43             return 1;
44             }
45              
46             sub final
47             {
48             return 1;
49             }
50              
51             sub terminate
52             {
53             do
54             {
55             lock($terminating);
56             return 0 if $terminating;
57             $terminating = 1;
58             };
59             App::cdnget::log_info("Downloaders terminating...");
60             my $gracefully = 0;
61             while (not $gracefully and not $App::cdnget::terminating_force)
62             {
63             $gracefully = $downloaderSemaphore->down_timed(3, $maxCount);
64             }
65             lock($terminated);
66             $terminated = 1;
67             App::cdnget::log_info("Downloaders terminated".($gracefully? " gracefully": "").".");
68             return 1;
69             }
70              
71             sub terminating
72             {
73             lock($terminating);
74             return $terminating;
75             }
76              
77             sub terminated
78             {
79             if (@_ > 0)
80             {
81             my $self = shift;
82             lock($self);
83             return defined($self->tid)? 0: 1;
84             }
85             lock($terminated);
86             return $terminated;
87             }
88              
89             sub new
90             {
91             my $class = shift;
92             my ($uid, $path, $url, $hook) = @_;
93             while (not $downloaderSemaphore->down_timed(1))
94             {
95             if (terminating())
96             {
97             return;
98             }
99             }
100             if (terminating())
101             {
102             $downloaderSemaphore->up();
103             return;
104             }
105             lock(%uids);
106             return if exists($uids{$uid});
107             my $self = $class->SUPER();
108             $self->uid = $uid;
109             $self->path = $path;
110             $self->url = $url;
111             $self->hook = $hook;
112             $self->tid = undef;
113             {
114             lock($self);
115             my $thr = threads->create(\&run, $self) or $self->throw($!);
116             cond_wait($self);
117             unless (defined($self->tid))
118             {
119             App::cdnget::Exception->throw($thr->join());
120             }
121             $thr->detach();
122             }
123             $uids{$uid} = $self;
124             return $self;
125             }
126              
127             sub DESTROY
128             {
129             my $self = shift;
130             $self->SUPER::DESTROY;
131             }
132              
133             sub throw
134             {
135             my $self = shift;
136             my ($msg) = @_;
137             unless (ref($msg))
138             {
139             $msg = "Unknown" unless $msg;
140             $msg = "Downloader ".
141             "uid=$self->uid ".
142             "url=\"".shellmeta($self->url)."\" ".
143             $msg;
144             }
145             App::cdnget::Exception->throw($msg, 1);
146             }
147              
148             sub processHook_img
149             {
150             my $self = shift;
151             my ($hook, $response, @params) = @_;
152             my $headers = $response->{_headers};
153             my $img;
154             given ($headers->content_type)
155             {
156             when ("image/png")
157             {
158             $img = GD::Image->newFromPngData($response->decoded_content) or $self->throw($!);
159             }
160             when ("image/jpeg")
161             {
162             $img = GD::Image->newFromJpegData($response->decoded_content) or $self->throw($!);
163             }
164             default
165             {
166             $self->throw("Unsupported content type for image");
167             }
168             }
169             given ($hook)
170             {
171             when (/^imgresize$/i)
172             {
173             $params[0] = $img->width unless defined($params[0]) and $params[0] > 0;
174             $params[1] = $img->height unless defined($params[1]) and $params[1] > 0;
175             $params[2] = 60 unless defined($params[2]) and $params[2] >= 0 and $params[2] <= 100;
176             my $newimg = new GD::Image($params[0], $params[1]) or $self->throw($!);
177             $newimg->copyResampled($img, 0, 0, 0, 0, $params[0], $params[1], $img->width, $img->height);
178             my $data;
179             given ($headers->content_type)
180             {
181             when ("image/png")
182             {
183             $data = $newimg->png($params[2]) or $self->throw($!);
184             }
185             when ("image/jpeg")
186             {
187             $data = $newimg->jpeg($params[2]) or $self->throw($!);
188             }
189             }
190             return ("Status: 200\r\nContent-Type: ".$headers->content_type."\r\nContent-Length: ".length($data)."\r\n", $data);
191             }
192             when (/^imgcrop$/i)
193             {
194             $params[0] = $img->width unless defined($params[0]) and $params[0] > 0;
195             $params[1] = $img->height unless defined($params[1]) and $params[1] > 0;
196             $params[2] = 0 unless defined($params[2]) and $params[2] > 0;
197             $params[3] = 0 unless defined($params[3]) and $params[3] > 0;
198             $params[4] = 60 unless defined($params[4]) and $params[4] >= 0 and $params[4] <= 100;
199             my $newimg = new GD::Image($params[0], $params[1]) or $self->throw($!);
200             $newimg->copy($img, 0, 0, $params[2], $params[3], $params[0], $params[1]);
201             my $data;
202             given ($headers->content_type)
203             {
204             when ("image/png")
205             {
206             $data = $newimg->png($params[4]) or $self->throw($!);
207             }
208             when ("image/jpeg")
209             {
210             $data = $newimg->jpeg($params[4]) or $self->throw($!);
211             }
212             }
213             return ("Status: 200\r\nContent-Type: ".$headers->content_type."\r\nContent-Length: ".length($data)."\r\n", $data);
214             }
215             default
216             {
217             $self->throw("Unsupported img hook");
218             }
219             }
220             return;
221             }
222              
223             sub processHook
224             {
225             my $self = shift;
226             my ($response) = @_;
227             my @params = split /\s+/, $self->hook;
228             my $hook = shift @params;
229             return unless defined($hook);
230             given ($hook)
231             {
232             when (/^img/i)
233             {
234             return $self->processHook_img($hook, $response, @params);
235             }
236             default
237             {
238             $self->throw("Unsupported hook");
239             }
240             }
241             return;
242             }
243              
244             sub run
245             {
246             my $self = shift;
247             my $tid = threads->tid();
248              
249             my $fh;
250             eval
251             {
252             $fh = FileHandle->new($self->path, ">") or $self->throw($!);
253             };
254             if ($@)
255             {
256             lock($self);
257             cond_signal($self);
258             return $@;
259             }
260              
261             $self->tid = $tid;
262             do
263             {
264             lock($self);
265             cond_signal($self);
266             };
267              
268             eval
269             {
270             my $max_size = undef;
271             if ($self->hook)
272             {
273             $max_size = 20*1024*1024;
274             }
275             $fh->binmode(":bytes") or $self->throw($!);
276             my $ua = LWP::UserAgent->new(agent => "p5-cdnget/${App::cdnget::VERSION}",
277             max_redirect => 1,
278             max_size => $max_size,
279             requests_redirectable => [],
280             timeout => 5);
281             my $response_header = sub
282             {
283             my ($response, $ua) = @_;
284             local ($/, $\) = ("\r\n")x2;
285             my $status = $response->{_rc};
286             my $headers = $response->{_headers};
287             $fh->print("Status: ".$status) or $self->throw($!);
288             $fh->print("Client-URL: ".$self->url) or $self->throw($!);
289             $fh->print("Client-Date: ".POSIX::strftime($App::cdnget::DTF_RFC822_GMT, gmtime)) or $self->throw($!);
290             for my $header (sort grep /^(Content\-|Location\:)/i, $headers->header_field_names())
291             {
292             $fh->print("$header: ", $headers->header($header)) or $self->throw($!);
293             }
294             $fh->print("") or $self->throw($!);
295             return 1;
296             };
297             my $content_cb = sub
298             {
299             my ($data, $response) = @_;
300             $fh->write($data, length($data)) or $self->throw($!);
301             $self->throw("Terminating") if $self->terminating;
302             return 1;
303             };
304             my %matchspec = (':read_size_hint' => $App::cdnget::CHUNK_SIZE);
305             unless ($self->hook)
306             {
307             $ua->add_handler(
308             response_header => $response_header,
309             );
310             $matchspec{':content_cb'} = $content_cb;
311             }
312             my $response = $ua->get($self->url, %matchspec);
313             die $response->header("X-Died")."\n" if $response->header("X-Died");
314             $self->throw("Download failed") if $response->header("Client-Aborted");
315             if ($self->hook)
316             {
317             if ($response->is_success)
318             {
319             my ($header, $data) = $self->processHook($response);
320             if ($header)
321             {
322             $header .= "Client-URL: ".$self->url."\r\n";
323             $header .= "Client-Date: ".POSIX::strftime($App::cdnget::DTF_RFC822_GMT, gmtime)."\r\n";
324             $data = "" unless defined($data);
325             $fh->print($header."\r\n".$data) or $self->throw($!);
326             }
327             } else
328             {
329             $response_header->($response, $ua);
330             $content_cb->($response->decoded_content, $response);
331             }
332             }
333             };
334             do
335             {
336             local $@;
337             $fh->close();
338             {
339             lock(%uids);
340             delete($uids{$self->uid});
341             }
342             $downloaderSemaphore->up();
343             usleep(10*1000); #cond_wait bug
344             lock($self);
345             $self->tid = undef;
346             };
347             if ($@)
348             {
349             unlink($self->path);
350             warn $@;
351             return $@;
352             }
353             return;
354             }
355              
356              
357             1;
358             __END__
359             =head1 REPOSITORY
360              
361             B<GitHub> L<https://github.com/orkunkaraduman/p5-cdnget>
362              
363             B<CPAN> L<https://metacpan.org/release/App-cdnget>
364              
365             =head1 AUTHOR
366              
367             Orkun Karaduman <orkunkaraduman@gmail.com>
368              
369             =head1 COPYRIGHT AND LICENSE
370              
371             Copyright (C) 2017 Orkun Karaduman <orkunkaraduman@gmail.com>
372              
373             This program is free software: you can redistribute it and/or modify
374             it under the terms of the GNU General Public License as published by
375             the Free Software Foundation, either version 3 of the License, or
376             (at your option) any later version.
377              
378             This program is distributed in the hope that it will be useful,
379             but WITHOUT ANY WARRANTY; without even the implied warranty of
380             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
381             GNU General Public License for more details.
382              
383             You should have received a copy of the GNU General Public License
384             along with this program. If not, see <http://www.gnu.org/licenses/>.
385              
386             =cut