Files that have uppercase .MP3 are probably just mundane .mp3 files but
[podcast-perl:podcast.git] / podcast
1 #!/usr/bin/perl
2
3 # Copyright (C) 2005 Eric Richardson (sark) <e@ericrichardson.com>
4 #   This string:
5 #      eScripting: push(@the_masses, $eWorld->GPL_tools); http://escripting.com
6 #
7 #  Found at: http://web.archive.org/web/20070515075025/www.escripting.com/podcast/
8 #
9 #  Seems to indicate that Eric's copyrights are licensed GPLv2-or-later.
10 #  I have emailed Eric for clarification as well.
11 #
12 # Copyright (C) 2006, 2007, 2008, 2009, 2010 Bradley M. Kuhn <bkuhn@ebb.org>
13 #
14 #   This software's license gives you freedom; you can copy, convey,
15 #   propagate, redistribute and/or modify this program under the terms of
16 #   the GNU General Public License (GPL) as published by the Free Software
17 #   Foundation (FSF), either version 3 of the License, or (at your option)
18 #   any later version of the AGPL published by the FSF.
19 #
20 #   This program is distributed in the hope that it will be useful, but
21 #   WITHOUT ANY WARRANTY; without even the implied warranty of
22 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23 #   Affero General Public License for more details.
24 #
25 #   You should have received a copy of the GNU General Public License
26 #   along with this program in a file in the toplevel directory called
27 #   "GPLv3".  If not, see <http://www.gnu.org/licenses/>.
28
29
30 my $OGG_QUALITY = 5;
31 #use XML::RAI;
32 use XML::DOM;
33 use XML::Simple;
34
35 use URI::Fetch;
36
37 use Cache::File;
38
39 use DateTime;
40 use DateTime::Format::HTTP;
41
42 #use MP3::Mplib;
43
44 use Storable;
45
46 use strict;
47 use vars qw( $cfg $config $args $parser $cache );
48
49 $cfg = {
50         config  => "/home/bkuhn/Files/Audio/Programs/podcast/config",
51 };
52
53 #----------
54 open(DOWNLOAD_LIST, ">>downloaded.list") or die "unable to open downloadedlist: $!";
55 open(NEW_LIST, ">>new.m3u") or die "unable to open new.m3u: $!";
56 {
57         $parser = new XML::DOM::Parser;
58 #       $parser = new XML::RSS::Parser;
59
60         # -- open our config file -- #
61         
62         $config = XML::Simple::XMLin($cfg->{config});
63
64         # -- open our cache -- #
65         
66         $cache = Cache::File->new( cache_root => $config->{cache} );
67         
68         # -- run through our feeds -- #
69         while ( my ($n,$f) = each %{ $config->{feed} } ) {
70                 next if ( $f->{disabled} );
71                 my $subdir = $config->{local} . '/' . $f->{subdir};
72                 mkdir($subdir) unless -d $subdir;
73                 
74                 warn "feed name: $n\n";
75                 print "URL $f->{url}\n";
76                 my $rss = URI::Fetch->fetch( $f->{url} , 
77                         (Cache  => $cache)
78                  ) or die URI::Fetch->errstr();
79
80                 if ( $rss->status == URI::Fetch::URI_OK() ) {
81                         # go on to main handling
82                         my $items = &parse_feed( $f , $rss );
83                         &handle_items( $f , $items );
84                 } elsif ( $rss->status == URI::Fetch::URI_NOT_MODIFIED() ) {
85                         # do nothing
86                 } elsif ( $rss->status == URI::Fetch::URI_MOVED_PERMANENTLY() ) {
87                         # we need to update the config file
88                         warn "\n\nMOVING RSS URL FOR $n\nURI: ".$rss->uri."\n";
89                         $f->{oldurl} = $f->{url};
90                         $f->{url} = $rss->uri;
91                 } elsif ( $rss->status == URI::Fetch::URI_GONE() ) {
92                         # we'll disable it in the config file, but leave it in there
93                         $f->{ disabled } = 1;
94                 } else {
95                         die "odd status code: $rss->status\n";
96                 }
97         }
98 }
99
100 #----------
101
102 sub parse_feed {
103         my ($f,$rss) = @_;
104
105         my $content = $rss->content;
106
107         my $xml = $parser->parse($rss->content,ProtocolEncoding=>"ISO-8859-1");
108
109         # -- parse through items in the feed -- #
110
111         my $items = [];
112
113         foreach my $item ( $xml->getElementsByTagName('item') ) {
114                 # -- first we'll make a hash with title/desc/etc -- #
115                 my $info = {};
116                 foreach my $c ( $item->getChildNodes ) {
117                         next if ($c->getNodeName !~ /
118                                 ^(
119                                         title
120                                         | link
121                                         | description
122                                         | pubdate
123                                         | dc:date
124                                         | dcterms:created
125                                 )
126                         /ix);
127
128                         my $name = $1;
129                         my $text;
130                         eval {
131                             $text = $c->getFirstChild->getData;
132                         };
133                         if ($@) {
134                             if ($name eq "description") {
135                                 $text = "Empty Description!";
136                             } else {
137                                 die "Unable to find contents in $name: $@"
138                             }
139                         }
140                         # clean it up a bit
141                         $text =~ s!(?:^\s+|\s+$)!!g;
142
143                         $info->{ lc($name) } = $text;
144                 }
145
146                 # -- now handle some preferred fields -- #
147
148                 foreach my $a (
149                         ['created','dcterms:created','dc:date','pubdate']
150                 ) {
151                         my $f = shift @$a;
152                         foreach my $p (@$a) {
153                                 next if (!$info->{$p});
154                                 $info->{$f} = $info->{$p};
155                                 last;
156                         }
157                 }
158
159                 # -- now handle the enclosure -- #
160                 {
161                         my $elist = $item->getElementsByTagName('enclosure');
162
163                         # this list should only have one member
164                         warn "item has more than one enclosure?\n" 
165                                 if ($elist->getLength > 1);
166
167                         my $enc = $elist->item(0);
168
169                         if ($enc) {
170                                 my $ei = $info->{enclosure} = {};
171
172                                 my $attributes = $enc->getAttributes;
173                                 if ($attributes) {
174                                         for my $i ( 0 .. $attributes->getLength-1 ) {
175                                                 my $attr = $attributes->item($i);
176                                                 $ei->{ lc($attr->getName) } = $attr->getValue;
177                                         }
178                                 }
179                         } else {
180                                 # boo...  item has no audio
181                         }
182                 }
183
184                 push @$items , $info;
185         }
186
187         return $items;
188 }
189
190 #----------
191
192 sub handle_items {
193         my ($f,$items) = @_;
194
195         # -- find out what files we already know about -- #
196
197         my $known;
198         if ( my $blob = $cache->get( "known_files." . $f->{url} ) ) {
199                 $known = Storable::thaw( $blob );
200         } else {
201                 $known = [];
202         }
203
204         # -- get new files -- #
205
206         my $current = [];
207
208         # we assume that the podcast feed is always going to have our newest 
209         # file(s), so we start there with the idea that if we don't reach our 
210         # count we'll keep around a couple we already know
211
212         {
213                 my $c = 0;
214                 foreach my $i (@$items) {
215                         $i->{created} =~ s/\s+EDT\s*$/ -0400/;
216                         $i->{created} =~ s/\s+EST\s*$/ -0500/;
217                         $i->{created} =~
218                   s/^\s*([SMTWF][a-z][a-z]\s*,)\s+(\w{3,3})\s+(\d+)/$1 $3 $2/;
219                         $i->{created} =~
220                   s/^\s*([SMTWF][a-z][a-z]\s*,)\s+(\w{3,3})\s+(\d+)/$1 $3 $2/;
221                         my $date;
222 eval {
223                         $date 
224                                 = DateTime::Format::HTTP->parse_datetime($i->{created});
225
226 };
227   if ($@) {
228     use Date::Manip;
229     $date = ($i->{created} =~ /^\s*$/) ? ParseDate('today')
230                                        : ParseDate($i->{created});
231     if ($date eq "") {
232         # Ok, still having trouble and we have something in created.
233         # Sometimes they have brain-dead dates like: Sun 27 Oct 2007
234         # 2:53:17 PM, but the 27th wasn't a sunday.  Parse that up.
235
236         $i->{created} =~ s/^((Sun|Mon|Tue|Wed|Thu|Fri|Sat)([A-Za-z]*\s*,?)?\s+)(\d+)/$4/;
237         $date = ($i->{created} =~ /^\s*$/) ? ParseDate('today')
238             : ParseDate($i->{created});
239     }
240     $date = DateTime::Format::HTTP->parse_datetime(UnixDate($date, "%a, %d %b %Y %T %z"));
241   }
242 #                       print "date: " . $date->strftime("%Y/%m/%d") . "\n";
243
244                         if ($i->{enclosure} && $c < $f->{count}) {
245                                 if ( &download_audio($f,$i,$date) ) {
246                                         warn "onto current: " . &local_file_from_url($i) . "\n";
247                                         push @$current, [ $date->epoch , &local_file_from_url($i) ];
248                                         $c++;
249                                 } else {
250                                         # nothing
251                                 }
252                         } else {
253                                 # no audio or we've reached our limit   
254                         }
255                 }
256                 # sort them by date
257                 # map curent files to filenames
258                 my $files = {};
259                 %$files = map { $_->[1] => 1 }  @$current;
260
261                 # -- fill in missing current files -- #
262
263                 if ($c < $f->{count}) {
264                         foreach my $k (@$known) {
265                                 next if ($files->{ $k->[1] });
266                                 warn "adding $k->[1] to current\n";
267                                 push @$current, $k;
268                                 $c++;
269                                 last unless ($c < $f->{count});
270                         }
271                 }
272
273                 # (refresh) map curent files to filenames
274                 %$files = map { $_->[1] => 1 } @$current;
275
276                 # -- delete old known files -- #
277
278                 foreach my $k (@$known) {
279                         # skip it if the file name's in current
280                         next if ($files->{ $k->[1] });
281
282                         my $lfile = $config->{local} . "/" . $f->{subdir} . '/' .
283                           $k->[1];
284                         # if it's not, out it goes
285                         warn "deleting $lfile\n";
286                         unlink($lfile) or warn "Unable to delete $lfile: $!";
287                         #`rm $lfile`;
288                 }
289         }
290         # -- store a list of what we know -- #
291
292         $cache->set( "known_files." . $f->{url} , Storable::nfreeze( $current ) );
293         
294         return 1;
295 }
296
297 #----------
298
299 sub buildFileNames {
300   my ($file, $f, $date) = @_;
301   my $androidFile = $file;
302   $androidFile =~ s%^.+/([^/]+)%$1%;
303   $androidFile = $date . "_" . $f->{subdir} ."_". $androidFile;
304   my $newFileName = $config->{local} . "/" . $f->{subdir} . '/' . $androidFile;
305 #  $newFileName .= "_" . $info{TRACKNUMBER} if defined $info{TRACKNUMBER};
306   return ($androidFile, $newFileName);
307 }
308
309 sub download_audio {
310   my ($f,$i,$date) = @_;
311
312   my %info;
313   $info{DATE} = $date->strftime('%Y-%m-%d');
314   $info{GENRE} = "Podcast";
315
316   # -- split the filename off the url -- #
317
318   my $file = $config->{local} . "/" . $f->{subdir} . '/' .
319              &local_file_from_url($i);
320   $file =~ s/\.MP3$/.mp3/;
321
322   my $oggFile = $file;
323   $oggFile =~ s/mp3$/ogg/;
324
325   my ($testAndroidFileName, $testNewFileName) = buildFileNames($oggFile, $f, $info{DATE});
326
327   # -- first make sure we don't already have the file -- #
328   return 1 if (-e $file or -e $oggFile or -e $testNewFileName or -e $testAndroidFileName
329               or -e "/home/bkuhn/Files/Audio/Portable/Listened/$testAndroidFileName");
330   print "$file, $oggFile, $testAndroidFileName, and $testNewFileName and /home/bkuhn/Files/Audio/Portable/Listened/$testAndroidFileName all didn't exist\n";
331   # -- grab the file -- #
332   system("/usr/bin/wget -N -O $file $i->{enclosure}{url}");
333   die "wget failure: $!" unless ($? == 0);
334   # -- change file info if desired -- #
335
336   if ($file !~ /ogg$/) {
337     my $newFile = $file;
338     $newFile =~ s/mp3$/ogg/;
339 #    system("mpg321 $file -w - | oggenc -q $OGG_QUALITY -o $newFile -");
340     system("/usr/bin/sox $file $newFile");
341     die "Unable to mp3->ogg on $file to $newFile" unless ($? == 0);
342     open(ID_MP3, "/usr/bin/id3v2 -l $file|") or die "unable to run: /usr/bin/id3v2 -l $file";
343     my %mp3Data;
344     while (my $line = <ID_MP3>) {
345       chomp $line;
346       if ($line =~ /^(TRCK|TIT2|TT2|TPE1|TALB|TRDA)[^:]*\s*:\s*(.+$)/) {
347         $mp3Data{$1} = $2;
348       }
349     }
350     close ID_MP3;
351     my %map = (TITLE => 'TIT2', ARTIST => 'TPE1', ALBUM => 'TALB',
352                TRACKNUMBER => 'TRCK', DATE => 'TRDA');
353     foreach my $key (keys %map) {
354       $info{$key} = $mp3Data{$map{$key}}
355         if ( (not defined $info{$key}) and defined $mp3Data{$map{$key}});
356       print "hoping to setting $key using $map{$key} by $mp3Data{$map{$key}}\n";
357     }
358     my %map2 = (TITLE => 'TT2', ARTIST => 'TP1', ALBUM => 'TAL', DATE => 'TYE');
359     foreach my $key (keys %map2) {
360       $info{$key} = $mp3Data{$map2{$key}}
361         if ( ( (not defined $info{$key}) or $info{$key} =~ /^\s*$/) and defined $mp3Data{$map2{$key}});
362       print "hoping to setting $key using $map2{$key} by $mp3Data{$map2{$key}}\n";
363     }
364     die "Unable to remove $file now that $oggFile is made" unless unlink($file) == 1;
365     $file = $oggFile;
366   } else {
367     open(VORBIS_COMMENTS, "/usr/bin/vorbiscomment -l $file|") or
368       die "unable to run: /usr/bin/vorbiscomment -l $file";
369     while (my $line = <VORBIS_COMMENTS>) {
370       chomp $line;
371       die "Weird vorbis line: $line" unless $line =~ /^\s*([^=]*)\s*=\s*(.+)$/;
372       $info{$1} = $2 unless defined $info{$1};
373     }
374     close VORBIS_COMMENTS;
375   }
376
377   my ($androidFile, $newFileName) = buildFileNames($file, $f, $info{DATE});
378   rename($file, $newFileName) or die "Unable to rename $file to $newFileName: $!";
379   $file = $newFileName;
380   print NEW_LIST "$androidFile\n";
381   print DOWNLOAD_LIST " File: $file";
382   open(VORBIS_CHANGE,  "|/usr/bin/vorbiscomment -w $file") or
383     die "unable to /usr/bin/vorbiscomment -w $file: $!";
384   use Data::Dumper;
385   print "info IS", Data::Dumper->Dump([\%info]);
386   print "F IS", Data::Dumper->Dump([$f]);
387   $info{TITLE} = $info{DATE} unless defined $info{TITLE};
388   foreach my $key (keys %{$f}) {
389     $info{"\U$key\E"} = $f->{$key} unless defined $info{"\U$key\E"};
390   }
391   foreach my $key ('TITLE', 'ARTIST', 'ALBUM') {
392     if (defined $f->{"\L$key\E"}) {
393       my $value = $date->strftime($f->{"\L$key\E"});
394       $value =~ s!#T#!$info{TITLE}!i if defined $info{TITLE};
395       $value =~ s!#N#!$info{TRACKNUMBER}!i if defined $info{TRACKNUMBER};
396       $info{$key} = $value;
397     }
398   }
399   foreach my $key (keys %info) {
400     print VORBIS_CHANGE $key, '=', $info{$key}, "\n";
401   }
402   close VORBIS_CHANGE;
403   print DOWNLOAD_LIST "\n\n";
404
405 #       $mp3->set_v2tag($id3v2);
406   return 1;
407 }
408 #----------
409
410 sub local_file_from_url {
411         my $i = shift;
412
413         my ($file) = $i->{enclosure}{url} =~ m!.*/([^/]+)$!;
414
415         $file =~ s/\s+/-/g;
416         return $file;
417 }
418
419 #----------
420
421 sub handle_feed_rai {
422         my ($f,$rss) = @_;
423
424         # stupid XML::RAI and XML::RSS::Parser don't pass any extra args on 
425         # to XML::Parser or XML::Expat, so we'll have to go around them
426
427         my $xml = 
428                 XML::RAI::new(
429                         $parser->parse($rss->content,ProtocolEncoding=>"ISO-8859-1")
430                 );
431
432 #       my $xml = XML::RAI->parse($rss->content,ProtocolEncoding=>"ISO-8859-1");
433
434         my $items = [];
435
436         foreach my $item ( @{ $xml->items } ) {
437                 my $info = {};
438                 foreach my $t ('title','link','description','created') {
439                         $info->{ $t } = $item->$t;
440                 }
441
442                 warn "item: $info->{title}\n";
443         }
444 }
445
446 package XML::RSS::Parser;
447
448 sub parse {
449         my $class = shift;
450         $class->rss_normalize($class->SUPER::parse(@_));
451 }
452
453 1;
454