File Coverage

blib/lib/App/Automatan/Plugin/Action/NZB.pm
Criterion Covered Total %
statement 24 45 53.3
branch 1 6 16.6
condition 0 2 0.0
subroutine 7 9 77.7
pod 1 1 100.0
total 33 63 52.3


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__