# 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;