line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Automatan::Plugin::Action::NZB; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: Download module for nzb files |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
602
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
6
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
25
|
|
7
|
1
|
|
|
1
|
|
566
|
use Moo; |
|
1
|
|
|
|
|
12503
|
|
|
1
|
|
|
|
|
7
|
|
8
|
1
|
|
|
1
|
|
2121
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
47572
|
|
|
1
|
|
|
|
|
34
|
|
9
|
1
|
|
|
1
|
|
531
|
use File::Spec::Functions; |
|
1
|
|
|
|
|
648
|
|
|
1
|
|
|
|
|
92
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
5
|
use Data::Dumper; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
344
|
|
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
|
|
1191
|
my $uri = shift; |
43
|
|
|
|
|
|
|
|
44
|
1
|
|
|
|
|
3
|
my $name = (split(/\//, $uri))[-1]; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# swap out characters that we don't want in the file name |
47
|
1
|
|
|
|
|
10
|
$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
|
|
|
|
|
2
|
$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__ |