File Coverage

blib/lib/App/Automaton/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::Automaton::Plugin::Action::NZB;
2              
3             # ABSTRACT: Download module for nzb files
4              
5 1     1   633 use strict;
  1         2  
  1         40  
6 1     1   5 use warnings;
  1         2  
  1         36  
7 1     1   594 use Moo;
  1         14732  
  1         8  
8 1     1   2301 use LWP::UserAgent;
  1         44577  
  1         47  
9 1     1   689 use File::Spec::Functions;
  1         784  
  1         127  
10              
11 1     1   7 use Data::Dumper;
  1         1  
  1         423  
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   1446 my $uri = shift;
43              
44 1         5 my $name = (split(/\//, $uri))[-1];
45            
46             # swap out characters that we don't want in the file name
47 1         13 $name =~ s/[^a-zA-Z0-9\\-]/_/g;
48            
49             # ensure file name ends in .nzb for ease
50 1 50       7 if ( lc(substr($name, -4)) ne '.nzb' ) {
51 1         2 $name .= '.nzb';
52             }
53            
54 1         3 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__