| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package App::Automaton::Plugin::Action::NZB; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: Download module for nzb files |
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
440
|
use strict; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
57
|
|
|
6
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
22
|
|
|
7
|
1
|
|
|
1
|
|
456
|
use Moo; |
|
|
1
|
|
|
|
|
10540
|
|
|
|
1
|
|
|
|
|
6
|
|
|
8
|
1
|
|
|
1
|
|
1670
|
use LWP::UserAgent; |
|
|
1
|
|
|
|
|
29565
|
|
|
|
1
|
|
|
|
|
30
|
|
|
9
|
1
|
|
|
1
|
|
606
|
use File::Spec::Functions; |
|
|
1
|
|
|
|
|
559
|
|
|
|
1
|
|
|
|
|
82
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
5
|
use Data::Dumper; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
325
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub go { |
|
14
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
15
|
0
|
|
|
|
|
0
|
my $in = shift; |
|
16
|
0
|
|
|
|
|
0
|
my $bits = shift; |
|
17
|
0
|
|
0
|
|
|
0
|
my $target = $in->{target} || '.'; |
|
18
|
0
|
|
|
|
|
0
|
my $d = $in->{debug}; |
|
19
|
|
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
0
|
my @patterns = ( |
|
21
|
|
|
|
|
|
|
'http:\/\/www.nzbsearch.net\/nzb_get.aspx\?mid=[a-z,A-Z,0-9]*', |
|
22
|
|
|
|
|
|
|
'https:\/\/www.nzb-rss.com\/nzb\/.*nzb' |
|
23
|
|
|
|
|
|
|
); |
|
24
|
0
|
|
|
|
|
0
|
my $pattern_string = join('|', @patterns); |
|
25
|
|
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
0
|
foreach my $bit (@$bits) { |
|
27
|
0
|
|
|
|
|
0
|
my @urls = $bit =~ /$pattern_string/g; |
|
28
|
0
|
|
|
|
|
0
|
foreach my $url (@urls) { |
|
29
|
0
|
|
|
|
|
0
|
my $name = _get_name($url); |
|
30
|
0
|
|
|
|
|
0
|
my $target_file = catfile($target, $name); |
|
31
|
0
|
0
|
|
|
|
0
|
next if -e $target_file; |
|
32
|
0
|
|
|
|
|
0
|
my $ua = LWP::UserAgent->new(); |
|
33
|
0
|
|
|
|
|
0
|
_logger($d, "downloading $url to $target_file"); |
|
34
|
0
|
|
|
|
|
0
|
$ua->mirror($url, $target_file); |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
} |
|
37
|
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
0
|
return(1); |
|
39
|
|
|
|
|
|
|
} |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub _get_name { |
|
42
|
1
|
|
|
1
|
|
477
|
my $uri = shift; |
|
43
|
|
|
|
|
|
|
|
|
44
|
1
|
|
|
|
|
4
|
my $name = (split(/\//, $uri))[-1]; |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# swap out characters that we don't want in the file name |
|
47
|
1
|
|
|
|
|
7
|
$name =~ s/[^a-zA-Z0-9\\-]/_/g; |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# ensure file name ends in .nzb for ease |
|
50
|
1
|
50
|
|
|
|
6
|
if ( lc(substr($name, -4)) ne '.nzb' ) { |
|
51
|
1
|
|
|
|
|
1
|
$name .= '.nzb'; |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
1
|
|
|
|
|
2
|
return $name; |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub _logger { |
|
58
|
0
|
|
|
0
|
|
|
my $level = shift; |
|
59
|
0
|
|
|
|
|
|
my $message = shift; |
|
60
|
0
|
0
|
|
|
|
|
print "$message\n" if $level; |
|
61
|
0
|
|
|
|
|
|
return 1; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
1; |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
__END__ |