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