File Coverage

blib/lib/App/Automaton/Plugin/Action/TedTalks.pm
Criterion Covered Total %
statement 27 58 46.5
branch 1 12 8.3
condition 0 2 0.0
subroutine 8 11 72.7
pod 1 1 100.0
total 37 84 44.0


line stmt bran cond sub pod time code
1             package App::Automaton::Plugin::Action::TedTalks;
2              
3             # ABSTRACT: Download module for Ted Talk videos
4              
5 1     1   398 use strict;
  1         1  
  1         28  
6 1     1   5 use warnings;
  1         1  
  1         30  
7 1     1   474 use Moo;
  1         9304  
  1         5  
8 1     1   1396 use WWW::Offliberty qw/off/;
  1         51364  
  1         57  
9 1     1   5 use LWP::UserAgent;
  1         2  
  1         13  
10 1     1   383 use File::Spec::Functions;
  1         488  
  1         60  
11              
12 1     1   4 use Data::Dumper;
  1         1  
  1         346  
13              
14             sub go {
15 0     0 1 0 my $self = shift;
16 0         0 my $in = shift;
17 0         0 my $bits = shift;
18 0   0     0 my $target = $in->{target} || '.';
19 0         0 my $d = $in->{debug};
20              
21 0         0 my $ua = LWP::UserAgent->new();
22              
23 0         0 foreach my $bit (@$bits) {
24 0         0 my @urls = $bit =~ /www.ted.com\/talks\/[a-z,A-Z,0-9,_]+/g;
25            
26 0         0 foreach my $url (@urls) {
27 0 0       0 next unless $url;
28 0         0 my $name = _get_name($url);
29 0         0 _logger($d, "getting links for $url");
30 0         0 my $new_url = _get_link($url);
31             #TODO: what if url is undef?'
32 0 0       0 die "could not determine new url for $url" unless $new_url;
33 0         0 my $target_file = catfile($target, $name);
34 0 0       0 next if -e $target_file;
35 0         0 my $ua = LWP::UserAgent->new();
36 0         0 _logger($d, "downloading $new_url to $target_file");
37 0         0 $ua->mirror( $new_url, $target_file );
38             }
39              
40             }
41              
42 0         0 return (1);
43             }
44              
45             sub _get_link {
46 0     0   0 my $url = shift;
47              
48 0         0 my @links = off( $url, video_file => 1 );
49              
50 0         0 my $_get_link;
51 0         0 foreach my $link (@links) {
52             #TODO: I'd like to make this more sophisticated, with less assumption
53             #TODO: Also, maybe a flag to specify language or format preference, even audio only
54 0 0       0 if ( $link =~ m/-480p.mp4/ ) {
55 0         0 $_get_link = $link;
56             }
57             }
58            
59 0         0 return $_get_link;
60             }
61              
62             sub _get_name {
63 1     1   460 my $uri = shift;
64              
65 1         4 my $name = ( split( /\//, $uri ) )[-1];
66              
67             # swap out characters that we don't want in the file name
68 1         6 $name =~ s/[^a-zA-Z0-9\\-]/_/g;
69              
70             #TODO: This should be based on the "_get_link" var from above?
71             # put the .mp4 back on
72 1 50       5 if ( lc( substr( $name, -4 ) ) ne '.mp4' ) {
73 1         5 $name .= '.mp4';
74             }
75              
76 1         4 return $name;
77             }
78              
79             sub _logger {
80 0     0     my $level = shift;
81 0           my $message = shift;
82 0 0         print "$message\n" if $level;
83 0           return 1;
84             }
85              
86             1;
87              
88             __END__