# This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ################### Podcast class ################# package Programme::podcast; use Env qw[@PATH]; use Fcntl; use File::Copy; use File::Path; use File::stat; use HTML::Entities; use HTTP::Cookies; use HTTP::Headers; use IO::Seekable; use IO::Socket; use LWP::ConnCache; use LWP::UserAgent; use POSIX qw(mkfifo); use strict; use Time::Local; use URI; # Inherit from Programme class use base 'Programme'; # Class vars # Global options my $opt; # Constructor # Usage: $prog{$pid} = Programme->new( 'pid' => $pid, 'name' => $name, ); sub new { my $type = shift; my %params = @_; my $self = {}; for (keys %params) { $self->{$_} = $params{$_}; } # Ensure the subclass $opt var is pointing to the Superclass global optref $opt = $Programme::optref; bless $self, $type; } sub index_min { return 200001 } sub index_max { return 299999 } # Class cmdline Options sub opt_format { return { outputpodcast => [ 1, "outputpodcast=s", 'Output', '--outputpodcast ', "Output directory for podcast recordings"], }; } # Method to return optional list_entry format sub optional_list_entry_format { my $prog = shift; my @format; for ( qw/ available channel categories / ) { push @format, $prog->{$_} if defined $prog->{$_}; } return ', '.join ', ', @format; } # Returns the modes to try for this prog type sub modelist { return 'podcast'; } # Feed info: # # Also see http://derivadow.com/2008/07/18/interesting-bbc-data-to-hack-with/ # # All podcasts menu (iphone) # http://www.bbc.co.uk/radio/podcasts/ip/ # # All radio1 podcasts # http://www.bbc.co.uk/radio/podcasts/ip/lists/radio1.sssi # # All radio1 -> moyles podcasts # http://www.bbc.co.uk/radio/podcasts/moyles/assets/iphone_keepnet.sssi # # RSS Feed (indexed from?) # http://downloads.bbc.co.uk/podcasts/radio1/moyles/rss.xml # # aod by channel see http://docs.google.com/View?docid=d9sxx7p_38cfsmxfcq # # http://www.bbc.co.uk/radio/aod/availability/.xml # Usage: Programme::podcast->get_links( $prog, 'podcast' ); sub get_links { shift; # ignore obj ref my $prog = shift; my $prog_type = shift; my $podcast_index_feed_url = 'http://downloads.bbc.co.uk/podcasts/ppg.xml'; my $xml; my $res; main::logger "INFO: Getting podcast Index Feeds\n"; # Setup User agent my $ua = main::create_ua('get_iplayer'); # Method # $podcast_index_feed_url (gets list of rss feeds for each podcast prog) => # http://downloads.bbc.co.uk/podcasts/$channel/$name/rss.xml => # Download index feed my $xmlindex = main::request_url_retry($ua, $podcast_index_feed_url, 3, '.', "WARNING: Failed to get prodcast index from site\n"); $xmlindex =~ s/\n/ /g; # Every RSS feed has an extry like below (all in a text block - not formatted like below) # # Best of Chris Moyles # moyles # Weekly highlights from the award-winning Chris Moyles breakfast show, as broadcast by Chris and team every morning from 6.30am to 10am. # # # # # # Moyles: Guestfest. 26 Sep 08 # Rihanna, Ross Kemp, Jack Osbourne, John # Barrowman, Cheggars, the legend that is Roy Walker and more, # all join the team in a celeb laden bundle of mirth and # merriment. It’s all the best bits of the # week from The Chris Moyles Show on BBC Radio 1. # 2008-09-26T06:30:00+01:00 # # # # # # for ( split / $channel = $1 if m{}; # $url = $1 if m{}; # $web = $1 if m{}; # Skip if there is no feed data for channel next if ! ($channel || $url); my ( $name, $episode, $desc, $pid, $available, $duration, $thumbnail ); # Get RSS feeds for each podcast programme main::logger "DEBUG: Getting podcast feed $url\n" if $opt->{verbose}; $xml = main::request_url_retry($ua, $url, 3, '.', "WARNING: Failed to get podcast feed for $channel / $_ from iplayer site\n") if $opt->{verbose}; $xml = main::request_url_retry($ua, $url, 3, '.', '') if ! $opt->{verbose}; # skip if no data next if ! $xml; main::logger "INFO: Got ".(grep //, $xml)." programmes\n" if $opt->{verbose}; decode_entities($xml); # First entry is channel data # # # # Stuart Maconie's Freak Zone # http://www.bbc.co.uk/6music/shows/freakzone/ # Weekly highlights from Stuart Maconie's # ...podcast is only available in the UK. # Weekly highlights from Stuart Maconie's # ...podcast is only available in the UK. # BBC 6 Music # # BBC # podcast.support@bbc.co.uk # # en # 720 # # # http://www.bbc.co.uk/radio/podcasts/freakzone/assets/_300x300.jpg # Stuart Maconie's Freak Zone # http://www.bbc.co.uk/6music/shows/freakzone/ # # # (C) BBC 2008 # Sun, 06 Jul 2008 20:00:05 +0100 # # Stewart Maconie, Macconie, freekzone, # freakzone, macoonie # Stewart Maconie, Macconie, freekzone, # freakzone, macoonie # no # nonadult # Parse XML # get list of entries within tags my @entries = split //, $xml; # first element == header my $header = shift @entries; # Get podcast name $name = $1 if $header =~ m{\s*(.+?)\s*}; # Parse the categories into hash # my @category; for my $line ( grep / $thumbnail = $1 if $header =~ m{ # FreakZone: C'est Stuart avec le Professeur Spear et le # pop francais? # Stuart and Justin discuss the sub-genre of # French 'cold wave' in this week's module. # Stuart and Justin discuss the sub-genre of # French 'cold wave' in this week's # module.... # Stuart and Justin discuss the sub-genre of # French 'cold wave' in this week's module. # Sun, 06 Jul 2008 20:00:00 +0100 # 14:23 # # # http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3 # # http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3 # # BBC 6 Music # foreach my $entry (@entries) { my $entry_flat = $entry; $entry_flat =~ s/\n/ /g; # Use the link as a guid # http://downloads.bbc.co.uk/podcasts/6music/freakzone/freakzone_20080706-2000.mp3 $pid = $1 if $entry =~ m{\s*(.+?)}; # Skip if this pid is a duplicate if ( defined $prog->{$pid} ) { main::logger "WARNING: '$pid, $prog->{$pid}->{name} - $prog->{$pid}->{episode}, $prog->{$pid}->{channel}' already exists (this channel = $_)\n" if $opt->{verbose}; next; } # parse episode # FreakZone: C'est Stuart avec le Professeur Spear et le pop francais? $episode = $1 if $entry =~ m{\s*(.*?)\s*}; # Sun, 06 Jul 2008 20:00:00 +0100 $available = $1 if $entry =~ m{\s*(.*?)\s*}; # Stuart and Justin discuss the sub-genre of French 'cold wave' in this week's module. $desc = $1 if $entry =~ m{\s*(.*?)\s*}; # Duration $duration = $1 if $entry =~ m{\s*(.*?)\s*}; # build data structure $prog->{$pid} = Programme::podcast->new( 'pid' => $pid, 'name' => $name, 'versions' => 'default', 'episode' => $episode, 'desc' => $desc, 'available' => $available, 'duration' => $duration, 'thumbnail' => $thumbnail, 'channel' => $channel, 'categories' => join(',', @category), 'type' => $prog_type, 'web' => $web, ); } } main::logger "\n"; return 0; } # Gets media streams data for this version pid # $media = http|undef sub get_stream_data { my ( $prog, $verpid, $media ) = @_; my $data = {}; $opt->{quiet} = 0 if $opt->{streaminfo}; $data->{podcast}->{ext} = $prog->{pid}; $data->{podcast}->{ext} =~ s|^.*\.(\w+)$|$1|g; $data->{podcast}->{streamer} = 'http'; $data->{podcast}->{streamurl} = $prog->{pid}; $data->{podcast}->{type} = 'Podcast stream'; # Return a hash with media => url if '' is specified - otherwise just the specified url if ( ! $media ) { return $data; } else { # Make sure this hash exists before we pass it back... $data->{$media}->{exists} = 0 if not defined $data->{$media}; return $data->{$media}; } } sub download { my ( $prog, $ua, $mode, $version, $version_pid ) = ( @_ ); # if subsonly required then skip return 'skip' if $opt->{subsonly}; # Determine the correct filename and extension for this download my $filename_orig = $prog->{pid}; $filename_orig =~ s|^.+/(.+?)\.\w+$|$1|g; $prog->{ext} = $prog->{streams}->{$version}->{$mode}->{ext}; # Determine the correct filenames for this download return 'skip' if $prog->generate_filenames( $ua, " - $filename_orig" ); # Create dir for prog if not streaming-only if ( ( ! ( $opt->{stdout} && $opt->{nowrite} ) ) && ( ! $opt->{test} ) ) { $prog->create_dir(); } # Skip from here if we are only testing downloads return 1 if $opt->{test}; # Instantiate new streamer based on streamdata my $class = "Streamer::$prog->{streams}->{$version}->{$mode}->{streamer}"; my $stream = $class->new; return $stream->get( $ua, $prog->{pid}, $prog ); } 1;