File Coverage

lib/MP3/PodcastFetch.pm
Criterion Covered Total %
statement 297 369 80.4
branch 79 132 59.8
condition 20 62 32.2
subroutine 54 61 88.5
pod 39 45 86.6
total 489 669 73.0


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__