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__ |