line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MP3::PodcastFetch; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
62613
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
5
|
1
|
|
|
1
|
|
5
|
use Carp 'croak'; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
53
|
|
6
|
1
|
|
|
1
|
|
474
|
use MP3::PodcastFetch::Feed; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
7
|
1
|
|
|
1
|
|
722
|
use MP3::PodcastFetch::TagManager; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
7
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
10
|
1
|
|
|
1
|
|
6
|
use HTTP::Status; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
358
|
|
11
|
1
|
|
|
1
|
|
6
|
use URI::Escape; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
66
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use File::Spec; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
14
|
1
|
|
|
1
|
|
5
|
use File::Basename 'basename'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
83
|
|
15
|
1
|
|
|
1
|
|
5
|
use File::Path 'mkpath'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
16
|
1
|
|
|
1
|
|
889
|
use IO::Dir; |
|
1
|
|
|
|
|
10338
|
|
|
1
|
|
|
|
|
55
|
|
17
|
1
|
|
|
1
|
|
10
|
use Digest::MD5 qw(md5_hex); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
18
|
1
|
|
|
1
|
|
6
|
use Date::Parse; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
51
|
|
19
|
1
|
|
|
1
|
|
10
|
use Cwd; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
149
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '1.05'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 NAME |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
MP3::PodcastFetch -- Fetch and manage a podcast subscription |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 SYNOPSIS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
use MP3::PodcastFetch; |
30
|
|
|
|
|
|
|
my $feed = MP3::PodcastFetch->new(-base => '/tmp/podcasts', |
31
|
|
|
|
|
|
|
-rss => 'http://www.npr.org/rss/podcast.php?id=500001' |
32
|
|
|
|
|
|
|
-rewrite_filename => 1, |
33
|
|
|
|
|
|
|
-upgrade_tag => 'auto'); |
34
|
|
|
|
|
|
|
$feed->fetch_pods; |
35
|
|
|
|
|
|
|
print "fetched ",$feed->fetched," new podcasts\n"; |
36
|
|
|
|
|
|
|
for my $file ($feed->fetched_files) { |
37
|
|
|
|
|
|
|
print $file,"\n"; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 DESCRIPTION |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This package provides a convenient and simple way of mirroring the |
43
|
|
|
|
|
|
|
podcasts described by an RSS feed into a local directory. It was |
44
|
|
|
|
|
|
|
written as the backend for the fetch_pods.pl script. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
To use it, create an MP3::PodcastFetch object with the required |
47
|
|
|
|
|
|
|
B<-base> and B<-rss> arguments. The podcasts listed in the RSS |
48
|
|
|
|
|
|
|
subscription file located at the B<-rss> URL will be mirrored into one |
49
|
|
|
|
|
|
|
or more subdirectories located beneath the path at B<-base>. One |
50
|
|
|
|
|
|
|
subdirectory will be created for each channel specified by the |
51
|
|
|
|
|
|
|
RSS. Additional new() arguments control optional features of this |
52
|
|
|
|
|
|
|
module. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Once the object is created, call its fetch_pods() method to download |
55
|
|
|
|
|
|
|
the RSS file, parse it, and mirror the subscribed podcasts locally. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 METHODS |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This module implements the following methods: |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=cut |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
BEGIN { |
64
|
1
|
|
|
1
|
|
5
|
my @accessors = qw(base subdir override_channel_dir rss |
65
|
|
|
|
|
|
|
max timeout mirror_mode verbose rewrite_filename upgrade_tags use_pub_date |
66
|
|
|
|
|
|
|
keep_old playlist_handle playlist_base force_genre force_artist |
67
|
|
|
|
|
|
|
force_album fetch_callback delete_callback env_proxy); |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
22
|
for my $accessor (@accessors) { |
70
|
20
|
100
|
|
14
|
1
|
1188
|
eval <
|
|
14
|
50
|
|
4
|
0
|
30
|
|
|
14
|
100
|
|
12
|
1
|
39
|
|
|
14
|
100
|
|
10
|
0
|
45
|
|
|
14
|
100
|
|
14
|
1
|
286
|
|
|
4
|
100
|
|
10
|
1
|
9
|
|
|
4
|
100
|
|
10
|
1
|
8
|
|
|
4
|
100
|
|
8
|
1
|
15
|
|
|
4
|
100
|
|
8
|
0
|
9
|
|
|
12
|
100
|
|
16
|
1
|
20
|
|
|
12
|
100
|
|
14
|
1
|
25
|
|
|
12
|
50
|
|
4
|
1
|
40
|
|
|
12
|
100
|
|
10
|
1
|
46
|
|
|
10
|
100
|
|
28
|
1
|
20
|
|
|
10
|
100
|
|
8
|
1
|
72
|
|
|
10
|
100
|
|
14
|
1
|
32
|
|
|
10
|
100
|
|
12
|
1
|
38
|
|
|
14
|
100
|
|
16
|
1
|
27
|
|
|
14
|
100
|
|
10
|
0
|
27
|
|
|
14
|
100
|
|
20
|
1
|
50
|
|
|
14
|
|
|
|
|
176
|
|
|
10
|
|
|
|
|
38
|
|
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
39
|
|
|
10
|
|
|
|
|
194
|
|
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
33
|
|
|
10
|
|
|
|
|
42
|
|
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
25
|
|
|
8
|
|
|
|
|
26
|
|
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
23
|
|
|
8
|
|
|
|
|
30
|
|
|
8
|
|
|
|
|
27
|
|
|
16
|
|
|
|
|
25
|
|
|
16
|
|
|
|
|
30
|
|
|
16
|
|
|
|
|
43
|
|
|
16
|
|
|
|
|
39
|
|
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
29
|
|
|
14
|
|
|
|
|
44
|
|
|
14
|
|
|
|
|
243
|
|
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
20
|
|
|
4
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
34
|
|
|
10
|
|
|
|
|
36
|
|
|
28
|
|
|
|
|
47
|
|
|
28
|
|
|
|
|
40
|
|
|
28
|
|
|
|
|
65
|
|
|
28
|
|
|
|
|
394
|
|
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
29
|
|
|
8
|
|
|
|
|
26
|
|
|
14
|
|
|
|
|
24
|
|
|
14
|
|
|
|
|
32
|
|
|
14
|
|
|
|
|
49
|
|
|
14
|
|
|
|
|
96
|
|
|
12
|
|
|
|
|
21
|
|
|
12
|
|
|
|
|
27
|
|
|
12
|
|
|
|
|
36
|
|
|
12
|
|
|
|
|
39
|
|
|
16
|
|
|
|
|
304
|
|
|
16
|
|
|
|
|
31
|
|
|
16
|
|
|
|
|
48
|
|
|
16
|
|
|
|
|
70
|
|
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
32
|
|
|
20
|
|
|
|
|
35
|
|
|
20
|
|
|
|
|
36
|
|
|
20
|
|
|
|
|
54
|
|
|
20
|
|
|
|
|
82
|
|
71
|
|
|
|
|
|
|
sub $accessor { |
72
|
|
|
|
|
|
|
my \$self = shift; |
73
|
|
|
|
|
|
|
my \$d = \$self->{$accessor}; |
74
|
|
|
|
|
|
|
\$self->{$accessor} = shift if \@_; |
75
|
|
|
|
|
|
|
return \$d; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
END |
78
|
20
|
50
|
|
|
|
3473
|
die $@ if $@; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head2 Constructor |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$feed = MP3::PodcastFetch->new(-base=>$base,-rss=>$url, [other args]) |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
The new() method creates a new MP3::PodcastFetch object. Options are |
87
|
|
|
|
|
|
|
as follows: |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=over 4 |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item -base |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
The base directory for all mirrored podcast files, |
94
|
|
|
|
|
|
|
e.g. "/var/podcasts". Fetched podcasts files will be stored into |
95
|
|
|
|
|
|
|
appropriately-named subdirectories of this location, one subdirectory |
96
|
|
|
|
|
|
|
per channel. Additional subdirectory levels can be added using the |
97
|
|
|
|
|
|
|
B<-subdirs> argument. This argument is required. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item -override_channel_dir |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Default is to use directory named after a channel title. Specify |
102
|
|
|
|
|
|
|
another directory instead. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=item -rss |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
The URL of the RSS feed to subscribe to. This is usually indicated in |
107
|
|
|
|
|
|
|
web pages as a red "podcast" or "xml" icon. This argument is required. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item -verbose |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
If true, print status messages to STDERR for each podcast file |
112
|
|
|
|
|
|
|
attempted. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item -env_proxy |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
If true, load proxy settings from *_proxy environment variables. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item -max |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Set the maximum number of podcast episodes to keep. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item -keep_old |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
If true, keep old episodes and skip new ones if B<-max> is |
125
|
|
|
|
|
|
|
exceeded. The default is to delete old episodes to make room for new |
126
|
|
|
|
|
|
|
ones. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=item -timeout |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
How long (in seconds) to wait before timing out slow servers. Applies |
131
|
|
|
|
|
|
|
to both the initial RSS feed fetching and mirroring individual podcast |
132
|
|
|
|
|
|
|
episodes. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item -mirror_mode |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
One of "exists" or "modified-since". The default, "exists", will cause |
137
|
|
|
|
|
|
|
podcast episodes to be skipped if a like-named file already |
138
|
|
|
|
|
|
|
exists. "modified-since" performs a more careful comparison with the |
139
|
|
|
|
|
|
|
corresponding podcast episode on the remote server. The local file |
140
|
|
|
|
|
|
|
will be refreshed if the remote server's version is more recent. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item -rewrite_filename |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
If true, cryptic MP3 names will be replaced with long names based on |
145
|
|
|
|
|
|
|
podcast episode title. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item -upgrade_tag |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Some podcast files have informative ID3 tags, but many |
150
|
|
|
|
|
|
|
don't. Particularly annoying is the genre, which may be given as |
151
|
|
|
|
|
|
|
"Speech", "Podcast", or anything else. The upgrade_tag option, if set |
152
|
|
|
|
|
|
|
to a non-false value, will attempt to normalize the ID3 tags from the |
153
|
|
|
|
|
|
|
information provided by the RSS feed information. Specifically, the |
154
|
|
|
|
|
|
|
title will be set to the title of the podcast, the album will be set |
155
|
|
|
|
|
|
|
to the title of the channel (e.g. "New York Times Front Page"), the |
156
|
|
|
|
|
|
|
artist will be set to the channel author (e.g. "The New York Times"), |
157
|
|
|
|
|
|
|
the year will be set to the publication date, the genre will be set to |
158
|
|
|
|
|
|
|
"Podcast" and the comment will be set to the channel description. You |
159
|
|
|
|
|
|
|
can change some of these values using the options "force_genre," |
160
|
|
|
|
|
|
|
"force_album," and "force_artist." |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
The value of upgrade_tag is one of: |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
false Don't mess with the ID3 tags |
165
|
|
|
|
|
|
|
id3v1 Upgrade the ID3 version 1 tag |
166
|
|
|
|
|
|
|
id3v2.3 Upgrade the ID3 version 2.3 tag |
167
|
|
|
|
|
|
|
id3v2.4 Upgrade the ID3 version 2.4 tag |
168
|
|
|
|
|
|
|
auto Choose the best tag available |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Depending on what optional Perl ID3 manipulation modules you have |
171
|
|
|
|
|
|
|
installed, you may be limited in what level of ID3 tag you can update: |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Audio::TagLib all versions through 2.4 |
174
|
|
|
|
|
|
|
MP3::Tag all versions through 2.3 |
175
|
|
|
|
|
|
|
MP3::Info only version 1.0 |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Choosing "auto" is your best bet. It will dynamically find what Perl |
178
|
|
|
|
|
|
|
modules you have installed, and choose the one that provides the most |
179
|
|
|
|
|
|
|
recent tag version. Omit this argument, or set it to false, to prevent |
180
|
|
|
|
|
|
|
any ID3 tag rewriting from occurring. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=item -force_genre, -force_artist, -force_album |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
If you have "upgrade_tag" set to a true value (and at least one |
185
|
|
|
|
|
|
|
tag-writing module installed) then each podcast's ID3 tag will be |
186
|
|
|
|
|
|
|
modified to create a consistent set of fields using information |
187
|
|
|
|
|
|
|
provided by the RSS feed. The title will be set to the title of the |
188
|
|
|
|
|
|
|
podcast, the album will be set to the title of the channel (e.g. "New |
189
|
|
|
|
|
|
|
York Times Front Page"), the artist will be set to the channel author |
190
|
|
|
|
|
|
|
(e.g. "The New York Times"), the year will be set to the publication |
191
|
|
|
|
|
|
|
date, the genre will be set to "Podcast" and the comment will be set |
192
|
|
|
|
|
|
|
to the channel description. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
You can change some of these values using these three options: |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
-force_genre Change the genre to whatever you specify. |
197
|
|
|
|
|
|
|
-force_artist Change the artist. |
198
|
|
|
|
|
|
|
-force_album Change the album. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Note that if you use ID3v1 tagging (e.g. MP3::Info) then you must |
201
|
|
|
|
|
|
|
choose one of the predefined genres; in particular, there is no genre |
202
|
|
|
|
|
|
|
named "Podcast." You must force something else, like "Speech" instead. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item -playlist_handle |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
A writeable filehandle on a previously-opened .m3u playlist file. The |
207
|
|
|
|
|
|
|
playlist file must already have the "#EXTM3U" top line written into |
208
|
|
|
|
|
|
|
it. The podcast fetch operation will write an appropriate item |
209
|
|
|
|
|
|
|
description for each podcast episode it mirrors. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item -playlist_base |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
If you are writing a playlist and mirroring the podcasts to a |
214
|
|
|
|
|
|
|
removable medium such as an sdcard for later use with a portable music |
215
|
|
|
|
|
|
|
player device, you will need to set this argument to the directory |
216
|
|
|
|
|
|
|
path to each podcast file as it will appear to the music player. For |
217
|
|
|
|
|
|
|
example, if you mount the medium at /mnt/sdcard and keep podcasts in |
218
|
|
|
|
|
|
|
/mnt/sdcard/podcasts, then the B<-base> and B<-playlist_base> options |
219
|
|
|
|
|
|
|
might look like this: |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
-base => '/mnt/sdcard/podcasts', |
222
|
|
|
|
|
|
|
-playlist_base => '/podcasts' |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
For Windows-based devices, you might have to specify a playlist_base |
225
|
|
|
|
|
|
|
using Windows filesystem conventions. |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=item -subdir |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
Ordinarily each podcast will be placed in a directory named after its |
230
|
|
|
|
|
|
|
channel, directly underneath the directory specified by "base." If |
231
|
|
|
|
|
|
|
this boolean is set to a partial path, then additional levels of |
232
|
|
|
|
|
|
|
directory will be placed between the base and the channel |
233
|
|
|
|
|
|
|
directory. For instance: |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
-base => '/tmp/podcasts', |
236
|
|
|
|
|
|
|
-subdir => 'News/Daily', |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Will place the channel's podcasts in '/tmp/podcasts/News/Daily/channel_name/' |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item -force_genre, -force_artist, -force_album |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
If B<-upgrade_tag> is set to true, then you can use these options to |
243
|
|
|
|
|
|
|
force the genre, artist and/or album to desired hard-coded values. By |
244
|
|
|
|
|
|
|
default, genre will be set to "Podcast", and artist and album will be |
245
|
|
|
|
|
|
|
dynamically determined from information provided by the RSS feed, such |
246
|
|
|
|
|
|
|
that the channel name becomes the album and the podcast author becomes |
247
|
|
|
|
|
|
|
the artist. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item -use_pub_date |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
If B<-use_pub_date> is set to true, then podcast files will have their |
252
|
|
|
|
|
|
|
modification times set to match the publication time specified in the |
253
|
|
|
|
|
|
|
RSS feed. Otherwise they will take retain the modification time they |
254
|
|
|
|
|
|
|
carry on the site they are downloaded from. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item -fetch_callback |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
If you provide a coderef to B<-fetch_callback> this routine will be |
259
|
|
|
|
|
|
|
invoked on every file fetched immediately after the file is |
260
|
|
|
|
|
|
|
created. It will be called with two arguments corresponding to the |
261
|
|
|
|
|
|
|
MP3::PodcastFetch object, and the complete path to the fetched file: |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
my $callback = sub { |
264
|
|
|
|
|
|
|
my ($feed,$filepath) = @_; |
265
|
|
|
|
|
|
|
print STDERR "$filepath successfully fetched\n"; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
$feed = MP3::PodcastFetch->new(-base => $base, |
269
|
|
|
|
|
|
|
-rss => $url, |
270
|
|
|
|
|
|
|
-fetch_callback => $callback); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=item -delete_callback |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
Similar to B<-fetch_callback> except that the passed coderef is called |
276
|
|
|
|
|
|
|
on every deleted file immediately after the file is deleted. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=back |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# arguments: |
283
|
|
|
|
|
|
|
# -base => base directory for podcasts, e.g. /var/podcasts |
284
|
|
|
|
|
|
|
# -subdir => subdirectory for this podcast, e.g. music |
285
|
|
|
|
|
|
|
# -override_channel_dir => directory to use instead of channel title |
286
|
|
|
|
|
|
|
# -rss => url of the RSS feed to read |
287
|
|
|
|
|
|
|
# -max => maximum number of episodes to keep |
288
|
|
|
|
|
|
|
# -timeout => timeout for URL requests |
289
|
|
|
|
|
|
|
# -mirror_mode => 'modified-since' (careful) or 'exists' (careless) |
290
|
|
|
|
|
|
|
# -rewrite_filename => rewrite file name with podcast title |
291
|
|
|
|
|
|
|
# -upgrade_tag => upgrade tags to v2.4 |
292
|
|
|
|
|
|
|
# -force_{genre,artist,album} => force set the genre, artist and/or album |
293
|
|
|
|
|
|
|
# -keep_old => keep old podcasts that are no longer in the RSS |
294
|
|
|
|
|
|
|
# -playlist_handle => file handle for playlist |
295
|
|
|
|
|
|
|
# -playlist_base => file system base to use for the playlists |
296
|
|
|
|
|
|
|
# -verbose => print status reports |
297
|
|
|
|
|
|
|
# -env_proxy => load proxy settings from environment variables |
298
|
|
|
|
|
|
|
# -use_pub_date => set the modtime of the downloaded podcast file to the RSS item's pubdate |
299
|
|
|
|
|
|
|
# -fetch_callback => subroutine to run for every fetched files |
300
|
|
|
|
|
|
|
# -delete_callback => subroutine to run for every deleted files |
301
|
|
|
|
|
|
|
# |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub new { |
305
|
4
|
|
|
4
|
0
|
4623
|
my $class = shift; |
306
|
4
|
|
|
|
|
20
|
my %args = @_; |
307
|
4
|
|
33
|
|
|
32
|
my $self = bless {},ref $class || $class; |
308
|
4
|
|
50
|
|
|
158
|
$self->base($args{-base} || '/tmp/podcasts'); |
309
|
4
|
|
|
|
|
128
|
$self->subdir($args{-subdir}); |
310
|
4
|
|
|
|
|
124
|
$self->override_channel_dir($args{-override_channel_dir}); |
311
|
4
|
|
33
|
|
|
131
|
$self->rss($args{-rss} || croak 'please provide -rss argument'); |
312
|
4
|
|
|
|
|
121
|
$self->max($args{-max} ); |
313
|
4
|
|
50
|
|
|
129
|
$self->timeout($args{-timeout} || 30 ); |
314
|
4
|
|
50
|
|
|
122
|
$self->mirror_mode($args{-mirror_mode} || 'exists' ); |
315
|
4
|
|
|
|
|
114
|
$self->verbose($args{-verbose} ); |
316
|
4
|
|
|
|
|
118
|
$self->env_proxy($args{-env_proxy} ); |
317
|
4
|
|
|
|
|
118
|
$self->rewrite_filename($args{-rewrite_filename} ); |
318
|
4
|
|
|
|
|
116
|
$self->upgrade_tags($args{-upgrade_tag} ); |
319
|
4
|
|
|
|
|
116
|
$self->keep_old($args{-keep_old} ); |
320
|
4
|
|
|
|
|
116
|
$self->playlist_handle($args{-playlist_handle} ); |
321
|
4
|
|
|
|
|
5713
|
$self->playlist_base($args{-playlist_base} ); |
322
|
4
|
|
|
|
|
130
|
$self->force_genre($args{-force_genre} ); |
323
|
4
|
|
|
|
|
119
|
$self->force_artist($args{-force_artist} ); |
324
|
4
|
|
|
|
|
117
|
$self->force_album($args{-force_artist} ); |
325
|
4
|
|
50
|
|
|
135
|
$self->fetch_callback( $args{-fetch_callback} || 'none' ); |
326
|
4
|
|
50
|
|
|
135
|
$self->delete_callback( $args{-delete_callback} || 'none' ); |
327
|
4
|
|
|
|
|
115
|
$self->force_album($args{-force_artist} ); |
328
|
4
|
|
|
|
|
134
|
$self->use_pub_date($args{-use_pub_date} ); |
329
|
4
|
|
|
|
|
11
|
$self->{tabs} = 1; |
330
|
4
|
|
|
|
|
9
|
$self->{files_fetched} = []; |
331
|
4
|
|
|
|
|
9
|
$self->{files_deleted} = []; |
332
|
4
|
|
|
|
|
19
|
$self; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=head2 Read/write accessors |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
The following are read/write accessors (get and/or set the |
338
|
|
|
|
|
|
|
corresponding option). Each takes the form: |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
$old_value = $feed->accessor([$new_value]) |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Where $new_value is optional. |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=over 4 |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=item $feed->base |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=item $feed->subdir |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item $feed->override_channel_dir |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item $feed->rss |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=item $feed->timeout |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=item $feed->mirror_mode |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=item $feed->verbose |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=item $feed->env_proxy |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=item $feed->rewrite_filename |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=item $feed->upgrade_tags |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=item $feed->keep_old |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=item $feed->playlist_handle |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=item $feed->playlist_base |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=item $feed->force_genre |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=item $feed->force_artist |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=item $feed->force_album |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=back |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=head2 Common methods |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
The following methods are commonly used in end-user scripts: |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=over 4 |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=item $feed->fetch_pods |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
Mirror the subscribed podcast episodes into the base directory |
389
|
|
|
|
|
|
|
specified in new(). After calling it, use the fetched() and errors() |
390
|
|
|
|
|
|
|
methods to find out how many podcasts were successfully mirrored and |
391
|
|
|
|
|
|
|
whether there were any errors. Use the fetched_files() method to get |
392
|
|
|
|
|
|
|
the names of the newly fetched podcasts. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=cut |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub fetch_pods { |
397
|
4
|
|
|
4
|
1
|
835
|
my $self = shift; |
398
|
4
|
50
|
|
|
|
124
|
my $url = $self->rss or croak 'No URL!'; |
399
|
4
|
50
|
|
|
|
39
|
my $parser = MP3::PodcastFetch::Feed->new($url) or croak "Couldn't create parser"; |
400
|
4
|
|
|
|
|
120
|
$parser->timeout($self->timeout); |
401
|
4
|
|
|
|
|
112
|
$parser->env_proxy($self->env_proxy); |
402
|
4
|
|
|
|
|
19
|
my @channels = $parser->read_feed; |
403
|
4
|
50
|
|
|
|
13
|
$self->log("Couldn't read RSS for $url: ",$parser->errstr) unless @channels; |
404
|
4
|
|
|
|
|
21
|
$self->update($_) foreach @channels; |
405
|
4
|
|
|
|
|
59
|
1; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=item @files = $feed->fetched_files |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
This method will return the complete paths to each of the podcast |
411
|
|
|
|
|
|
|
episodes successfully fetched by the proceeding call to fetch_pods(). |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=cut |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
sub fetched_files { |
416
|
2
|
|
|
2
|
1
|
4
|
return @{shift->{files_fetched}} |
|
2
|
|
|
|
|
12
|
|
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=item @files = $feed->deleted_files |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
This method will return the complete paths to each of the podcast |
422
|
|
|
|
|
|
|
episodes successfully deleted by the proceeding call to fetch_pods(). |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=cut |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub deleted_files { |
427
|
0
|
|
|
0
|
1
|
0
|
return @{shift->{files_deleted}} |
|
0
|
|
|
|
|
0
|
|
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item $feed->fetched |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
The number of episodes fetched/refreshed. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=item $feed->skipped |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
The number of episodes skipped. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item $feed->deleted |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
The number of episodes deleted because they are either no longer |
441
|
|
|
|
|
|
|
mentioned in the subscription file or exceed the per-feed limit. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=item $feed->errors |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
The number of episodes not fetched because of an error. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=back |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=cut |
450
|
|
|
|
|
|
|
|
451
|
4
|
|
100
|
4
|
1
|
41
|
sub fetched { shift->{stats}{fetched} ||= 0 } |
452
|
0
|
|
0
|
0
|
1
|
0
|
sub errors { shift->{stats}{error} ||= 0 } |
453
|
0
|
|
0
|
0
|
1
|
0
|
sub deleted { shift->{stats}{deleted} ||= 0 } |
454
|
4
|
|
100
|
4
|
1
|
34
|
sub skipped { shift->{stats}{skipped} ||= 0 } |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=head2 Internal Methods |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
These methods are intended for internal use cut can be overridden in |
459
|
|
|
|
|
|
|
subclasses in order to change their behavior. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=over 4 |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=item $feed->update($channel) |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
Update all episodes contained in the indicated |
466
|
|
|
|
|
|
|
MP3::PodcastFetch::Feed::Channel object (this object is generated by |
467
|
|
|
|
|
|
|
podcast_fetch() in the course of downloading and parsing the RSS file. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=cut |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub update { |
472
|
4
|
|
|
4
|
1
|
8
|
my $self = shift; |
473
|
4
|
|
|
|
|
6
|
my $channel = shift; |
474
|
4
|
|
|
|
|
97
|
my $title = $channel->title; |
475
|
4
|
|
|
|
|
100
|
my $description = $channel->description; |
476
|
4
|
|
|
|
|
35
|
my $dir = $self->generate_directory($channel); |
477
|
4
|
|
|
|
|
23
|
my @items = sort {$b->timestamp <=> $a->timestamp} grep {$_->url} $channel->items; |
|
12
|
|
|
|
|
1841
|
|
|
12
|
|
|
|
|
281
|
|
478
|
4
|
|
|
|
|
884
|
my $total = @items; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# if there are more items than we want, then remove the oldest ones |
481
|
4
|
50
|
|
|
|
138
|
if (my $max = $self->max) { |
482
|
0
|
0
|
|
|
|
0
|
splice(@items,$max) if @items > $max; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
4
|
|
|
|
|
96
|
$self->log("$title: $total podcasts available. Mirroring ",scalar @items,"..."); |
486
|
|
|
|
|
|
|
{ |
487
|
4
|
|
|
|
|
7
|
$self->{tabs}++; # for formatting |
|
4
|
|
|
|
|
8
|
|
488
|
4
|
|
|
|
|
18
|
$self->mirror($dir,\@items,$channel); |
489
|
4
|
|
|
|
|
106
|
$self->{tabs}--; # for formatting |
490
|
|
|
|
|
|
|
} |
491
|
4
|
|
|
|
|
16
|
1; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item $feed->bump_fetched($value) |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
=item $feed->bump_error($value) |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=item $feed->bump_deleted($value) |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item $feed->bump_skipped($value) |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Increase the fetched, error, deleted and skipped counters by $value, |
503
|
|
|
|
|
|
|
or by 1 if not specified. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=cut |
506
|
|
|
|
|
|
|
|
507
|
6
|
50
|
|
6
|
1
|
29
|
sub bump_fetched {shift->{stats}{fetched} += (@_ ? shift : 1)} |
508
|
0
|
0
|
|
0
|
1
|
0
|
sub bump_error {shift->{stats}{error} += (@_ ? shift : 1)} |
509
|
0
|
0
|
|
0
|
1
|
0
|
sub bump_deleted {shift->{stats}{deleted} += (@_ ? shift : 1)} |
510
|
6
|
50
|
|
6
|
1
|
18
|
sub bump_skipped {shift->{stats}{skipped} += (@_ ? shift : 1)} |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=item $feed->mirror($dir,$items,$channel) |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Mirror a list of podcast episodes into the indicated directory. $dir |
515
|
|
|
|
|
|
|
is the absolute path to the directory to mirror the episodes into, |
516
|
|
|
|
|
|
|
$items is an array ref of MP3::PodcastFetch::Feed::Item objects, and |
517
|
|
|
|
|
|
|
$channel is a MP3::PodcastFetch::Feed::Channel object. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=cut |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub mirror { |
522
|
4
|
|
|
4
|
1
|
5
|
my $self = shift; |
523
|
4
|
|
|
|
|
8
|
my ($dir,$items,$channel) = @_; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# generate a directory listing of the directory |
526
|
4
|
|
|
|
|
8
|
my %current_files; |
527
|
4
|
|
|
|
|
33
|
my $curdir = getcwd(); |
528
|
4
|
50
|
|
|
|
76
|
chdir($dir) or croak "Couldn't changedir to $dir: $!"; |
529
|
4
|
50
|
|
|
|
40
|
my $d = IO::Dir->new('.') or croak "Couldn't open directory $dir for reading: $!"; |
530
|
4
|
|
|
|
|
383
|
while (my $file = $d->read) { |
531
|
14
|
100
|
|
|
|
234
|
next if $file eq '..'; |
532
|
10
|
100
|
|
|
|
25
|
next if $file eq '.'; |
533
|
6
|
|
|
|
|
24
|
$current_files{$file}++; |
534
|
|
|
|
|
|
|
} |
535
|
4
|
|
|
|
|
44
|
$d->close; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# generate a list of the basenames of the items |
538
|
4
|
|
|
|
|
88
|
my %to_fetch; |
539
|
4
|
|
|
|
|
10
|
for my $i (@$items) { |
540
|
12
|
|
|
|
|
261
|
my $url = $i->url; |
541
|
12
|
|
|
|
|
303
|
my $basename = $self->make_filename($url,$i->title); |
542
|
12
|
|
|
|
|
94
|
$to_fetch{$basename}{url} = $url; |
543
|
12
|
|
|
|
|
36
|
$to_fetch{$basename}{item} = $i; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
# find files that are no longer on the subscription list |
547
|
4
|
|
|
|
|
16
|
my @goners = grep {!$to_fetch{$_}} keys %current_files; |
|
6
|
|
|
|
|
14
|
|
548
|
|
|
|
|
|
|
|
549
|
4
|
50
|
|
|
|
118
|
if ($self->keep_old) { |
550
|
0
|
|
|
|
|
0
|
my $max = $self->max; |
551
|
0
|
0
|
|
|
|
0
|
if (@goners + keys %to_fetch > $max) { |
552
|
0
|
|
|
|
|
0
|
$self->log_error("The episode limit of $max has been reached. Will not fetch additional podcasts."); |
553
|
0
|
|
|
|
|
0
|
return; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
else { |
557
|
4
|
|
|
|
|
11
|
foreach my $fn ( @goners ) { |
558
|
0
|
|
|
|
|
0
|
my $gone = unlink $fn; |
559
|
0
|
|
|
|
|
0
|
$self->bump_deleted($gone); |
560
|
0
|
0
|
|
|
|
0
|
if ( ref $self->delete_callback eq 'CODE' ) { |
561
|
0
|
|
|
|
|
0
|
&{$self->delete_callback}( $self, $fn ); |
|
0
|
|
|
|
|
0
|
|
562
|
|
|
|
|
|
|
} |
563
|
0
|
|
|
|
|
0
|
$self->log("$fn: deleted"); |
564
|
0
|
|
|
|
|
0
|
push @{$self->{files_deleted}}, $fn; |
|
0
|
|
|
|
|
0
|
|
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# use LWP to mirror the remainder |
569
|
4
|
|
|
|
|
36
|
my $ua = LWP::UserAgent->new; |
570
|
4
|
50
|
|
|
|
1015
|
$ua->env_proxy if $self->env_proxy; |
571
|
4
|
|
|
|
|
113
|
$ua->timeout($self->timeout); |
572
|
4
|
|
|
|
|
60
|
for my $basename (sort keys %to_fetch) { |
573
|
12
|
|
|
|
|
47
|
$self->mirror_url($ua,$to_fetch{$basename}{url},$basename,$to_fetch{$basename}{item},$channel); |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
4
|
|
|
|
|
164
|
chdir ($curdir); |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=item $feed->mirror_url($ua,$url,$filename,$item,$channel) |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Fetch a single podcast episode. Arguments are: |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
$ua An LWP::UserAgent object |
584
|
|
|
|
|
|
|
$url The URL of the podcast episode to mirror |
585
|
|
|
|
|
|
|
$filename The local filename for the episode (may already exist) |
586
|
|
|
|
|
|
|
$item The corresponding MP3::PodcastFetch::Feed::Item object |
587
|
|
|
|
|
|
|
$channel The corresponding MP3::PodcastFetch::Feed::Channel object |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=cut |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
sub mirror_url { |
592
|
12
|
|
|
12
|
1
|
15
|
my $self = shift; |
593
|
12
|
|
|
|
|
26
|
my ($ua,$url,$filename,$item,$channel) = @_; |
594
|
|
|
|
|
|
|
|
595
|
12
|
|
|
|
|
326
|
my $mode = $self->mirror_mode; |
596
|
12
|
50
|
33
|
|
|
35
|
croak "invalid mirror mode $mode" unless $mode eq 'exists' or $mode eq 'modified-since'; |
597
|
|
|
|
|
|
|
|
598
|
12
|
|
|
|
|
238
|
my $title = $item->title; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# work around buggy servers that don't respect if-modified-since |
601
|
12
|
100
|
66
|
|
|
277
|
if ($mode eq 'exists' && -e $filename) { |
602
|
6
|
|
|
|
|
19
|
$self->log("$title: skipped"); |
603
|
6
|
|
|
|
|
15
|
$self->bump_skipped; |
604
|
6
|
|
|
|
|
16
|
return; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
|
607
|
6
|
|
|
|
|
31
|
my $response = $ua->mirror($url,$filename); |
608
|
6
|
50
|
|
|
|
14721
|
if ($response->is_error) { |
609
|
0
|
|
|
|
|
0
|
$self->log_error("$url: ",$response->status_line); |
610
|
0
|
|
|
|
|
0
|
$self->bump_error; |
611
|
0
|
|
|
|
|
0
|
return; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
6
|
50
|
|
|
|
68
|
if ($response->code eq RC_NOT_MODIFIED) { |
615
|
0
|
|
|
|
|
0
|
$self->bump_skipped; |
616
|
0
|
|
|
|
|
0
|
$self->log("$title: skipped"); |
617
|
0
|
|
|
|
|
0
|
return; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
6
|
50
|
|
|
|
72
|
if ($response->code eq RC_OK) { |
621
|
6
|
|
|
|
|
66
|
my $length = $response->header('Content-Length'); |
622
|
6
|
|
|
|
|
259
|
my $size = -s $filename; |
623
|
|
|
|
|
|
|
|
624
|
6
|
50
|
33
|
|
|
34
|
if (defined $length && $size < $length) { |
625
|
0
|
|
|
|
|
0
|
$self->log("$title: ","INCOMPLETE. $size/$length bytes fetched (will retry later)"); |
626
|
0
|
|
|
|
|
0
|
unlink $filename; |
627
|
0
|
|
|
|
|
0
|
$self->bump_error; |
628
|
|
|
|
|
|
|
} else { |
629
|
6
|
|
|
|
|
25
|
$self->fix_tags($filename,$item,$channel); |
630
|
6
|
|
|
|
|
28
|
$self->write_playlist($filename,$item,$channel); |
631
|
6
|
|
|
|
|
21
|
$self->bump_fetched; |
632
|
6
|
|
|
|
|
23
|
$self->add_file($filename,$item,$channel); |
633
|
|
|
|
|
|
|
|
634
|
6
|
50
|
|
|
|
18
|
if ( $mode eq 'exists' ) { |
635
|
|
|
|
|
|
|
# |
636
|
|
|
|
|
|
|
# change time stamp to pub date ( for dinamic url ) |
637
|
|
|
|
|
|
|
# |
638
|
6
|
|
|
|
|
128
|
my $pubdate = $item->pubDate; |
639
|
6
|
50
|
|
|
|
52
|
my $secs = $pubdate ? str2time($pubdate) : 0; |
640
|
6
|
50
|
|
|
|
1525
|
if ( $secs ) { |
641
|
6
|
|
|
|
|
103
|
utime $secs, $secs, $filename; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
} |
644
|
6
|
|
|
|
|
31
|
$self->log("$title: $size bytes fetched"); |
645
|
|
|
|
|
|
|
} |
646
|
6
|
|
|
|
|
92
|
return; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
0
|
|
|
|
|
0
|
$self->log("$title: unrecognized response code ",$response->code); |
650
|
0
|
|
|
|
|
0
|
$self->bump_error; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=item $feed->log(@msg) |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
Log the strings provided in @msg to STDERR. Logging is controlled by |
656
|
|
|
|
|
|
|
the -verbose setting. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=cut |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
sub log { |
661
|
16
|
|
|
16
|
1
|
21
|
my $self = shift; |
662
|
16
|
|
|
|
|
30
|
my @msg = @_; |
663
|
16
|
50
|
|
|
|
454
|
return unless $self->verbose; |
664
|
0
|
|
0
|
|
|
0
|
my $tabs = $self->{tabs} || 0; |
665
|
0
|
|
0
|
|
|
0
|
foreach (@msg) { $_ ||= '' } # get rid of uninit variables |
|
0
|
|
|
|
|
0
|
|
666
|
0
|
|
|
|
|
0
|
chomp @msg; |
667
|
0
|
|
|
|
|
0
|
warn "\t"x$tabs,@msg,"\n"; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=item $feed->log_error(@msg) |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Log the errors provided in @msg to STDERR. Logging occurs even if |
673
|
|
|
|
|
|
|
-verbose is false. |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=cut |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
sub log_error { |
678
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
679
|
0
|
|
|
|
|
0
|
my @msg = @_; |
680
|
0
|
|
0
|
|
|
0
|
my $tabs = $self->{tabs} || 0; |
681
|
0
|
|
0
|
|
|
0
|
foreach (@msg) { $_ ||= '' } # get rid of uninit variables |
|
0
|
|
|
|
|
0
|
|
682
|
0
|
|
|
|
|
0
|
chomp @msg; |
683
|
0
|
|
|
|
|
0
|
warn "\t"x$tabs,"*ERROR* ",@msg,"\n"; |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=item $feed->add_file($path) |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Record that we successfully mirrored the podcast episode indicated by $path. |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=cut |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
sub add_file { |
693
|
6
|
|
|
6
|
1
|
8
|
my $self = shift; |
694
|
6
|
|
|
|
|
12
|
my ($filename,$item,$channel) = @_; |
695
|
6
|
|
|
|
|
19
|
my $dir = $self->generate_directory($channel); |
696
|
6
|
|
|
|
|
55
|
my $fn = File::Spec->catfile($dir,$filename); |
697
|
6
|
|
|
|
|
11
|
push @{$self->{files_fetched}},$fn; |
|
6
|
|
|
|
|
15
|
|
698
|
|
|
|
|
|
|
|
699
|
6
|
50
|
|
|
|
172
|
if ( ref $self->fetch_callback eq 'CODE' ) { |
700
|
0
|
|
|
|
|
0
|
&{$self->fetch_callback}( $self, $fn ); |
|
0
|
|
|
|
|
0
|
|
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=item $feed->write_playlist($filename,$item,$channel) |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Write an entry into the current playlist indicating that $filename is |
707
|
|
|
|
|
|
|
ready to be listened to. $item and $channel are the |
708
|
|
|
|
|
|
|
MP3::PodcastFetch::Feed::Item and Channel objects respectively. |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=cut |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
sub write_playlist { |
713
|
6
|
|
|
6
|
1
|
13
|
my $self = shift; |
714
|
6
|
|
|
|
|
11
|
my ($filename,$item,$channel) = @_; |
715
|
6
|
50
|
|
|
|
179
|
my $playlist = $self->playlist_handle or return; |
716
|
0
|
|
|
|
|
0
|
my $title = $item->title; |
717
|
0
|
|
|
|
|
0
|
my $album = $channel->title; |
718
|
0
|
|
|
|
|
0
|
my $duration = $self->get_duration($filename,$item); |
719
|
0
|
|
0
|
|
|
0
|
my $base = $self->playlist_base || $self->base; |
720
|
0
|
|
|
|
|
0
|
my $subdir = $self->subdir; |
721
|
0
|
|
|
|
|
0
|
my $dir = $self->channel_dir($channel); |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
# This is dodgy. We may be writing the podcast files onto a Unix mounted SD card |
724
|
|
|
|
|
|
|
# and reading it on a Windows-based MP3 player. We try to guess whether the base |
725
|
|
|
|
|
|
|
# is a Unix or a Windows base. We assume that OSX will work OK. |
726
|
0
|
|
|
|
|
0
|
my $path; |
727
|
0
|
0
|
0
|
|
|
0
|
if ($base =~ m!^[A-Z]:\\! or $base =~ m!\\!) { # Windows style path |
728
|
0
|
0
|
|
|
|
0
|
eval { require File::Spec::Win32 } unless File::Spec::Win32->can('catfile'); |
|
0
|
|
|
|
|
0
|
|
729
|
0
|
|
|
|
|
0
|
$path = File::Spec::Win32->catfile($base,$subdir,$dir,$filename); |
730
|
|
|
|
|
|
|
} else { # Unix style path |
731
|
0
|
0
|
|
|
|
0
|
eval { require File::Spec::Unix } unless File::Spec::Unix->can('catfile'); |
|
0
|
|
|
|
|
0
|
|
732
|
0
|
|
|
|
|
0
|
$path = File::Spec::Unix->catfile($base,$subdir,$dir,$filename); |
733
|
|
|
|
|
|
|
} |
734
|
0
|
|
|
|
|
0
|
print $playlist "#EXTINF:$duration,$album: $title\r\n"; |
735
|
0
|
|
|
|
|
0
|
print $playlist $path,"\r\n"; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=item $feed->fix_tags($filename,$item,$channel) |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Fix the ID3 tags in the newly-downloaded podcast episode indicated by |
741
|
|
|
|
|
|
|
$filename. $item and $channel are the MP3::PodcastFetch::Feed::Item |
742
|
|
|
|
|
|
|
and Channel objects respectively. |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=cut |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
sub fix_tags { |
747
|
6
|
|
|
6
|
1
|
14
|
my $self = shift; |
748
|
6
|
|
|
|
|
9
|
my ($filename,$item,$channel) = @_; |
749
|
|
|
|
|
|
|
|
750
|
6
|
|
|
|
|
64
|
my $mtime = (stat($filename))[9]; |
751
|
6
|
|
|
|
|
190
|
my $pubdate = $item->pubDate; |
752
|
6
|
50
|
|
|
|
125
|
my $secs = $pubdate ? str2time($pubdate) : $mtime; |
753
|
|
|
|
|
|
|
|
754
|
6
|
50
|
|
|
|
1806
|
if ($self->upgrade_tags ne 'no') { |
755
|
6
|
|
|
|
|
119
|
my $year = (localtime($secs))[5]+1900; |
756
|
6
|
|
33
|
|
|
186
|
my $album = $self->force_album || $channel->title; |
757
|
6
|
|
33
|
|
|
209
|
my $artist = $self->force_artist || $channel->author; |
758
|
6
|
|
|
|
|
171
|
my $comment = $channel->description; |
759
|
6
|
50
|
|
|
|
53
|
$comment .= " " if $comment; |
760
|
6
|
|
|
|
|
12
|
$comment .= "[Fetched with podcast_fetch.pl (c) 2006 Lincoln D. Stein]"; |
761
|
6
|
|
50
|
|
|
166
|
my $genre = $self->force_genre || 'Podcast'; |
762
|
|
|
|
|
|
|
|
763
|
6
|
|
|
|
|
11
|
eval { |
764
|
6
|
|
|
|
|
57
|
MP3::PodcastFetch::TagManager->new()->fix_tags($filename, |
765
|
|
|
|
|
|
|
{title => $item->title, |
766
|
|
|
|
|
|
|
genre => $genre, |
767
|
|
|
|
|
|
|
year => $year, |
768
|
|
|
|
|
|
|
artist => $artist, |
769
|
|
|
|
|
|
|
album => $album, |
770
|
|
|
|
|
|
|
comment=> $comment, |
771
|
|
|
|
|
|
|
}, |
772
|
|
|
|
|
|
|
$self->upgrade_tags, |
773
|
|
|
|
|
|
|
); |
774
|
|
|
|
|
|
|
}; |
775
|
6
|
50
|
|
|
|
40
|
$self->log_error($@) if $@; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
6
|
50
|
|
|
|
169
|
if ($self->use_pub_date) { |
779
|
0
|
|
|
|
|
0
|
utime $secs,$secs,$filename; # make the modification time match the pubtime |
780
|
|
|
|
|
|
|
} else { |
781
|
6
|
|
|
|
|
128
|
utime $mtime,$mtime,$filename; # keep the modification times mirroring the web site |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=item $duration = $feed->get_duration($filename,$item) |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
This method is used to provide extended information for .m3u |
788
|
|
|
|
|
|
|
playlists. |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
Get the duration, in seconds, of the podcast episode given by |
791
|
|
|
|
|
|
|
$filename. If an ID3 tagging library is available, the duration will |
792
|
|
|
|
|
|
|
be calculated from the MP3 file directory. Otherwise, it will fall |
793
|
|
|
|
|
|
|
back to using the duration specified by the RSS feed's |
794
|
|
|
|
|
|
|
MP3::PodcastFetch::Feed::Item object. Many RSS feeds do not specify |
795
|
|
|
|
|
|
|
the duration, in which case get_duration() will return 0. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=cut |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
sub get_duration { |
800
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
801
|
0
|
|
|
|
|
0
|
my ($filename,$item) = @_; |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
0
|
my $duration = MP3::PodcastFetch::TagManager->new()->get_duration($filename); |
804
|
0
|
0
|
0
|
|
|
0
|
$duration = $item->duration || 0 unless defined $duration; |
805
|
0
|
|
|
|
|
0
|
return $duration; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item $filename = $feed->make_filename($url,$title) |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Create a filename for the episode located at $url based on its $title |
811
|
|
|
|
|
|
|
or the last component of the URL, depending on -rewrite_filename |
812
|
|
|
|
|
|
|
argument provided to new(). |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=cut |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
sub make_filename { |
817
|
12
|
|
|
12
|
1
|
79
|
my $self = shift; |
818
|
12
|
|
|
|
|
19
|
my ($url,$title) = @_; |
819
|
|
|
|
|
|
|
|
820
|
12
|
50
|
|
|
|
365
|
if ($self->rewrite_filename eq 'md5' ) { |
|
|
100
|
|
|
|
|
|
821
|
0
|
|
|
|
|
0
|
my $md5 = md5_hex( $url ); |
822
|
0
|
|
|
|
|
0
|
$url =~ s#([^\?]+).*#$1#; |
823
|
0
|
|
|
|
|
0
|
my ($extension) = $url =~ /\.(\w+)$/; |
824
|
0
|
0
|
|
|
|
0
|
if ( defined $extension ) { |
825
|
0
|
|
|
|
|
0
|
return $self->safestr($md5) . ".$extension"; |
826
|
|
|
|
|
|
|
} else { |
827
|
0
|
|
|
|
|
0
|
return $self->safestr($md5); |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
} elsif ($self->rewrite_filename) { |
830
|
6
|
|
|
|
|
31
|
my ($extension) = $url =~ /\.(\w+)$/; |
831
|
6
|
|
|
|
|
15
|
my $name = $self->safestr($title); |
832
|
6
|
50
|
|
|
|
20
|
$name .= ".$extension" if defined $extension; |
833
|
6
|
|
|
|
|
13
|
return $name; |
834
|
|
|
|
|
|
|
} else { |
835
|
6
|
|
|
|
|
247
|
return uri_unescape( basename($url) ); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=item $path = $feed->generate_directory($channel) |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
Create a directory for the channel specified by the provided |
842
|
|
|
|
|
|
|
MP3::PodcastFetch::Feed::Channel object, respecting the values of |
843
|
|
|
|
|
|
|
-base and -subdir. The path is created in an OS-independent way, using |
844
|
|
|
|
|
|
|
File::Spec->catfile(). The directory will be created if it doesn't |
845
|
|
|
|
|
|
|
already exist. If it already exists and is not writeable, the method |
846
|
|
|
|
|
|
|
errors out. |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=cut |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sub generate_directory { |
851
|
10
|
|
|
10
|
1
|
14
|
my $self = shift; |
852
|
10
|
|
|
|
|
15
|
my $channel = shift; |
853
|
10
|
|
50
|
|
|
289
|
my $dir = File::Spec->catfile($self->base,$self->subdir||'',$self->channel_dir($channel)); |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
# create the thing |
856
|
10
|
100
|
|
|
|
358
|
unless (-d $dir) { |
857
|
2
|
50
|
|
|
|
670
|
mkpath($dir) or croak "Couldn't create directory $dir: $!"; |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
10
|
50
|
|
|
|
206
|
-w $dir or croak "Can't write to directory $dir"; |
861
|
10
|
|
|
|
|
28
|
return $dir; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item $dirname = $feed->channel_dir($channel) |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Generate a directory named based on the provided channel object's title, |
867
|
|
|
|
|
|
|
unless it is overriden by B<-override_channel_dir> value. |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=cut |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
sub channel_dir { |
872
|
10
|
|
|
10
|
1
|
54
|
my $self = shift; |
873
|
10
|
|
|
|
|
15
|
my $channel = shift; |
874
|
|
|
|
|
|
|
|
875
|
10
|
|
33
|
|
|
1213
|
my $dir = $self->override_channel_dir || $channel->title; |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
return |
878
|
10
|
|
|
|
|
99
|
$self->safestr( $dir ); # potential bug here -- what if two podcasts have same title? |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item $safe_str = $feed->safe_str($unsafe_str) |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
This method generates OS-safe path components from channel and podcast |
884
|
|
|
|
|
|
|
titles. It replaces whitespace and other odd characters with |
885
|
|
|
|
|
|
|
underscores. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=back |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=cut |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub safestr { |
892
|
16
|
|
|
16
|
0
|
24
|
my $self = shift; |
893
|
16
|
|
|
|
|
27
|
my $str = shift; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# turn runs of spaces into _ characters |
896
|
16
|
|
|
|
|
29
|
$str =~ tr/ /_/s; |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
# get rid of odd characters |
899
|
16
|
|
|
|
|
31
|
$str =~ tr/a-zA-Z0-9_+^.%$@=,\\-//cd; |
900
|
|
|
|
|
|
|
|
901
|
16
|
|
|
|
|
191
|
return $str; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
1; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
__END__ |