#!/usr/bin/env perl
#
# The world's most insecure web-based PVR manager and streaming proxy for get_iplayer
# ** WARNING ** Never run this in an untrusted environment or facing the internet
#
# Copyright (C) 2009-2010 Phil Lewis
#
# 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 <http://www.gnu.org/licenses/>.
#
# Author: Phil Lewis
# Email: iplayer2 (at sign) linuxcentre.net
# Web: http://www.infradead.org/get_iplayer/html/get_iplayer.html
# License: GPLv3 (see LICENSE.txt)
#
my $VERSION = 2.99;
my $VERSION_TEXT;
$VERSION_TEXT = sprintf("v%.2f", $VERSION) unless $VERSION_TEXT;
use strict;
use CGI qw(-utf8 :all);
use CGI::Cookie;
use IO::File;
use File::Copy;
use HTML::Entities;
use LWP::ConnCache;
#use LWP::Debug qw(+);
use LWP::UserAgent;
use IO::Handle;
use Getopt::Long;
use Cwd 'abs_path';
use File::Basename;
use Encode qw(:DEFAULT :fallback_all);
use PerlIO::encoding;
$PerlIO::encoding::fallback = XMLCREF;
use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0;
# suppress Perl 5.22/CGI 4 warning
$CGI::LIST_CONTEXT_WARN = 0;
$| = 1;
my $fh;
# Send log messages to this fh
my $se = *STDERR;
binmode $se, ':utf8';
my $opt_cmdline;
$opt_cmdline->{debug} = 0;
# Allow bundling of single char options
Getopt::Long::Configure ("bundling");
# cmdline opts take precedence
GetOptions(
"help|h" => \$opt_cmdline->{help},
"listen|address|l=s" => \$opt_cmdline->{listen},
"port|p=n" => \$opt_cmdline->{port},
"getiplayer|get_iplayer|g=s" => \$opt_cmdline->{getiplayer},
"ffmpeg=s" => \$opt_cmdline->{ffmpeg},
"encodinglocalefs|encoding-locale-fs=s" => \$opt_cmdline->{encodinglocalefs},
"debug" => \$opt_cmdline->{debug},
) || die usage();
# Display usage if old method of invocation is used or --help
usage() if $opt_cmdline->{help} || @ARGV;
# Usage
sub usage {
my $text = "get_iplayer Web PVR Manager $VERSION_TEXT, ";
$text .= <<'EOF';
Copyright (C) 2009-2010 Phil Lewis
This program comes with ABSOLUTELY NO WARRANTY; This is free software,
and you are welcome to redistribute it under certain conditions;
See the GPLv3 for details.
Options:
--listen,-l Use the built-in web server and listen on this interface address (default: 0.0.0.0)
--port,-p Use the built-in web server and listen on this TCP port
--getiplayer,-g Path to the get_iplayer script
--ffmpeg Path to the ffmpeg binary
--encodinglocalefs Encoding for file names (default: Linux/Unix/OSX = UTF-8, Windows = cp1252)
--debug Debug mode
--help,-h This help text
EOF
print $text;
exit 1;
}
# Some defaults
my $default_modes = 'default';
$opt_cmdline->{listen} = '0.0.0.0' if ! $opt_cmdline->{listen};
# Search for get_iplayer
if ( ! $opt_cmdline->{getiplayer} ) {
for ( './get_iplayer', './get_iplayer.cmd', './get_iplayer.pl', '/usr/bin/get_iplayer', '/usr/local/bin/get_iplayer' ) {
$opt_cmdline->{getiplayer} = $_ if -x $_;
}
}
if ( ( ! $opt_cmdline->{getiplayer} ) || ! -f $opt_cmdline->{getiplayer} ) {
print "ERROR: Cannot find get_iplayer, please specify its location using the --getiplayer option.\n";
exit 2;
}
$opt_cmdline->{encodinglocalefs} ||= (IS_WIN32 ? 'cp1252' : 'utf8');
$opt_cmdline->{ffmpeg} ||= 'ffmpeg';
# Path to get_iplayer (+ set HOME env var cos apache seems to not set it)
my $home = $ENV{HOME};
my %prog;
my @pids;
my @displaycols;
# Field names to be grabbed from get_iplayer
my @headings = qw(
index
thumbnail
pid
available
expires
type
name
episode
versions
duration
desc
channel
categories
timeadded
guidance
web
seriesnum
episodenum
filename
mode
);
# Default Displayed headings
my @headings_default = qw( thumbnail type name episode desc channel categories timeadded );
# Lookup table for nice field name headings
my %fieldname = (
index => 'Index',
pid => 'Pid',
available => 'Availability',
expires => 'Expires',
type => 'Type',
name => 'Name',
episode => 'Episode',
versions => 'Versions',
duration => 'Duration',
desc => 'Description',
channel => 'Channel',
categories => 'Categories',
thumbnail => 'Image',
timeadded => 'Time Added',
guidance => 'Guidance',
web => 'Web Page',
pvrsearch => 'PVR Search',
comment => 'Comment',
filename => 'Filename',
mode => 'Mode',
seriesnum => 'Series Number',
episodenum => 'Episode Number',
'name,episode' => 'Name+Episode',
'name,episode,desc' => 'Name+Episode+Desc',
);
my %cols_order = ();
my %cols_names = ();
my %prog_types = (
tv => 'BBC TV',
radio => 'BBC Radio'
);
my %prog_types_order = (
1 => 'tv',
2 => 'radio'
);
my $icons_base_url = './icons/';
my $cgi;
my $nextpage;
# Page routing based on NEXTPAGE CGI parameter
my %nextpages = (
'search_progs' => \&search_progs, # Main Programme Listings
'search_history' => \&search_history, # Recorded Programme Listings
'pvr_queue' => \&pvr_queue, # Queue Recording of Selected Progs
'recordings_delete' => \&recordings_delete, # Delete Files for Selected Recordings
'pvr_list' => \&show_pvr_list, # Show all current PVR searches
'pvr_del' => \&pvr_del, # Delete selected PVR searches
'pvr_add' => \&pvr_add,
'pvr_edit' => \&pvr_edit,
'pvr_save' => \&pvr_save,
'pvr_run' => \&pvr_run,
'record_now' => \&record_now,
'show_info' => \&show_info,
'refresh' => \&refresh,
);
##### Options #####
my $opt;
# Options Layout on page tabs
my $layout;
$layout->{BASICTAB}->{title} = 'Search Options',
$layout->{BASICTAB}->{heading} = 'Search Options:',
$layout->{BASICTAB}->{order} = [ qw/ SEARCH SEARCHFIELDS PROGTYPES HISTORY URL / ];
$layout->{SEARCHTAB}->{title} = 'Advanced Search';
$layout->{SEARCHTAB}->{heading} = 'Advanced Search Options:';
$layout->{SEARCHTAB}->{order} = [ qw/ EXCLUDE CATEGORY EXCLUDECATEGORY CHANNEL EXCLUDECHANNEL SINCE BEFORE FUTURE / ],
$layout->{DISPLAYTAB}->{title} = 'Display';
$layout->{DISPLAYTAB}->{heading} = 'Display Options:';
$layout->{DISPLAYTAB}->{order} = [ qw/ SORT REVERSE PAGESIZE HIDE HIDEDELETED / ];
$layout->{COLUMNSTAB}->{title} = 'Columns';
$layout->{COLUMNSTAB}->{heading} = 'Column Options:';
$layout->{COLUMNSTAB}->{order} = [ qw/ COLS / ];
$layout->{RECORDINGTAB}->{title} = 'Recording';
$layout->{RECORDINGTAB}->{heading} = 'Recording Options:';
$layout->{RECORDINGTAB}->{order} = [ qw/ OUTPUT VERSIONLIST MODES PROXY SUBTITLES METADATA THUMB PVRHOLDOFF FORCE AUTOWEBREFRESH AUTOPVRRUN REFRESHFUTURE / ];
$layout->{STREAMINGTAB}->{title} = 'Streaming';
$layout->{STREAMINGTAB}->{heading} = 'Streaming Options:';
$layout->{STREAMINGTAB}->{order} = [ qw/ BITRATE VSIZE VFR STREAMTYPE / ];
$layout->{HIDDENTAB}->{title} = '';
$layout->{HIDDENTAB}->{heading} = '';
$layout->{HIDDENTAB}->{order} = [ qw/ SAVE SEARCHTAB COLUMNSTAB DISPLAYTAB RECORDINGTAB STREAMINGTAB PAGENO INFO NEXTPAGE ACTION / ];
# Order of displayed tab buttoms (BASICTAB and HIDDEN are always displayed regardless of order)
$layout->{taborder} = [ qw/ BASICTAB SEARCHTAB DISPLAYTAB COLUMNSTAB RECORDINGTAB STREAMINGTAB HIDDENTAB / ];
# Any params that should never get into the get_iplayer pvr-add search
my @nosearch_params = qw/ /;
### Perl CGI Web Server ###
use Socket;
use IO::Socket;
use POSIX ":sys_wait_h";
my $IGNOREEXIT = 0;
# If the port number is specified then run embedded web server
if ( $opt_cmdline->{port} > 0 ) {
# Autoreap zombies
$SIG{CHLD} = 'IGNORE';
# Need this because with $SIG{CHLD} = 'IGNORE', backticks and systems calls always return -1
$IGNOREEXIT = 1;
for (;;) {
# Setup and create socket
my $server = new IO::Socket::INET(
Proto => 'tcp',
LocalAddr => $opt_cmdline->{listen},
LocalPort => $opt_cmdline->{port},
Listen => SOMAXCONN,
Reuse => 1,
);
$server or die "Unable to create server socket: $!";
print $se "INFO: Listening on $opt_cmdline->{listen}:$opt_cmdline->{port}\n";
print $se "WARNING: Insecure Remote access is allowed, use --listen=127.0.0.1 to limit to this host only\n" if $opt_cmdline->{listen} ne '127.0.0.1';
# Await requests and handle them as they arrive
while (my $client = $server->accept()) {
my $procid = fork();
die "Cannot fork" unless defined $procid;
# Parent
if ( $procid ) {
close $client;
# must call waitpid() on Windows
if ( IS_WIN32 ) {
while ( abs(waitpid(-1, WNOHANG)) > 1 ) {}
}
next;
}
# Child
binmode $se, IS_WIN32 ? ":encoding(cp1252)" : ':encoding(UTF-8)';
$client->autoflush(1);
my %request = ();
my $query_string;
my %data;
{
# Read Request
local $/ = Socket::CRLF;
while (<$client>) {
# Main http request
chomp;
if (/\s*(\w+)\s*([^\s]+)\s*HTTP\/(\d.\d)/) {
$request{METHOD} = uc $1;
$request{URL} = $2;
$request{HTTP_VERSION} = $3;
# Standard headers
} elsif (/:/) {
my ( $type, $val ) = split /:/, $_, 2;
$type =~ s/^\s+//;
for ($type, $val) {
s/^\s+//;
s/\s+$//;
}
$request{lc $type} = $val;
print "REQUEST HEADER: $type: $val\n" if $opt_cmdline->{debug};
# POST data
} elsif (/^$/) {
read( $client, $request{CONTENT}, $request{'content-length'} ) if defined $request{'content-length'};
last;
}
}
}
# Determine method and parse parameters
if ($request{METHOD} eq 'GET') {
if ($request{URL} =~ /(.*)\?(.*)/) {
$request{URL} = $1;
$request{CONTENT} = $2;
$query_string = $request{CONTENT};
}
$data{"_method"} = "GET";
} elsif ($request{METHOD} eq 'POST') {
$query_string = parse_post_form_string( $request{CONTENT} );
$data{"_method"} = "POST";
} else {
$data{"_method"} = "ERROR";
}
# Log Request
print $se "$data{_method}: $request{URL}\n";
# Is this the CGI or some other file request?
if ( $request{URL} =~ /^\/?(iplayer|recordings_delete|playlist.*|genplaylist.*|opml|)\/?$/ ) {
# remove any vars that might affect the CGI
#%ENV = ();
@ARGV = ();
# Setup CGI http vars
print $se "QUERY_STRING = $query_string\n" if defined $query_string;
$ENV{'QUERY_STRING'} = $query_string;
$ENV{'REQUEST_URI'} = $request{URL};
$ENV{'COOKIE'} = $request{cookie};
$ENV{'SERVER_PORT'} = $opt_cmdline->{port};
# respond OK to browser
print $client "HTTP/1.1 200 OK", Socket::CRLF;
# Invoke CGI
run_cgi( $client, $query_string, $request{URL}, 'http://'.$request{host}.'/' );
# Else 404
} else {
print $se "ERROR: 404 Not Found\n";
print $client "HTTP/1.1 404 Not Found", Socket::CRLF;
print $client Socket::CRLF;
print $client "<html><body>404 Not Found</body></html>";
$data{"_status"} = "404";
}
# Close Connection
close $client;
# Exit child
exit 0;
}
}
# If we're running as a proper CGI from a web server...
} else {
# If we were called by a webserver and not the builtin webserver then seed some vars
my $prefix = $ENV{REQUEST_URI};
my $request_uri;
# remove trailing query
$prefix =~ s/\?.*$//gi;
my $query_string = $ENV{QUERY_STRING};
my $request_host = "http://$ENV{SERVER_NAME}:$ENV{SERVER_PORT}${prefix}";
# determine whether http or https
my $request_protocol = 'http';
if ( defined $ENV{'HTTPS'} ) {
$request_protocol = $ENV{'HTTPS'}=='on'?'https':'http';
}
my $request_host = "${request_protocol}://$ENV{SERVER_NAME}:$ENV{SERVER_PORT}${prefix}";
$home = $ENV{HOME};
# Read POSTed data from STDIN if this is a form POST
if ( $ENV{REQUEST_METHOD} eq 'POST' ) {
my $content;
while ( <STDIN> ) {
$content .= $_;
}
$query_string = parse_post_form_string( $content );
}
run_cgi( *STDOUT, $query_string, undef, $request_host );
}
exit 0;
sub cleanup {
my $signal = shift;
print $se "INFO: Cleaning up PID $$ (signal = $signal)\n";
exit 0;
}
# wrap HTML::Entities::encode_entities to limit encoding
sub encode_entities {
my $value = shift;
return HTML::Entities::encode_entities( $value, '&<>"\'' );
}
sub parse_post_form_string {
my $form = $_[0];
my @data;
while ( $form =~ /Content-Disposition:(.+?)--/sg ) {
$_ = $1;
# form-data; name = "KEY"
m{name.+?"(.+?)"[\n\r\s]*(.+)}sg;
my ($key, $val) = ( $1, $2 );
next if ! $1;
$val =~ s/[\r\n]//g;
$val =~ s/\+/ /g;
# Decode entities first
decode_entities($val);
# url encode each entry
# $val =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
$val = CGI::escape($val);
push @data, "$key=$val";
}
return join '&', @data;
}
sub run_cgi {
# Get filehandle for output
$fh = shift;
binmode $fh, ':utf8';
my $query_string = shift;
my $request_uri = shift;
my $request_host = shift;
# Clean globals
%prog = ();
@pids = ();
@displaycols = ();
# new cgi instance
$cgi->delete_all() if defined $cgi;
$cgi = new CGI( $query_string );
# Get next page
$nextpage = $cgi->param( 'NEXTPAGE' ) || 'search_progs';
# Process All options
process_params();
# Set HOME env var for forked processes
$ENV{HOME} = $home;
my $action = $cgi->param( 'ACTION' ) || $request_uri;
# Strip the leading '/' to get the action
$action =~ s|^\/||g;
# rewrite short-form backwards compatible URIs
# e.g. http://server/stream?args -> http://server/get_iplayer.cgi?ACTION=stream&args
# Stream from get_iplayer STDOUT (optionally transcoding if required)
if ( $action eq 'direct' ) {
binmode $fh, ':raw';
# get filename first
my $progtype = $cgi->param( 'PROGTYPES' );
my $pid = $cgi->param( 'PID' );
# If the modes list f set to nothing
#my $mode = $opt->{MODES}->{current} || $opt->{MODES}->{default};
my $mode = $cgi->param( 'MODES' );
my $filename = get_direct_filename( $pid, $mode, $progtype );
# Use OUTTYPE for transcoding if required - get output ext
# $cgi->param('STREAMTYPE') || $cgi->param('OUTTYPE') || 'flv' if $action eq 'playlistdirect';
my $ext = lc( $cgi->param('STREAMTYPE') || $cgi->param( 'OUTTYPE' ) );
# Remove fileprefix
$ext =~ s/^.*\.//g;
# get file source ext
my $src_ext = $filename;
$src_ext =~ s/^.*\.//g;
# Stream mime types
my %mimetypes = (
wav => 'audio/x-wav',
flac => 'audio/x-flac',
aac => 'audio/mpeg',
m4a => 'audio/mpeg',
mp3 => 'audio/mpeg',
rm => 'audio/x-pn-realaudio',
mov => 'video/quicktime',
mp4 => 'video/mp4',
avi => 'video/x-flv',
flv => 'video/x-flv',
asf => 'video/x-ms-asf',
);
# default recipies
# Disable transcoding if none is specified as OUTTYPE/STREAMTYPE
my $notranscode = 0;
if ( $ext =~ /none/i ) {
print $se "INFO: Transcoding disabled (OUTTYPE=none)\n";
$ext = $src_ext;
$notranscode = 1;
# cannot stream mp4/avi so transcode to flv
# Add types here which you want re-muxed into flv
#if ( $src_ext =~ m{^(mp4|avi|mov|mp3|aac)$} && ! $ext ) {
} elsif ( $src_ext =~ m{^(mp4|m4a|aac|avi|mov)$} && ! $ext ) {
$ext = 'flv';
# Else Default to no transcoding
} elsif ( ! $ext ) {
$ext = $src_ext;
}
print $se "INFO: Streaming OUTTYPE:$ext MIMETYPE=$mimetypes{$ext} FILE:$filename to client\n";
# If type is defined
if ( $mimetypes{$ext} ) {
# Output headers
# to stream
# This will enable seekable -Accept_Ranges=>'bytes',
my $headers = $cgi->header( -type => $mimetypes{$ext}, -Connection => 'close' );
# Send the headers to the browser
print $se "\r\nHEADERS:\n$headers\n"; #if $opt_cmdline->{debug};
print $fh $headers;
stream_file( $filename, $mimetypes{$ext}, $src_ext, $ext, $notranscode, $cgi->param( 'BITRATE' ), $cgi->param( 'VSIZE' ), $cgi->param( 'VFR' ) );
} else {
print $se "ERROR: Aborting client thread - output mime type is undetermined\n";
}
# Get a playlist for a specified 'PROGTYPES'
} elsif ( $action eq 'playlist' || $action eq 'playlistdirect' || $action eq 'playlistfiles' ) {
# Output headers
my $headers = $cgi->header( -type => 'audio/x-mpegurl' );
# Send the headers to the browser
print $se "\r\nHEADERS:\n$headers\n"; #if $opt_cmdline->{debug};
print $fh $headers;
# determine output type
my $outtype = $cgi->param('OUTTYPE') || 'flv';
$outtype = $cgi->param('STREAMTYPE') || $cgi->param('OUTTYPE') || 'flv' if $action eq 'playlistdirect';
# ( host, outtype, modes, progtype, bitrate, search, searchfields, action )
print $fh create_playlist_m3u_single( $request_host, $outtype, $opt->{MODES}->{current}, $opt->{PROGTYPES}->{current} , $cgi->param('BITRATE') || '', $opt->{SEARCH}->{current}, $opt->{SEARCHFIELDS}->{current} || 'name', $opt->{VERSIONLIST}->{current}, $action );
# Get a playlist for a specified 'PROGTYPES'
} elsif ( $action eq 'opml' ) {
# Output headers
my $headers = $cgi->header( -type => 'text/xml' );
# Send the headers to the browser
print $se "\r\nHEADERS:\n$headers\n"; #if $opt_cmdline->{debug};
print $fh $headers;
# ( host, outtype, modes, type, bitrate )
print $fh get_opml( $request_host, $cgi->param('OUTTYPE') || 'flv', $opt->{MODES}->{current}, $opt->{PROGTYPES}->{current} , $cgi->param('BITRATE') || '', $opt->{SEARCH}->{current}, $cgi->param('LIST') || '' );
# Get a playlist for a selected progs in form
} elsif ( $action eq 'genplaylist' || $action eq 'genplaylistdirect' || $action eq 'genplaylistfile' ) {
# Output headers
my $headers = $cgi->header( -type => 'audio/x-mpegurl' );
# To save file
#my $headers = $cgi->header( -type => 'audio/x-mpegurl', -attachment => 'get_iplayer.m3u' );
# Send the headers to the browser
print $se "\r\nHEADERS:\n$headers\n"; #if $opt_cmdline->{debug};
print $fh $headers;
# determine output type
my $outtype = $cgi->param('OUTTYPE') || 'flv';
$outtype = $cgi->param('STREAMTYPE') || $cgi->param('OUTTYPE') if $action eq 'genplaylistdirect';
# ( host, outtype, modes, bitrate, action )
print $fh create_playlist_m3u_multi( $request_host, $outtype, $cgi->param('BITRATE') || '', $action );
# HTML page
} else {
# Output header and html start
begin_html( $request_host );
# Page Routing
form_header( $request_host );
#print $fh $cgi->Dump();
if ( $opt_cmdline->{debug} ) {
print $fh $cgi->Dump();
#for my $key (sort keys %ENV) {
# print $fh $key, " = ", $ENV{$key}, "\n";
#}
}
if ($nextpages{$nextpage}) {
# call the correct subroutine
$nextpages{$nextpage}->();
}
form_footer();
html_end();
}
$cgi->delete_all();
return 0;
}
sub pvr_run {
print $fh "<strong><p>The PVR will auto-run every $opt->{AUTOPVRRUN}->{current} hour(s) if you leave this page open</p></strong>" if $opt->{AUTOPVRRUN}->{current};
if ( IS_WIN32 ) {
print $fh "<strong><p>Windows users: You may encounter errors if you perform other tasks in the Web PVR Manager while this page is reloading</p></strong>" if $opt->{AUTOPVRRUN}->{current};
}
print $se "INFO: Starting PVR Run\n";
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nopurge',
'--nocopyright',
'--hash',
'--pvr',
);
#print $se "DEBUG: running: $cmd\n";
print $fh '<pre>';
# Redirect both STDOUT and STDERR to client browser socket
run_cmd_autorefresh( $fh, $fh, 1, @cmd );
print $fh '</pre>';
print $fh p("PVR Run complete");
# Load the refresh tab if required
my $autopvrrun = $cgi->cookie( 'AUTOPVRRUN' ) || $cgi->param( 'AUTOPVRRUN' );
# Render options actions
print $fh div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Run PVR Now',
-onClick => "RefreshTab( '?NEXTPAGE=pvr_run&AUTOPVRRUN=$autopvrrun', ".(1000*3600*$autopvrrun).", 1 );",
},
'PVR Run Now'
),
a(
{
-class=>'action',
-title => 'Close',
-onClick => "window.close()",
},
'Close'
),
]),
),
);
}
sub record_now {
my @record;
# The 'Record' action button uses SEARCH to pass it's pvr_queue data
if ( $cgi->param( 'SEARCH' ) ) {
push @record, $cgi->param( 'SEARCH' );
} else {
@record = ( $cgi->param( 'PROGSELECT' ) );
}
my @params = get_search_params();
my $out;
# If a URL was specified by the User (assume auto mode list is OK):
if ( $opt->{URL}->{current} =~ m{^http://} ) {
push @record, "$opt->{PROGTYPES}->{current}|$opt->{URL}->{current}|$opt->{URL}->{current}|-";
}
print $fh "<strong><p>Please leave this page open until the recording completes</p></strong>";
# Render options actions
print $fh div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Close',
-onClick => "window.close()",
},
'Close'
),
]),
),
);
print $fh "<p>Recording The Following Programmes</p><ul>\n";
for (@record) {
chomp();
my ( $type, $pid, $name, $episode ) = (split /\|/)[0,1,2,3];
next if ! ($type && $pid );
print $fh "<li>$name - $episode ($pid)</li>\n";
}
print $fh "</ul><br />\n";
print $se "INFO: Starting Recording Now\n";
# Queue all selected 'TYPE|PID|NAME|EPISODE|MODE|CHANNEL' entries in the PVR
for (@record) {
chomp();
my ( $type, $pid, $name, $episode ) = (split /\|/)[0,1,2,3];
next if ! ($type && $pid );
my $comment = "$name - $episode";
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nopurge',
'--nocopyright',
'--expiry=999999999',
'--hash',
'--webrequest',
get_iplayer_webrequest_args(
"pid=$pid",
"type=$type",
build_cmd_options( grep !/^(HISTORY|SINCE|BEFORE|HIDEDELETED|FUTURE|SEARCH|SEARCHFIELDS|PROGTYPES|EXCLUDEC.+)$/, @params )
),
);
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
print $fh '<pre>';
# Redirect both STDOUT and STDERR to client browser socket
run_cmd_autorefresh( $fh, $fh, 1, @cmd );
print $fh '</pre>';
}
print $fh p("Recording complete");
return 0;
}
# Stream a file to browser/client
sub stream_file {
my ( $filename, $mimetype, $src_ext, $ext, $notranscode, $abitrate, $vsize, $vfr ) = ( @_ );
print $se "INFO: Start Direct Streaming $filename to browser using mimetype '$mimetype', output ext '$ext', audio bitrate '$abitrate', video size '$vsize', video frame rate '$vfr'\n";
# If transcoding required (i.e. output ext != source ext) - OR, if one of the transcoing options is set
if ( ( ! $notranscode ) && ( lc( $ext ) ne lc( $src_ext ) || $abitrate || $vsize || $vfr ) ) {
$fh->autoflush(0);
my @cmd = build_ffmpeg_args( $filename, $mimetype, $ext, $abitrate, $vsize, $vfr, $src_ext );
run_cmd( $fh, $se, 100000, @cmd );
print $se "INFO: Finished Streaming and transcoding $filename to browser\n";
} else {
print $se "INFO: Streaming file directly: $filename\n";
if ( ! open( STREAMIN, "< $filename" ) ) {
print $se "INFO: Cannot Read file '$filename'\n";
exit 4;
}
# Read each char from command output and push to socket fh
my $char;
my $bytes;
# Assume that we don't want to buffer STDERR output of the command
my $size = 100000;
while ( $bytes = read( STREAMIN, $char, $size ) ) {
if ( $bytes <= 0 ) {
close STREAMIN;
print $se "DEBUG: Stream thread has completed\n";
exit 0;
} else {
print $fh $char;
print $se '#';
}
last if $bytes < $size;
}
close STREAMIN;
print $se "INFO: Finished Streaming $filename to browser\n";
}
return 0;
}
sub build_ffmpeg_args {
my ( $filename, $mimetype, $ext, $abitrate, $vsize, $vfr, $src_ext ) = ( @_ );
my @cmd_aopts;
my $src_mimetype = $mimetype;
# mime type override for audio->flv conversion
if ( lc( $src_ext ) =~ m{^(aac|m4a|mp3)$} ) {
$src_mimetype = 'audio/mpeg';
}
if ( $abitrate =~ m{^\d+$} ) {
if ( lc( $ext ) eq 'flv' ) {
push @cmd_aopts, ( '-ar', '44100', '-ab', "${abitrate}k" );
} else {
push @cmd_aopts, ( '-ab', "${abitrate}k" );
}
} else {
if ( lc( $ext ) eq 'flv' ) {
push @cmd_aopts, ( '-ar', '44100' );
}
# cannot copy code if for example we have an aac stream output as WAV (e.g. squeezebox flashaac)
#push @cmd_aopts, ( '-acodec', 'copy' );
}
my @cmd;
# If conversion is necessary
# Video
if ( $src_mimetype =~ m{^video} ) {
my @cmd_vopts;
# Apply video size
push @cmd_vopts, ( '-s', "${vsize}" ) if $vsize =~ m{^\d+x\d+$};
# Apply video framerate - caveat - bitrate defaults to 200k if only vfr is set
push @cmd_vopts, ( '-r', $vfr ) if $vfr =~ m{^\d$};
# -sameq is bad
## Apply sameq if framerate only and no bitrate
#push @cmd_vopts, '-sameq' if $vfr =~ m{^\d$} && $vsize !~ m{^\d+x\d+$};
# Add in the codec if we are transcoding and not remuxing the stream
if ( @cmd_vopts ) {
push @cmd_vopts, ( '-vcodec', 'libx264' );
} else {
push @cmd_vopts, ( '-vcodec', 'copy' );
}
@cmd = (
$opt_cmdline->{ffmpeg},
#'-f', $src_ext, # not required?
'-i', $filename,
@cmd_aopts,
@cmd_vopts,
'-f', $ext,
'-',
);
# Audio
} else {
@cmd = (
$opt_cmdline->{ffmpeg},
#'-f', $src_ext, # not required?
'-i', $filename,
'-vn',
@cmd_aopts,
'-ac', 2,
'-f', $ext,
'-',
);
}
print $se "DEBUG: Command args: ".(join ' ', @cmd)."\n";
return @cmd;
}
sub create_playlist_m3u_single {
my ( $request_host, $outtype, $modes, $type, $bitrate, $search, $searchfields, $versionlist, $request ) = ( @_ );
my @playlist;
$outtype =~ s/^.*\.//g;
my $searchterm = $search;
# this is already a wildcard default regex...
if ( $search eq '.*' ) {
$searchterm = '.*';
# if it's a URL then bypass regex stuff
} elsif ( $search =~ m{^http} ) {
$searchterm = $search;
# make search term regex friendly
} else {
$searchterm =~ s|([\/\.\?\+\-\*\^\(\)\[\]\{\}])|\\$1|g;
}
print $se "INFO: Getting playlist for type '$type' using modes '$modes' and bitrate '$bitrate'\n";
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( 'nopurge=1', "type=$type", 'listformat=ENTRY|<pid>|<name>|<episode>|<desc>|<filename>|<mode>', "fields=$searchfields", "search=$searchterm", "versionlist=$versionlist" ),
);
# Only add history search if the request is of this type or is a PlayFile from localfiles type
if ( ( $request eq 'playlistfiles' || $request eq 'playlistdirect' ) && ! ( $search =~ m{^/} && $searchfields eq 'pid' ) ) {
push @cmd, '--history', '--skipdeleted';
}
my @out = get_cmd_output( @cmd );
push @playlist, "#EXTM3U\n";
# Extract and rewrite into m3u format
# /home/lewispj/mp3/Rock/radiohead/Ok Computer/radiohead - (07) fitter happier.mp3||(07) Fitter Happier|, , (256kbps/44.1kHz)|<filename>|<mode>
for ( grep !/^(Added:|Matches|$)/ , @out ) {
chomp();
my $url;
my ( $pid, $name, $episode, $desc, $filename, $mode, $channel ) = (split /\|/)[1,2,3,4,5,6,7];
#print $se "DEBUG: $pid, $name, $episode, $desc, $filename, $mode\n";
# sanitze modes && filename
$mode = '' if $mode eq '<mode>';
$filename = '' if $filename eq '<filename>';
# playlist with direct streaming for files through webserver
if ( $request eq 'playlistdirect' ) {
next if ! ( $pid && $type && $mode );
$url = build_url_direct( $request_host, $type, $pid, $mode, basename( $filename ), $opt->{STREAMTYPE}->{current}, $opt->{HISTORY}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} );
# If pid is actually a filename then use it cos this is a local file type programme
} elsif ( $request eq 'playlistfiles' && $pid =~ m{^/} ) {
next if ! $pid;
$url = search_absolute_path( $pid ) if $pid;
# playlist with local files
} elsif ( $request eq 'playlistfiles' ) {
next if ! $filename;
$url = search_absolute_path( $filename );
# playlist of proxied urls for streaming online prog via web server
} else {
next if ! ( $type && $pid );
my $suffix = "${pid}.${outtype}";
$url = build_url_stream( $request_host, $type, $pid, $mode || $modes, $suffix, $opt->{STREAMTYPE}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} );
}
# Format required, e.g.
##EXTINF:-1,BBC Radio - BBC Radio One (High Quality Stream)
push @playlist, "#EXTINF:-1,$type - $channel - $name - $episode - $desc";
push @playlist, "$url\n";
}
print $se join ("\n", @playlist);
return join ("\n", @playlist);
}
sub create_playlist_m3u_multi {
my ( $request_host, $outtype, $bitrate, $request ) = ( @_ );
my @playlist;
push @playlist, "#EXTM3U\n";
my @record = ( $cgi->param( 'PROGSELECT' ) );
# If a URL was specified by the User (assume auto mode list is OK):
if ( $opt->{URL}->{current} =~ m{^http://} ) {
push @record, "$opt->{PROGTYPES}->{current}|$opt->{URL}->{current}|$opt->{URL}->{current}|-";
}
# Create m3u from all selected 'TYPE|PID|NAME|EPISODE|MODE|CHANNEL' entries in the PVR
for (@record) {
my $url;
chomp();
my ( $type, $pid, $name, $episode, $mode, $channel ) = (split /\|/)[0,1,2,3,4,5];
next if ! ($type && $pid );
# playlist with direct streaming fo files through webserver
if ( $request eq 'genplaylistdirect' ) {
$url = build_url_direct( $request_host, $type, $pid, $mode, $outtype, $opt->{STREAMTYPE}->{current}, $opt->{HISTORY}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} );
# playlist with local files
} elsif ( $request eq 'genplaylistfile' ) {
# If pid is actually a filename then use it cos this is a local file type programme
if ( $pid =~ m{^/} ) {
my $filename = search_absolute_path( $pid );
$url = $filename if $filename;
} else {
# Lookup filename (add it if defined - even if relative)
# check for -f $filename if you want to exclude files that cannot be found
my $filename = get_direct_filename( $pid, $mode, $type );
$url = $filename if $filename;
}
# Uncomment this to make all playlists local for localfiles types
# If pid is actually a filename then use it cos this is a local file type programme
#} elsif ( $pid =~ m{^/} ) {
# my $filename = search_absolute_path( $pid );
# $url = $filename if $filename;
# playlist of proxied urls for streaming online prog via web server
} else {
my $suffix = "${pid}.${outtype}";
$url = build_url_stream( $request_host, $type, $pid, $mode || $opt->{MODES}->{current}, $suffix, $opt->{STREAMTYPE}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} );
}
# Skip empty urls
next if ! $url;
# Format required, e.g.
##EXTINF:-1,BBC Radio - BBC Radio One (High Quality Stream)
#http://localhost:1935/stream?PID=liveradio:bbc_radio_one&MODES=flashaac&OUTTYPE=bbc_radio_one.wav
push @playlist, "#EXTINF:-1,$type - $channel - $name - $episode";
push @playlist, "$url\n";
}
print $se join ("\n", @playlist);
return join ("\n", @playlist);
}
sub get_opml {
my ( $request_host, $outtype, $modes, $type, $bitrate, $search, $list ) = ( @_ );
my @playlist;
$outtype =~ s/^.*\.//g;
#<?xml version="1.0" encoding="UTF-8"?>
#<opml version="1.1">
# <head>
# <title>Grateful Dead - 1995-07-09-Chicago, IL</title>
# </head>
# <body>
# <outline URL="http://www.archive.org/.../gd1995-07-09d1t01_vbr.mp3" bitrate="200" source="Soundboard" text="Touch Of Grey" type="audio" />
# <outline URL="http://www.archive.org/.../gd1995-07-09d1t02_vbr.mp3" bitrate="203" source="Soundboard" text="Little Red Rooster" type="audio" />
# <outline URL="http://www.archive.org/.../gd1995-07-09d1t03_vbr.mp3" bitrate="194" source="Soundboard" text="Lazy River Road" type="audio" />
# </body>
#</opml>
print $se "INFO: Getting playlist for type '$type' using modes '$modes', bitrate '$bitrate', search='$search' and list '$list'\n";
# Header
push @playlist, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<opml version=\"1.1\">";
# Programmes
if (! $list) {
# Header
push @playlist, "\t<head>\n\t\t\n\t</head>";
push @playlist, "\t<body>";
# Extract and rewrite into playlist format
my @out = get_cmd_output(
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( 'nopurge=1', "type=$type", 'listformat=<pid>|<name>|<episode>|<desc>', "search=$search" ),
);
for ( grep !/^(Added:|Matches|$)/, @out ) {
chomp();
# Strip unprinatble chars
s/(.)/(ord($1) > 127) ? "" : $1/egs;
my ($pid, $name, $episode, $desc) = (split /\|/)[0,1,2,3];
next if ! ( $pid && $name );
push @playlist, "\t\t<outline URL=\"".encode_entities( build_url_stream( $request_host, $type, $pid, $modes, $outtype ) )."\" bitrate=\"${bitrate}\" source=\"get_iplayer\" title=\"".encode_entities("$name - $episode - $desc")."\" text=\"".encode_entities("$name - $episode - $desc")."\" type=\"audio\" />";
}
# Top-level Menu
} elsif ( lc($list) eq 'menu' ) {
my %menu = (
'BBC iPlayer Radio Listen Again'=> "${request_host}?ACTION=opml&PROGTYPES=radio&LIST=channel",
);
# Header
push @playlist, "\t<head title=\"GetIplayer\">\n\t\t\n\t</head>";
push @playlist, "\t<body>";
for my $item ( sort keys %menu ) {
my $item_url = $menu{ $item };
#http://localhost:1935/opml?PROGTYPES=<type>SEARCH=bbc+radio+1&MODES=${modes}&OUTTYPE=a.wav
push @playlist, "\t\t<outline URL=\"".encode_entities( $item_url )."\" text=\"".encode_entities( "$item" )."\" />";
}
# Channels/Names etc
} elsif ($list) {
# Header
push @playlist, "\t<head>\n\t\t\n\t</head>";
push @playlist, "\t<body>";
# Extract and rewrite into playlist format
my @out = get_cmd_output(
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( 'nopurge=1', "type=$type", "list=$list", "channel=$search" ),
);
for ( grep !/^(Added:|Matches|$)/, @out ) {
my $suffix;
chomp();
# Strip unprinatble chars
s/(.)/(ord($1) > 127) ? "" : $1/egs;
next if ! m{^.+\(\d+\)$};
my $item = $_;
s/\s*\(\d+\)$//g;
my $itemregex = '^'.$_.'$';
# URL encode it
$itemregex =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
# Stateful addition of search terms
$suffix = '&LIST=name' if $list eq 'channel';
# Format required, e.g.
#http://localhost:1935/opml?PROGTYPES=<type>SEARCH=bbc+radio+1&MODES=${modes}&OUTTYPE=a.wav
push @playlist, "\t\t<outline URL=\"".encode_entities("${request_host}?ACTION=opml&PROGTYPES=${type}&SEARCH=${itemregex}${suffix}&MODES=${modes}&OUTTYPE=a.wav")."\" text=\"".encode_entities("$item")."\" title=\"".encode_entities("$item")."\" type=\"playlist\" />";
}
}
# Footer
push @playlist, "\t</body>\n</opml>";
return join ("\n", @playlist);
}
### Playlist URL builders
sub build_url_direct {
my ( $request_host, $progtypes, $pid, $modes, $outtype, $streamtype, $history, $bitrate, $vsize, $vfr, $versionlist ) = ( @_ );
# Sanity check
#print $se "DEBUG: building direct playback request using: PROGTYPES=${progtypes} PID=${pid} MODES=${modes} OUTTYPE=${outtype}\n";
# CGI::escape
$_ = CGI::escape($_) for ( $progtypes, $pid, $modes, $outtype, $streamtype, $history, $bitrate, $vsize );
#print $se "DEBUG: building direct playback request using: PROGTYPES=${progtypes} PID=${pid} MODES=${modes} OUTTYPE=${outtype} BITRATE=${bitrate} VSIZE=${vsize} VFR=${vfr}\n";
# Build URL
return "${request_host}?ACTION=direct&PROGTYPES=${progtypes}&PID=${pid}&MODES=${modes}&HISTORY=${history}&OUTTYPE=${outtype}&STREAMTYPE=${streamtype}&BITRATE=${bitrate}&VSIZE=${vsize}&VFR=${vfr}&VERSIONLIST=${versionlist}";
}
# "${request_host}?ACTION=stream&PROGTYPES=${type}&PID=${pid}&MODES=${modes}&OUTTYPE=${suffix}";
sub build_url_stream {
my ( $request_host, $progtypes, $pid, $modes, $outtype, $streamtype, $bitrate, $vsize, $vfr, $versionlist ) = ( @_ );
# Sanity check
#print $se "DEBUG: building stream playback request using: PROGTYPES=${progtypes} PID=${pid} MODES=${modes} OUTTYPE=${outtype}\n";
# CGI::escape
$_ = CGI::escape($_) for ( $progtypes, $pid, $modes, $outtype, $streamtype, $bitrate, $vsize, $vfr );
#print $se "DEBUG: building stream playback request using: PROGTYPES=${progtypes} PID=${pid} MODES=${modes} OUTTYPE=${outtype}\n";
# Build URL
return "${request_host}?ACTION=stream&PROGTYPES=${progtypes}&PID=${pid}&MODES=${modes}&OUTTYPE=${outtype}&STREAMTYPE=${streamtype}&BITRATE=${bitrate}&VSIZE=${vsize}&VFR=${vfr}&VERSIONLIST=${versionlist}";
}
# Play from Internet/'Play': ?ACTION=playlist &SEARCHFIELDS=pid &SEARCH=$pid &MODES=${modes} &PROGTYPES=${type} &OUTTYPE=${outtype}'
## 'PlayFile' - works with vlc
# Play from local file/'PlayFile' ?ACTION=playlistfiles &SEARCHFIELDS=pid &SEARCH=$pid &MODES=${modes} &PROGTYPES=${type}
## 'PlayWeb' - not on vlc
# Play from file on web server/'PlayWeb' ?ACTION=playlistdirect &SEARCHFIELDS=pid &SEARCH=$pid &MODES=${modes}
sub build_url_playlist {
my ( $request_host, $action, $searchfields, $search, $modes, $progtypes, $outtype, $streamtype, $bitrate, $vsize, $vfr, $versionlist ) = ( @_ );
# Sanity check
#print $se "DEBUG: building $action request using: SEARCHFIELDS=${searchfields} SEARCH=${search} MODES=${modes} PROGTYPES=${progtypes} OUTTYPE=${outtype}\n";
# CGI::escape
$_ = CGI::escape($_) for ( $action, $searchfields, $search, $modes, $progtypes, $outtype, $streamtype, $bitrate, $vsize, $vfr );
#print $se "DEBUG: building $action request using: SEARCHFIELDS=${searchfields} SEARCH=${search} MODES=${modes} PROGTYPES=${progtypes} OUTTYPE=${outtype}\n";
# Build URL
return "${request_host}?ACTION=${action}&SEARCHFIELDS=${searchfields}&SEARCH=${search}&MODES=${modes}&PROGTYPES=${progtypes}&OUTTYPE=${outtype}&STREAMTYPE=${streamtype}&BITRATE=${bitrate}&VSIZE=${vsize}&VFR=${vfr}&VERSIONLIST=${versionlist}";
}
# Generic
# Gets the contents of a URL and retries if it fails, returns '' if no page could be retrieved
# Usage <content> = request_url_retry(<ua>, <url>, <retries>, <succeed message>, [<fail message>]);
sub request_url_retry {
my %OPTS = @LWP::Protocol::http::EXTRA_SOCK_OPTS;
$OPTS{SendTE} = 0;
@LWP::Protocol::http::EXTRA_SOCK_OPTS = %OPTS;
my ($ua, $url, $retries, $succeedmsg, $failmsg) = @_;
my $res;
# Malformed URL check
if ( $url !~ m{^\s*https?\:\/\/}i ) {
print $se "ERROR: Malformed URL: '$url'\n";
return '';
}
my $i;
print $se "INFO: Getting page $url\n" if $opt->{verbose};
for ($i = 0; $i < $retries; $i++) {
$res = $ua->request( HTTP::Request->new( GET => $url ) );
if ( ! $res->is_success ) {
print $se $failmsg;
} else {
print $se $succeedmsg;
last;
}
}
# Return empty string if we failed
return '' if $i == $retries;
return $res->content;
}
# Invokes command in @args as a system call (hopefully) without using a shell
# Can also redirect all stdout and stderr to either: STDOUT, STDERR or unchanged
# Usage: run_cmd( <''|STDOUTFH>, <''|STDERRFH>, @args )
# Returns: exit code
# Note: doesn't appear to work with 'in memory' filehandles
sub run_cmd_unix {
# Define what to do with STDOUT and STDERR of the child process
my $fh_child_out = shift || "STDOUT";
my $fh_child_err = shift || "STDERR";
my @cmd = ( @_ );
my $rtn;
print $se "INFO: Command: ".(join ' ', @cmd)."\n"; # if $opt->{verbose};
# Check if we have IPC::Open3 otherwise fallback on system()
eval "use IPC::Open3";
# probably only likely in win32
if ($@) {
print $se "ERROR: Please download and run latest installer - 'IPC::Open3' is not available\n";
exit 1;
# Use open3()
} else {
#print $se "INFO: open3( 0, \">&".fileno($fh_child_out).", \">&".fileno($fh_child_err).", <cmd> )\n";
# Don't use NULL for the 1st arg of open3 otherwise we end up with a messed up STDIN once it returns
my $procid = open3( 0, ">&".fileno($fh_child_out), ">&".fileno($fh_child_err), @cmd );
# Wait for child to complete
waitpid( $procid, 0 );
$rtn = $?;
}
# Interpret return code
return interpret_return_code( $rtn );
}
# Invokes command in @args as a system call (hopefully) without using a shell
# Can also redirect all stdout and stderr to either: STDOUT, STDERR or unchanged
# Usage: run_cmd( $stdout_fh, $stderr_fh, <buf_size>, @args )
# Returns: exit code
sub run_cmd {
# win32 kludge cos win is so broken
return run_cmd_win32( @_ ) if IS_WIN32;
# Define what to do with STDOUT and STDERR of the child process
use IO::Select;
use Symbol qw(gensym);
my $fh_cmd_out = shift;
my $fh_cmd_err = shift;
my $size = shift;
my $from = new IO::Handle;
my $err = new IO::Handle;
my @cmd = ( @_ );
my $direct = grep(/$opt_cmdline->{ffmpeg}/, @cmd);
my $is_hls = grep(/modes%3Dhl(s|x)/, @cmd);
my $stdout_raw = $direct;
my $rtn;
$fh_cmd_out->autoflush(1);
$fh_cmd_err->autoflush(1);
print $se "INFO: Command: ".(join ' ', @cmd)."\n"; # if $opt->{verbose};
# Check if we have IPC::Open3 otherwise fallback on system()
eval "use IPC::Open3";
# probably only likely in win32
if ($@) {
print $se "ERROR: Please download and run latest installer - 'IPC::Open3' is not available\n";
exit 1;
# Use open3()
} else {
my $procid;
# Setup signal handlers so that when the browser is closed the SIGPIPE results in sending a SIGTERM to the forked command.
local $SIG{PIPE} = sub {
my $signal = shift;
print $se "\nINFO: $$ Cleaning up (signal = $signal), killing cmd PID=$procid:\n";
for my $sig ( qw/INT PIPE TERM KILL/ ) {
# Kill process with SIGs
print $se "INFO: $$ killing cmd PID=$procid with SIG${sig}\n";
kill $sig, $procid;
sleep 1;
if ( ! kill 0, $procid ) {
print $se "INFO: $$ killed cmd PID=$procid\n";
last;
}
sleep 4;
}
exit 0;
};
# Don't use NULL for the 1st arg of open3 otherwise we end up with a messed up STDIN once it returns
$procid = open3( gensym, $from, $err, @cmd ) || print $se "ERROR: Could not execute command: $!\n";
my $childpidout = fork();
# Fork a child process to read from the indirect (STDOUT) fh of the spawned command and write it to the selected fh (browser client)
if ( $childpidout <= 0 ) {
# Not sure if these are necessary:
$fh_cmd_out->autoflush(1);
$from->autoflush(1);
if ( $stdout_raw) {
binmode $from, ':raw';
} else {
binmode $from, ':utf8';
}
# Read each char from command output and push to socket fh
my $char;
my $bytes;
while ( $bytes = read( $from, $char, $size ) ) {
if ( $bytes <= 0 ) {
print $se "DEBUG: STDOUT fd closed - exiting thread\n";
exit 0;
} else {
print $fh_cmd_out $char;
}
last if $bytes < $size;
}
#print $se "CMD STDOUT FH EMPTY\n";
exit 0;
# Parent continues here
} elsif ( defined $childpidout ) {
print $se "DEBUG: Forked STDOUT reader with PID $childpidout\n";
# Failed to fork
} else {
print $se "ERROR: Failed to fork STDOUT reader process: $!\n";
exit 1;
}
my $childpiderr = fork();
# Fork a child process to read from the indirect (STDERR) fh of the spawned command and write it to the selected fh (browser client)
if ( $childpiderr <= 0 ) {
# Not sure if these are necessary:
$fh_cmd_err->autoflush(1);
$err->autoflush(1);
binmode $err, ':utf8';
# Read each char from command output and push to socket fh
my $char;
my $bytes;
# Assume that we don't want to buffer STDERR output of the command
$size = 1;
if ( $is_hls ) {
my ($count, $buf);
while ( $bytes = read( $err, $char, $size ) ) {
if ( $bytes <= 0 ) {
print $se "DEBUG: STDERR fd closed - exiting thread\n";
exit 0;
} else {
if ( $char eq "#" ) {
print $fh_cmd_err $char;
} elsif ( $char =~ /[\r\n]/ ) {
if ( $buf =~ /size=/ ) {
$count++;
print $fh_cmd_err "#";
print $fh_cmd_err "\n" if ! ($count % 100);
} else {
print $fh_cmd_err $buf;
print $fh_cmd_err "\n";
}
$buf = '';
} else {
$buf .= $char;
}
}
if ( $bytes < $size ) {
print $fh_cmd_err "$buf\n" if $buf;
last;
}
}
} else {
while ( $bytes = read( $err, $char, $size ) ) {
if ( $bytes <= 0 ) {
print $se "DEBUG: STDERR fd closed - exiting thread\n";
exit 0;
} else {
print $fh_cmd_err $char;
}
last if $bytes < $size;
}
}
#print $se "CMD STDERR FH EMPTY\n";
exit 0;
# Parent continues here
} elsif ( defined $childpiderr ) {
print $se "DEBUG: Forked STDERR reader with PID $childpiderr\n";
# Failed to fork
} else {
print $se "ERROR: Failed to fork STDERR reader process: $!\n";
exit 1;
}
# Reap reader processes
waitpid( $childpidout, 0 );
waitpid( $childpiderr, 0 );
# Reap command child
waitpid( $procid, 0 );
$rtn = $?;
# Restore sigpipe handler for reader and writer processes
$SIG{PIPE} = 'DEFAULT';
}
# Interpret return code
return interpret_return_code( $rtn );
}
# Works except for where both from and err go to fh - does not die when browser closes.
# Also the browser does not get closed after cmd completes...
# Uses shell when stderr needs to be redirected to stdout
sub run_cmd_win32 {
# Define what to do with STDOUT and STDERR of the child process
my $fh_child_out = shift;
my $fh_child_err = shift;
my $size = shift;
my @cmd = ( @_ );
# eek! - works around win32 inability to redirect STDERR nicely
# If the stderr is supposed to go to the same fh and stdout then add '2>&1'
push @cmd, '2>&1' if fileno($fh_child_out) == fileno($fh_child_err);
my $rtn;
# Disable buffering
$fh_child_out->autoflush(1);
print $se "INFO: Win32 Command: ".(join ' ', @cmd)."\n"; # if $opt->{verbose};
# Redirect $fh_child_out to STDOUT
open(STDOUT, ">&", $fh_child_out ) || die "can't dup client to stdout";
$rtn = system( @cmd );
# Interpret return code
return interpret_return_code( $rtn );
}
# PVR Run and Refresh Cache pages will not auto-refresh if client socket
# is dup()-ed to STDOUT (as in run_cmd_win32). Run command in shell and
# copy get_iplayer output to client socket instead.
sub run_cmd_autorefresh {
return run_cmd( @_ ) unless IS_WIN32;
# Define what to do with STDOUT and STDERR of the child process
my $fh_child_out = shift;
my $fh_child_err = shift;
my $size = shift;
my @cmd = ( @_ );
# workaround to add quotes around the args because we are using a shell here
for ( @cmd ) {
s/^(.+)$/"$1"/g if ! m{^[\-\"]};
}
# eek! - works around win32 inability to redirect STDERR nicely
# If the stderr is supposed to go to the same fh and stdout then add '2>&1'
push @cmd, '2>&1' if fileno($fh_child_out) == fileno($fh_child_err);
# Disable buffering
$fh_child_out->autoflush(1);
print $se "INFO: Win32 Command: ".(join ' ', @cmd)."\n"; # if $opt->{verbose};
my $buf;
my $bytes;
open( CMD, ( join ' ', @cmd ).'|' ) || die "can't open pipe: $!\n";
binmode CMD, ':utf8';
while ( $bytes = read( CMD, $buf, $size ) ) {
if ( $bytes <= 0 ) {
print $se "DEBUG: pipe fd closed - exiting thread\n";
exit 0;
} else {
print $fh_child_out $buf;
}
last if $bytes < $size;
}
close(CMD);
# Interpret return code
return interpret_return_code( $? );
}
# Same as backticks but without needing a shell
# sets $?
# returns array of output
sub get_cmd_output {
# win32 kludge cos win is so broken
return get_cmd_output_win32( @_ ) if IS_WIN32;
use Symbol qw(gensym);
my @cmd = ( @_ );
#my $to = new IO::Handle;
my $from = new IO::Handle;
my $error = new IO::Handle;
my $rtn;
my @out_from;
my @out_error;
#$to->autoflush(1);
$from->autoflush(1);
$error->autoflush(1);
print $se "INFO: Command: ".(join ' ', @cmd)."\n"; # if $opt->{verbose};
# Check if we have IPC::Open3 otherwise fallback on system()
eval "use IPC::Open3";
# probably only likely in win32
if ($@) {
print $se "ERROR: Please download and run latest installer - 'IPC::Open3' is not available\n";
exit 1;
# Use open3()
} else {
my $procid;
# Setup signal handlers so that when the browser is closed the SIGPIPE results in sending a SIGTERM to the forked command.
local $SIG{PIPE} = sub {
my $signal = shift;
print $se "\nINFO: $$ Cleaning up (signal = $signal), killing cmd PID=$procid:\n";
for my $sig ( qw/INT PIPE TERM KILL/ ) {
# Kill process with SIGs
print $se "INFO: $$ killing cmd PID=$procid with SIG${sig}\n";
kill $sig, $procid;
sleep 1;
if ( ! kill 0, $procid ) {
print $se "INFO: $$ killed cmd PID=$procid\n";
last;
}
sleep 4;
}
exit 0;
};
#print $se "INFO: open3( 0, \">&".fileno($fh_child_out).", \">&".fileno($fh_child_err).", <cmd> )\n";
# Don't use NULL for the 1st arg of open3 otherwise we end up with a messed up STDIN once it returns
$procid = open3( gensym, $from, $error, @cmd );
# Wait for child to complete
my $childpid = fork();
binmode $se, IS_WIN32 ? ":encoding(cp1252)" : ':encoding(UTF-8)';
# Child
if ( $childpid == 0 ) {
binmode $error, ':utf8';
while ( <$error> ) {
print $se "CMD STDERR: $_";
}
#print $se "CMD STDERR EMPTY\n";
exit 0;
# Parent
} elsif ( defined $childpid ) {
binmode $from, ':utf8';
while ( <$from> ) {
push @out_from, $_;
}
} else {
print $se "ERROR: Could not fork STDERR reader process\n";
exit 1;
}
waitpid( $childpid, 0 );
waitpid( $procid, 0 );
$rtn = $?;
# Restore sigpipe handler for reader and writer processes
$SIG{PIPE} = 'DEFAULT';
}
# Interpret return code
interpret_return_code( $rtn );
return @out_from;
}
# Still uses shell
sub get_cmd_output_win32 {
my ( @cmd ) = ( @_ );
# workaround to add quotes around the args because we are using a shell here
for ( @cmd ) {
s/^(.+)$/"$1"/g if ! m{^[\-\"]};
}
print $se "DEBUG: Command: ".( join ' ', @cmd )."\n";
open( CMD, ( join ' ', @cmd ).'|' ) || print $se "ERROR: echo failed: $!\n";
binmode CMD, ':utf8';
my @out = <CMD>;
close CMD;
# Interpret return code
interpret_return_code( $? );
return @out;
}
sub interpret_return_code {
my $rtn = shift;
# Interpret return code and force return code 2 upon error
my $return = $rtn >> 8;
if ( $rtn == -1 && $IGNOREEXIT ) {
$return = 0;
} elsif ( $rtn == -1 ) {
print $se "ERROR: Command failed to execute: $!\n";
$return = 2 if ! $return;
} elsif ( $rtn & 128 ) {
print $se "WARNING: Command executed but coredumped\n";
$return = 2 if ! $return;
} elsif ( $rtn & 127 ) {
print $se sprintf "WARNING: Command executed but died with signal %d\n", $rtn & 127;
$return = 2 if ! $return;
}
print $se sprintf "INFO: Command exit code %d\n", $return if $return;
return $return;
}
sub get_pvr_list {
my $pvrsearch;
my $out = join "\n", get_cmd_output(
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--pvrlist',
);
# Remove text before first pvrsearch entry
$out =~ s/^.+?(pvrsearch\s.+)$/$1/s;
# Parse all 'pvrsearch' elements
for ( split /pvrsearch\s+\=\s+/, $out ) {
next if /^get_iplayer/;
my $name;
$_ = "pvrsearch = $_";
# Get each element
while ( /([\w\-]+?)\s+=\s+(.+?)\n/sg ) {
if ( $1 eq 'pvrsearch' ) {
$name = $2;
}
$pvrsearch->{$name}->{$1} = $2;
# Remove disabled entries
if ( $pvrsearch->{$name}->{disable} == 1 ) {
delete $pvrsearch->{$name};
last;
}
}
}
return $pvrsearch;
}
sub show_pvr_list {
my %fields;
my $pvrsearch = get_pvr_list();
my $sort_field = $cgi->param( 'PVRSORT' ) || 'name';
my $reverse = $cgi->param( 'PVRREVERSE' ) || '0';
# Sort data
my @pvrsearches = get_sorted( $pvrsearch, $sort_field, $reverse );
# Parse all 'pvrsearch' elements to get all fields used
for my $name ( @pvrsearches ) {
# Get each element
for ( keys %{ $pvrsearch->{$name} } ) {
$fields{$_} = 1;
}
}
# Render options actions
my $buttons = div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Go Back',
-onClick => "history.back()",
},
'Back'
),
a(
{
-class => 'action',
-title => 'Delete selected programmes from PVR search list',
-onClick => "if(! check_if_selected(document.form1, 'PVRSELECT')) { alert('No programmes were selected'); return false; } BackupFormVars(form1); form1.NEXTPAGE.value='pvr_del'; form1.submit(); RestoreFormVars(form1);",
},
'Delete'
),
]),
),
);
my @html;
my @displaycols = ( 'pvrsearch', ( grep !/pvrsearch/, ( sort keys %fields ) ) );
# Build header row
push @html, "<tr class=\"search\" >";
push @html, th( { -class => 'search' }, checkbox( -class=>'search', -title=>'Select/Unselect All PVR Searches', -onClick=>"check_toggle(document.form1, 'PVRSELECT')", -name=>'SELECTOR', -value=>'1', -label=>'' ) );
# Display data in nested table
for my $heading (@displaycols) {
# Sort by column click and change display class (colour) according to sort status
my ($title, $class, $onclick);
if ( $sort_field eq $heading && not $reverse ) {
($title, $class, $onclick) = ("Sort by Reverse $fieldname{$heading}", 'sorted pointer', "BackupFormVars(form1); form1.NEXTPAGE.value='pvr_list'; form1.PVRSORT.value='$heading'; form1.PVRREVERSE.value=1; form1.submit(); RestoreFormVars(form1);");
} else {
($title, $class, $onclick) = ("Sort by $fieldname{$heading}", 'unsorted pointer', "BackupFormVars(form1); form1.NEXTPAGE.value='pvr_list'; form1.PVRSORT.value='$heading'; form1.submit(); RestoreFormVars(form1); ");
}
$class = 'sorted_reverse pointer' if $sort_field eq $heading && $reverse;
push @html, th( { -class => 'search' },
label( {
-title => $title,
-class => $class,
-onClick => $onclick,
},
$fieldname{$heading} || $heading,
)
);
}
push @html, "</tr>";
# Build each row
for my $name ( @pvrsearches ) {
my @row;
push @row, td( {-class=>'search'},
checkbox(
-class => 'search',
-name => 'PVRSELECT',
-label => '',
-value => "$name",
-checked => 0,
-override => 1,
)
);
for ( @displaycols ) {
push @row, td( {-class=>'search'},
label( {
-title => "Click to Edit",
-class => 'search',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='pvr_edit'; form1.PVRSEARCH.value='$name'; form1.submit(); RestoreFormVars(form1);",
},
$pvrsearch->{$name}->{$_},
)
);
}
push @html, Tr( {-class=>'search'}, @row );
}
# Search form
print $fh start_form(
-name => "form1",
-method => "POST",
);
print $fh p("Click to Edit any PVR Search");
# Render options actions
print $fh $buttons;
# Render table
print $fh table( {-class=>'search'} , @html );
print $fh $buttons;
# Make sure we go to the correct nextpage for processing
print $fh hidden(
-name => "NEXTPAGE",
-value => "pvr_list",
-override => 1,
);
# Reverse sort value
print $fh hidden(
-name => "PVRREVERSE",
-value => 0,
-override => 1,
);
print $fh hidden(
-name => "PVRSORT",
-value => $sort_field,
-override => 1,
);
print $fh hidden(
-name => "PVRSEARCH",
-value => '',
-override => 1,
);
print $fh end_form();
return 0;
}
# Edits a single record indicated by PVRSELECT
sub pvr_edit {
my %fields;
my $pvrsearch = get_pvr_list();
my @html;
my $pvrname = $cgi->param( 'PVRSEARCH' );
# Determine max field length
my $maxwidth = 30;
for ( values %{ $pvrsearch->{$pvrname} } ) {
$maxwidth = length($_) if length($_) > $maxwidth && $maxwidth < 200;
}
# Get each element
for my $key ( keys %{ $pvrsearch->{$pvrname} } ) {
my $val = $pvrsearch->{$pvrname}->{$key};
# Put INPUT field here
my $element;
#if ( $key eq 'pvrsearch' ) {
# $element = $val;
#} else {
$element = hidden(
-name => "EDITKEYS",
-value => $key,
-override => 1,
).
textfield(
-class => 'edit',
-name => "EDITVALUES",
-value => $val,
-size => $maxwidth + 20,
);
#}
push @html, Tr( { -class => 'info' }, th( { -class => 'info' }, $key ).td( { -class => 'info' }, $element ) );
}
# Editing form
print $fh start_form(
-name => "form1",
-method => "POST",
);
print $fh table( { -class => 'info' }, @html );
# Render options actions
print $fh div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Go Back',
-onClick => "history.back()",
},
'Back'
),
a(
{
-class => 'action',
-title => 'Save changes',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='pvr_save'; form1.submit(); RestoreFormVars(form1);",
},
'Save Changes'
),
]),
),
);
# Make sure we go to the correct nextpage for processing
print $fh hidden(
-name => "NEXTPAGE",
-value => "pvr_add",
-override => 1,
);
print $fh hidden(
-name => "PVRSEARCH",
-value => $pvrname,
-override => 1,
);
print $fh end_form();
return 0;
}
#
# Will return a list of pids sorted by the requested Heading
#
sub get_sorted {
my @sorted;
my @unsorted;
my $data = shift;
my $sort_field = shift;
my $reverse = shift;
# Lookup table for nice field name headings
my %sorttype = (
index => 'numeric',
duration => 'numeric',
timeadded => 'numeric',
seriesnum => 'numeric',
episodenum => 'numeric',
expires => 'numeric',
);
# Insert search '<key>~~~<sort_field>' for each prog in hash
for my $key (keys %{ $data } ) {
# generate sort column
push @unsorted, $data->{$key}->{$sort_field}.'~~~'.$key;
}
# If this a purely numerical field
if ( defined $sorttype{$sort_field} && $sorttype{$sort_field} eq 'numeric' ) {
if ($reverse) {
@sorted = reverse sort {$a <=> $b} @unsorted;
} else {
@sorted = sort {$a <=> $b} @unsorted;
}
# otherwise sort alphabetically
} else {
if ($reverse) {
@sorted = reverse sort { lc $a cmp lc $b } @unsorted;
} else {
@sorted = sort { lc $a cmp lc $b } @unsorted;
}
}
# Strip off seach key at beginning of each line
s/^.*~~~// for @sorted;
return @sorted;
}
sub pvr_del {
my @record = ( $cgi->param( 'PVRSELECT' ) );
my $out;
# Queue all selected '<type>|<pid>' entries in the PVR
for my $name (@record) {
chomp();
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( "pvrdel=$name" ),
);
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
my $cmdout = join "", get_cmd_output( @cmd );
return p("ERROR: ".$out) if $? && not $IGNOREEXIT;
print $fh p("Deleted: $name");
$out .= $cmdout;
}
print $fh "<pre>$out</pre>";
# Show list below
show_pvr_list();
return $out;
}
sub show_info {
my $progdata = ( $cgi->param( 'INFO' ) );
my $out;
my @html;
my %prog;
my ( $type, $pid ) = split /\|/, $progdata;
# Queue all selected '<type>|<pid>' entries in the PVR
chomp();
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( 'nopurge=1', "type=$type", "future=$opt->{FUTURE}->{current}", "history=$opt->{HISTORY}->{current}", "skipdeleted=$opt->{HIDEDELETED}->{current}", 'info=1', 'fields=pid', "search=$pid" ),
);
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
my @cmdout = get_cmd_output( @cmd );
return p("ERROR: ".@cmdout) if $? && not $IGNOREEXIT;
for ( grep !/^(Added|INFO):/, @cmdout ) {
my ( $key, $val ) = ( $1, $2 ) if m{^(\w+?):\s*(.+?)\s*$};
next if $key =~ /(^$|^\d+$)/ || $val =~ /Matching Program/i;
$out .= "$key: $val\n";
$prog{$pid}->{$key} = $val;
# Make into a link if this value is a URL
$val = a( { -class=>'info', -title=>'Open URL', -href=>$val }, $val ) if $val =~ m{^http://.+};
push @html, Tr( { -class => 'info' }, th( { -class => 'info' }, $key ).td( { -class => 'info' }, $val ) );
}
# Show thumb if one exists
print $fh img( { -class=>'action', -src=>$prog{$pid}->{thumbnail} } ) if $prog{$pid}->{thumbnail};
# Set optional output dir for pvr queue if set
my $outdir;
$outdir = '&OUTPUT='.CGI::escape("$opt->{OUTPUT}->{current}") if $opt->{OUTPUT}->{current};
# Render options actions
print $fh div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Close',
-onClick => "window.close()",
},
'Close'
),
]),
),
);
print $fh table( { -class => 'info' }, @html );
return $out;
}
# Get filename from history based on PID, MODE and TYPE
# If the PID is a filename then filename is still searched using PID and TYPE
sub get_direct_filename {
my ( $pid, $mode, $type ) = ( @_ );
my $out;
my @html;
my %prog;
my $pidisfile;
my $history = 1;
print $se "DEBUG: Looking up filename for MODE=$mode TYPE=$type PID=$pid\n";
# set this flag if required and unset history if pid is a file
if ( -f $pid ) {
print $se "DEBUG: PID is a valid filename\n";
$pidisfile = 1;
$history = 0;
}
# Skip if not defined or, if pid is a file and no type defined
if ( $pidisfile && ! $type ) {
print $se "ERROR: Cannot lookup filename for PID which is a filename if type is not set\n";
return '';
}
if ( ( ! $pidisfile ) && ! ( $pid && $mode && $type ) ) {
print $se "ERROR: Cannot lookup filename unless PID, MODE and TYPE are set\n";
return '';
}
# make the pid regex friendly
$pid =~ s|([\/\.\?\+\-\*\^\(\)\[\]\{\}])|\\$1|g;
# Get the 'filename' entry from --history --info for this pid
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( 'nopurge=1', "history=$history", 'fields=pid', "search=$pid", "type=$type", 'listformat=filename: <pid>|<filename>|<mode>' ),
);
print $se "Command: ".( join ' ', @cmd )."\n"; # if $opt_cmdline->{debug};
my @cmdout = get_cmd_output( @cmd );
return p("ERROR: ".@cmdout) if $? && not $IGNOREEXIT;
# Extract the filename
my $match = ( grep /^filename:/, @cmdout )[0];
my $filename;
if ( $pidisfile ) {
$filename = $1 if $match =~ m{^filename: (\/.+?)\|<filename>\|<mode>\s*$};
} else {
$filename = $1 if $match =~ m{^filename: .+?\|\s*(.+?)\|$mode\s*$};
}
if ( $filename && $opt_cmdline->{encodinglocalefs} !~ /UTF-?8/i ) {
$filename = encode($opt_cmdline->{encodinglocalefs}, $filename, sub { '' });
}
return search_absolute_path( $filename );
}
# Hack to work around relative paths in recordings history
sub search_absolute_path {
my $filename = shift;
my $abs_path;
# win32 doesn't seem to like abs_path
# abs_path croaks on cygwin if file not found
# rewrite win32 paths
if ( IS_WIN32 || $^O eq "cygwin" ) {
# add a hardcoded prefix for now if relative path (assume relative to local get_iplayer script)
if ( $filename !~ m{^[A-Za-z]:} && $filename =~ m{^(\.|\.\.|[A-Za-z_])} ) {
$filename = dirname( abs_path( $opt_cmdline->{getiplayer} ) ).'/'.$filename;
}
if ( IS_WIN32 ) {
# twiddle the / to \
$filename =~ s!(\\/|/|\/)!\\!g;
}
return $filename;
}
#print $se "FILENAME='$filename'";
# Try using CWD
if ( -f abs_path($filename) ) {
$abs_path = abs_path($filename);
# repair abs_path decomposition of UTF-8 filename
if ( $abs_path && $opt_cmdline->{encodinglocalefs} =~ /UTF-?8/i ) {
$abs_path = decode($opt_cmdline->{encodinglocalefs}, $abs_path, sub { '' });
}
# else try dir of get_iplayer
} elsif ( -f dirname( abs_path( $opt_cmdline->{getiplayer} ) ).'/'.$filename ) {
$abs_path = dirname( abs_path( $opt_cmdline->{getiplayer} ) ).'/'.$filename;
# else try dir current output dir option
} elsif ( $opt->{OUTPUT}->{current} && -f abs_path( $opt->{OUTPUT}->{current} ).'/'.$filename ) {
$abs_path = abs_path( $opt->{OUTPUT}->{current} ).'/'.$filename;
# Else just return the relative path
} else {
$abs_path = $filename;
}
#print $se " -> ABSPATH='$abs_path'\n";
return $abs_path;
}
sub pvr_queue {
# Gets the multiple selections of progs to queue from PROGSELECT
my @record;
# The 'Record' action button uses SEARCH to pass it's pvr_queue data
if ( $cgi->param( 'SEARCH' ) ) {
push @record, $cgi->param( 'SEARCH' );
} else {
@record = ( $cgi->param( 'PROGSELECT' ) );
}
my @params = get_search_params();
my $out;
# If a URL was specified by the User (assume auto mode list is OK):
if ( $opt->{URL}->{current} =~ m{^http://} ) {
push @record, "$opt->{PROGTYPES}->{current}|$opt->{URL}->{current}|$opt->{URL}->{current}|-";
}
print $fh "<p>Queuing The Following Programmes in the PVR</p><ul>\n";
for (@record) {
chomp();
my ( $type, $pid, $name, $episode ) = (split /\|/)[0,1,2,3];
next if ! ($type && $pid );
print $fh "<li>$name - $episode ($pid)</li>\n";
}
print $fh "</ul><br />\n";
# Queue all selected 'TYPE|PID|NAME|EPISODE|MODE|CHANNEL' entries in the PVR
for (@record) {
chomp();
my ( $type, $pid, $name, $episode ) = (split /\|/)[0,1,2,3];
next if ! ($type && $pid );
my $comment = "$name - $episode";
$comment =~ s/\'\"//g;
$comment =~ s/[^\s\w\d\-:\(\)]/_/g;
$comment =~ s/^_*//g;
$comment =~ s/_*$//g;
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args(
'pvrqueue=1',
"pid=$pid",
"comment=$comment (queued: ".localtime().')',
"type=$type",
build_cmd_options( grep !/^(HISTORY|SINCE|BEFORE|HIDEDELETED|FUTURE|SEARCH|SEARCHFIELDS|PROGTYPES|EXCLUDEC.+)$/, @params )
),
);
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
my $cmdout = join "", get_cmd_output( @cmd );
return p("ERROR: ".$out) if $? && not $IGNOREEXIT;
print $fh p("Queued: $type: '$name - $episode' ($pid)");
$out .= $cmdout;
}
print $fh "<pre>$out</pre>";
# Show list below
show_pvr_list();
return $out;
}
sub recordings_delete {
# Gets the multiple selections of progs to queue from PROGSELECT
my @record;
# The 'Record' action button uses SEARCH to pass it's pvr_queue data
if ( $cgi->param( 'SEARCH' ) ) {
push @record, $cgi->param( 'SEARCH' );
} else {
@record = ( $cgi->param( 'PROGSELECT' ) );
}
my @params = get_search_params();
# Render options actions
my $buttons = div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Go Back',
-onClick => "history.back()",
},
'Back'
),
]),
),
);
# Render options actions
print $fh $buttons;
print $fh "<p>Deleting the Following Programmes:</p><ul>\n";
for (@record) {
chomp();
my ( $type, $pid, $name, $episode ) = (split /\|/)[0,1,2,3];
next if ! ($type && $pid );
print $fh "<li>$name - $episode ($pid)</li>\n";
}
print $fh "</ul><br />\n";
# Queue all selected 'TYPE|PID|NAME|EPISODE|MODE|CHANNEL' entries in the PVR
for (@record) {
chomp();
my ( $type, $pid, $name, $episode, $mode ) = (split /\|/)[0,1,2,3,4];
next if ! ($mode && $pid );
my $filename = get_direct_filename( $pid, $mode, $type );
my $dir = dirname( $filename );
my $fileregex = basename( $filename );
# get the filename less the ext
$fileregex =~ s/\.\w+$//g;
# escape regex metachars
$fileregex =~ s/([\\\^\$\.\|\?\*\+\(\)\[\]])/\\$1/g;
$fileregex .= '\.\w+$';
# Find matching files <filename>.*
my $deleted;
if ( opendir DIR, $dir ) {
for my $file ( grep { /$fileregex/ } readdir(DIR) ) {
# Use absolute path
$file = "${dir}/${file}";
if ( -f $file ) {
if ( ! unlink( $file ) ) {
print $fh p("ERROR: Failed to delete $file");
} else {
$deleted = 1;
print $fh p("Successfully deleted: $type: '$name - $episode', MODE: $mode, PID: $pid");
}
} else {
print $fh p("ERROR: File does not exist for: $type: '$name - $episode', MODE: $mode, PID: $pid, FILENAME: $filename");
}
}
if ( ! $deleted ) {
print $fh p("No files deleted: $type: '$name - $episode', MODE: $mode, PID: $pid");
}
closedir(DIR);
} else {
print $fh p("ERROR: Cannot open dir '$dir' for file deletion\n");
}
}
# Render options actions
print $fh $buttons;
return '';
}
sub build_cmd_options {
my @options;
for ( @_ ) {
# skip non-options
next if $opt->{$_}->{optkey} eq '' || not defined $opt->{$_}->{optkey} || not $opt->{$_}->{optkey};
my $value = $opt->{$_}->{current};
push @options, "$opt->{$_}->{optkey}=$value" if $value ne '';
}
return @options;
}
sub get_search_params {
my @params;
for ( keys %{ $opt } ) {
# skip non-options
next if $opt->{$_}->{optkey} eq '' || not defined $opt->{$_}->{optkey} || not $opt->{$_}->{optkey};
next if grep /^$_$/, @nosearch_params;
push @params, $_;
}
return @params;
}
# Return get_iplayer command options when supplied an array of <key>=<value> options
sub get_iplayer_webrequest_args {
my @cmdopts;
print $se 'DEBUG: get_iplayer options: "'.join('" "', @_)."\"\n";
for (@_) {
push @cmdopts, CGI::escape($_);
}
my $cmdline = join('?', @cmdopts);
return $cmdline;
}
sub pvr_add {
my $out;
my @params = get_search_params();
# Only allow alphanumerics,_,-,. here for security reasons
my $searchname = "$opt->{SEARCH}->{current}_$opt->{SEARCHFIELDS}->{current}_$opt->{PROGTYPES}->{current}";
$searchname =~ s/[^\w\-\. \+\(\)]/_/g;
# Remove a few options from leaking into a PVR search
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( "pvradd=$searchname", build_cmd_options( grep !/^(HISTORY|HIDEDELETED|SINCE|BEFORE|HIDE|FORCE|FUTURE)$/, @params ) ),
);
print $se "DEBUG: Command: ".( join ' ', @cmd )."\n";
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
$out = join "", get_cmd_output( @cmd );
return p("ERROR: ".$out) if $? && not $IGNOREEXIT;
print $fh p("Added PVR Search ($searchname):\n\tTypes: $opt->{PROGTYPES}->{current}\n\tSearch: $opt->{SEARCH}->{current}\n\tSearch Fields: $opt->{SEARCHFIELDS}->{current}\n");
print $fh "<pre>$out</pre>";
# Show list below
show_pvr_list();
return $out;
}
# Delete then add again - just in case user has edited name of pvr search
sub pvr_save {
my $out;
my @keys = $cgi->param( 'EDITKEYS' );
my @values = $cgi->param( 'EDITVALUES' );
my @params;
my @search_args;
my $newsearchname;
# Convert the two keys and values arrays into a KEY=VALUE params array
for ( @keys ) {
my $val = shift @values;
if ( $_ eq 'pvrsearch' ) {
$newsearchname = $val;
# append search terms to cmdline
} elsif ( /^search\d+$/ && $val !~ /^\-/ ) {
push @search_args, $val;
} else {
push @params, $_.'='.$val;
}
}
#print STDERR "ELEMENTS for save: ".(join ',', @params)."\n\n";
# Sanity check
if ( $newsearchname eq '' ) {
print $fh p("No PVR Search Name Specified - not updated");
return;
}
# Delete the original pvr entry
my $searchname = $cgi->param( 'PVRSEARCH' );
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( "pvrdel=$searchname" ),
);
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
my $cmdout = join "", get_cmd_output( @cmd );
return p("ERROR: ".$out) if $? && not $IGNOREEXIT;
print $fh p("Deleted: $searchname");
$out .= $cmdout;
# Add the new pvr entry
@cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( "pvradd=$newsearchname", @params ),
'--',
@search_args,
);
print $se "DEBUG: Command: ".( join ' ', @cmd )."\n";
print $fh p("Command: ".( join ' ', @cmd ) ) if $opt_cmdline->{debug};
$out = join "", get_cmd_output( @cmd );
return p("ERROR: ".$out) if $? && not $IGNOREEXIT;
print $fh p("Added Updated PVR Search '$newsearchname'\n");
print $fh "<pre>$out</pre>";
# Show list below
show_pvr_list();
return $out;
}
# Build templated HTML for an option specified by passed hashref
sub build_option_html {
my $arg = shift;
my $title = $arg->{title};
my $tooltip = $arg->{tooltip};
my $webvar = $arg->{webvar};
my $option = $arg->{option};
my $type = $arg->{type};
my $label = $arg->{label};
my $current = $arg->{current};
my $value = $arg->{value};
my $status = $arg->{status};
my @html;
# On/Off
if ( $type eq 'hidden' ) {
push @html, hidden(
-name => $webvar,
-id => "option_$webvar",
#-value => $arg->{default},
-value => $current,
-override => 1,
);
# On/Off
} elsif ( $type eq 'boolean' ) {
push @html, th( { -class => 'options', -title => $tooltip, -id => "label_option_$webvar" }, $title ).
td( { -class => 'options', -title => $tooltip },
checkbox(
-class => 'options',
-name => $webvar,
-id => "option_$webvar",
-label => '',
#-value => 1,
-checked => $current,
-override => 1,
"aria-labelledby" => "label_option_$webvar",
)
);
# On/Off
} elsif ( $type eq 'radioboolean' ) {
push @html, th( { -class => 'options', -title => $tooltip }, $title ).
td( { -class => 'options', -title => $tooltip },
radio_group(
-class => 'options',
-name => $webvar,
-values => [ 0 , 1 ],
-labels => { 0=>'Off' , 1=>'On' },
-default => $current,
-override => 1,
)
);
# Multi-On/Off
} elsif ( $type eq 'multiboolean' ) {
my $element;
# values in hash of $value->{<order>} => value
# labels in hash of $label->{$value}
# selected status in $status->{$value}
my @keylist = sort { $a <=> $b } keys %{ $value };
my $count = 0;
while ( @keylist ) {
my $val = $value->{shift @keylist};
$element .=
td( { -class => 'options' },
table ( { -class => 'options_embedded', -title => $tooltip, -role=>'presentation' }, Tr( { -class => 'options_embedded' }, td( { -class => 'options_embedded' }, [
checkbox(
-class => 'options',
-name => $webvar,
-id => "option_${webvar}_$val",
-label => '',
-value => $val,
-checked => $status->{$val},
-override => 1,
"aria-labelledby" => "label_option_${webvar}_$val",
),
span({ -id=> "label_option_${webvar}_$val" }, $label->{$val})
] ) ) )
);
# Spread over more rows if there are many elements
if ( not ( ($count+1) % 3 ) ) {
$element .= '<tr class="options_embedded">';
}
$count++;
}
my $inner_table = table ( { -class => 'options_embedded' }, Tr( { -class => 'options_embedded' },
$element
) );
push @html, th( { -class => 'options', -title => $tooltip }, $title ).td( { -class => 'options' }, $inner_table );
# Popup type
} elsif ( $type eq 'popup' ) {
my @value = $arg->{value};
push @html, th( { -class => 'options', -title => $tooltip, -id => "label_option_$webvar" }, $title ).
td( { -class => 'options', -title => $tooltip },
popup_menu(
-class => 'options',
-name => $webvar,
-id => "option_$webvar",
-values => @value,
-labels => $label,
-default => $current,
-onChange => $arg->{onChange},
"aria-labelledby" => "label_option_$webvar",
)
);
# text field
} elsif ( $type eq 'text' ) {
push @html, th( { -class => 'options', -title => $tooltip, -id => "label_option_$webvar" }, $title ).
td( { -class => 'options', -title => $tooltip },
textfield(
-class => 'options',
-name => $webvar,
-value => $current,
-size => $value,
-onKeyDown => 'return submitonEnter(event);',
"aria-labelledby" => "label_option_$webvar",
)
);
}
return @html;
}
sub refresh {
my $typelist = join(",", $cgi->param( 'PROGTYPES' )) || 'tv';
my $refreshfuture = $cgi->param( 'REFRESHFUTURE' ) || 0;
print $fh "<strong><p>The cache will auto-refresh every $opt->{AUTOWEBREFRESH}->{current} hour(s) if you leave this page open</p></strong>" if $opt->{AUTOWEBREFRESH}->{current};
if ( IS_WIN32 ) {
print $fh "<strong><p>Windows users: You may encounter errors if you perform other tasks in the Web PVR Manager while this page is reloading</p></strong>" if $opt->{AUTOWEBREFRESH}->{current};
}
print $se "INFO: Refreshing\n";
my @cmd = (
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--webrequest',
get_iplayer_webrequest_args( 'expiry=30', 'nopurge=1', "type=$typelist", "refreshfuture=$refreshfuture", "search=no search just refresh" ),
);
print $fh '<pre>';
run_cmd_autorefresh( $fh, $se, 1, @cmd );
print $fh '</pre>';
print $fh p("Flushed Programme Caches for Types: $typelist");
# Load the refresh tab if required
my $autorefresh = $cgi->cookie( 'AUTOWEBREFRESH' ) || $cgi->param( 'AUTOWEBREFRESH' );
# Render options actions
print $fh div( { -class=>'action' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
a(
{
-class=>'action',
-title => 'Refresh Cache Now',
-onClick => "RefreshTab( '?NEXTPAGE=refresh&PROGTYPES=$typelist&AUTOWEBREFRESH=$autorefresh', ".(1000*3600*$autorefresh).", 1 );",
},
'Force Refresh'
),
a(
{
-class=>'action',
-title => 'Go Back',
-onClick => "window.close()",
},
'Close'
),
]),
),
);
}
# Just a wrapper to search_progs which defines history search settings for 'Recordings' tab
sub search_history {
$opt->{HISTORY}->{current} = 1;
$opt->{SORT}->{current} = 'timeadded';
$opt->{REVERSE}->{current} = 1;
$opt->{SINCE}->{current} = '';
$opt->{BEFORE}->{current} = '';
$opt->{EXCLUDE}->{current} = '';
$opt->{CATEGORY}->{current} = '';
$opt->{EXCLUDECATEGORY}->{current} = '';
$opt->{CHANNEL}->{current} = '';
$opt->{EXCLUDECHANNEL}->{current} = '';
search_progs();
}
sub search_progs {
# Set default status for progtypes
my %type;
$type{$_} = 1 for split /,/, $opt->{PROGTYPES}->{current};
$opt->{PROGTYPES}->{status} = \%type;
# Determine which cols to display and Set default status for cols
get_display_cols();
#for my $key (sort keys %ENV) {
# print $fh $key, " = ", $ENV{$key}, "\n<br>";
#}
# Get prog data
my @params = get_search_params();
my ( $matchcount, $response ) = ( get_progs( @params ) );
if ( $response ) {
print $fh p("ERROR: get_iplayer returned non-zero:").br().p( join '<br>', $response );
return 1;
}
my ($first, $last, @pagetrail) = pagetrail( $opt->{PAGENO}->{current}, $opt->{PAGESIZE}->{current}, $matchcount, 7 );
# Default displaycols
my @html;
push @html, "<tr>";
push @html, th( { -class => 'search' }, checkbox( -class=>'search', -title=>'Select/Unselect All Programmes', -onClick=>"check_toggle(document.form1, 'PROGSELECT')", -name=>'SELECTOR', -value=>'1', -label=>'' ) );
# Pad empty column for R/S
push @html, th( { -class => 'search' }, 'Actions' );
# Display data in nested table
for my $heading (@displaycols) {
# Sort by column click and change display class (colour) according to sort status
my ($title, $class, $onclick);
if ( $opt->{SORT}->{current} eq $heading && not $opt->{REVERSE}->{current} ) {
($title, $class, $onclick) = ("Sort by Reverse $heading", 'sorted pointer', "form1.NEXTPAGE.value='search_progs'; form1.SORT.value='$heading'; form1.REVERSE[0].checked=true; form1.submit();");
} else {
($title, $class, $onclick) = ("Sort by $heading", 'unsorted pointer', "form1.NEXTPAGE.value='search_progs'; form1.SORT.value='$heading'; form1.REVERSE[1].checked=true; form1.submit();");
}
$class = 'sorted_reverse pointer' if $opt->{SORT}->{current} eq $heading && $opt->{REVERSE}->{current};
push @html,
th( { -class => 'search' },
table( { -class => 'searchhead', -role=>'presentation' },
Tr( { -class => 'search' }, [
th( { -class => 'search' },
label( {
-title => $title,
-class => $class,
-onClick => $onclick,
},
$fieldname{$heading},
)
)
]
)
)
);
}
push @html, "</tr>";
# Set optional output dir for pvr queue if set
my $outdir;
$outdir = '&OUTPUT='.CGI::escape("$opt->{OUTPUT}->{current}") if $opt->{OUTPUT}->{current};
# Build each prog row
my $time = time();
for ( my $i = 0; $i <= $#pids; $i++ ) {
my $search_class = 'search';
my $pid = $pids[$i];
my @row;
# Grey-out history lines which files have been deleted or where the history doesn't have a filename mentioned
if ( $opt->{HISTORY}->{current} && ! $opt->{HIDEDELETED}->{current} ) {
if ( $prog{$pid}->{filename} && $opt_cmdline->{encodinglocalefs} !~ /UTF-?8/i ) {
$prog{$pid}->{filename} = encode($opt_cmdline->{encodinglocalefs}, $prog{$pid}->{filename}, sub { '' });
}
if ( ( ! $prog{$pid}->{filename} ) || ! -f $prog{$pid}->{filename} ) {
$search_class = 'search darker';
}
}
# Format of PROGSELECT: TYPE|PID|NAME|EPISODE|MODE|CHANNEL
push @row, td( {-class=>$search_class},
checkbox(
-class => $search_class,
-name => 'PROGSELECT',
-label => '',
-value => "$prog{$pid}->{type}|$pid|$prog{$pid}->{name}|$prog{$pid}->{episode}|$prog{$pid}->{mode}|$prog{$pid}->{channel}",
-checked => 0,
-override => 1,
)
);
# Record and stream links
my $links;
# 'Play'
# Search mode with filename as pid
if ( $pid =~ m{^/} ) {
if ( -f $pid ) {
# Play
$links .= a( { -class=>$search_class, -title=>"Play from file on web server", -href=>build_url_playlist( '', 'playlist', 'pid', $pid, $opt->{MODES}->{current} || $default_modes, $prog{$pid}->{type}, basename( $pid ) , $opt->{STREAMTYPE}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} ) }, 'Play' ).'<br />';
# PlayFile
$links .= a( { -id=>'nowrap', -class=>$search_class, -title=>"Play from local file", -href=>build_url_playlist( '', 'playlistfiles', 'pid', $pid, $prog{$pid}->{mode}, $prog{$pid}->{type}, undef, undef ) }, 'Play File' ).'<br />';
# PlayDirect
$links .= a( { -id=>'nowrap', -class=>$search_class, -title=>"Stream file into browser", -href=>build_url_direct( '', $prog{$pid}->{type}, $pid, $prog{$pid}->{mode}, $opt->{STREAMTYPE}->{current}, $opt->{STREAMTYPE}->{current}, $opt->{HISTORY}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} ) }, 'Play Direct' ).'<br />';
}
# History mode
} elsif ( $opt->{HISTORY}->{current} ) {
if ( $opt->{HIDEDELETED}->{current} || -f $prog{$pid}->{filename} ) {
# Play (Play Remote)
$links .= a( { -id=>'nowrap', -class=>$search_class, -title=>"Play from file on web server", -href=>build_url_playlist( '', 'playlistdirect', 'pid', $pid, $prog{$pid}->{mode}, $prog{$pid}->{type}, 'flv', 'flv', $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} ) }, 'Play' ).'<br />';
# PlayFile
$links .= a( { -id=>'nowrap', -class=>$search_class, -title=>"Play from local file", -href=>build_url_playlist( '', 'playlistfiles', 'pid', $pid, $prog{$pid}->{mode}, $prog{$pid}->{type}, undef ) }, 'Play File' ).'<br />';
# PlayDirect - depends on browser support
$links .= a( { -id=>'nowrap', -class=>$search_class, -title=>"Stream file into browser", -href=>build_url_direct( '', $prog{$pid}->{type}, $pid, $prog{$pid}->{mode}, $opt->{STREAMTYPE}->{current}, $opt->{STREAMTYPE}->{current}, $opt->{HISTORY}->{current}, $opt->{BITRATE}->{current}, $opt->{VSIZE}->{current}, $opt->{VFR}->{current}, $opt->{VERSIONLIST}->{current} ) }, 'Play Direct' ).'<br />';
}
# Search mode
} else {
# Record
$links .= label( { -id=>'nowrap', -class=>$search_class, -title=>"Record '$prog{$pid}->{name} - $prog{$pid}->{episode}' Now", -onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='record_now'; form1.SEARCH.value='".encode_entities("$prog{$pid}->{type}|$pid|$prog{$pid}->{name}|$prog{$pid}->{episode}|$prog{$pid}->{mode}")."'; form1.target='_newtab_$pid'; form1.submit(); RestoreFormVars(form1); form1.target='';" }, 'Record' ).'<br />';
# Queue
$links .= label( { -id=>'nowrap', -class=>$search_class, -title=>"Queue '$prog{$pid}->{name} - $prog{$pid}->{episode}' for PVR Recording", -onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='pvr_queue'; form1.SEARCH.value='".encode_entities("$prog{$pid}->{type}|$pid|$prog{$pid}->{name}|$prog{$pid}->{episode}|$prog{$pid}->{mode}")."'; form1.submit(); RestoreFormVars(form1);" }, 'Queue' ).'<br />';
# Add Series
# escape regex metacharacters in programme name
(my $escaped_name = $prog{$pid}->{name}) =~ s/([\\\^\$\.\|\?\*\+\(\)\[\]])/\\\\$1/g;
$links .= label( {
-id=>'nowrap',
-class=>'search pointer_noul',
-title=>"Add Series '$prog{$pid}->{name}' to PVR",
-onClick=>"BackupFormVars(form1); form1.NEXTPAGE.value='pvr_add'; form1.SEARCH.value='".encode_entities("^$escaped_name\$")."'; form1.SEARCHFIELDS.value='name'; form1.PROGTYPES.value='$prog{$pid}->{type}'; form1.HISTORY.value='0'; form1.SINCE.value=''; form1.BEFORE.value=''; form1.submit(); RestoreFormVars(form1);" }, 'Add Series' );
}
# Add links to row
push @row, td( {-class=>$search_class}, $links );
# This builds each row in turn
for ( @displaycols ) {
# display thumb if defined (will have to use proxy to get file:// thumbs)
if ( /^thumbnail$/ ) {
# Assume a thumbnail prefix if one is missing for BBC iPlayer
if ( ! $prog{$pid}->{$_} && $pid =~ m{^[wpb]0[a-z0-9]{6}$} && $prog{$pid}->{type} =~ /^(tv|radio)$/ ) {
$prog{$pid}->{$_} = "http://www.bbc.co.uk/iplayer/images/episode/${pid}_150_84.jpg";
}
if ( $prog{$pid}->{$_} =~ m{^http://} ) {
push @row, td( {-class=>$search_class}, a( { -title=>"Open original web URL", -class=>$search_class, -href=>$prog{$pid}->{web} }, img( { -class=>$search_class, -height=>40, -src=>$prog{$pid}->{$_} } ) ) );
} else {
push @row, td( {-class=>$search_class}, a( { -title=>"Open original web URL", -class=>$search_class, -href=>$prog{$pid}->{web} }, 'Open URL' ) );
}
# Calculate the seconds difference between epoch_now and epoch_datestring and convert back into array_time
} elsif ( /^timeadded$/ ) {
my @t = gmtime( $time - $prog{$pid}->{$_} );
my $years = ($t[5]-70)."y " if ($t[5]-70) > 0;
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -title=>"Click for full info", -onClick=>"BackupFormVars(form1); form1.NEXTPAGE.value='show_info'; form1.INFO.value='".encode_entities("$prog{$pid}->{type}|$pid")."'; form1.target='_blank'; form1.submit(); RestoreFormVars(form1); form1.target='';" }, "${years}$t[7]d $t[2]h ago" ) );
} elsif ( /^expires$/ ) {
my $expires;
if ( $prog{$pid}->{$_} && $prog{$pid}->{$_} > $time ) {
my @t = gmtime( $prog{$pid}->{$_} - $time );
my $years = ($t[5]-70)."y " if ($t[5]-70) > 0;
$expires = "in ${years}$t[7]d $t[2]h";
}
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -title=>"Click for full info", -onClick=>"BackupFormVars(form1); form1.NEXTPAGE.value='show_info'; form1.INFO.value='".encode_entities("$prog{$pid}->{type}|$pid")."'; form1.target='_blank'; form1.submit(); RestoreFormVars(form1); form1.target='';" }, $expires ) );
# truncate the description if it is too long
} elsif ( /^desc$/ ) {
my $text = $prog{$pid}->{$_};
$text = substr($text, 0, 256).'...[more]' if length( $text ) > 256;
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -title=>"Click for full info", -onClick=>"BackupFormVars(form1); form1.NEXTPAGE.value='show_info'; form1.INFO.value='".encode_entities("$prog{$pid}->{type}|$pid")."'; form1.target='_blank'; form1.submit(); RestoreFormVars(form1); form1.target='';" }, $text ) );
# Name / Series link
} elsif ( /^name$/ ) {
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -id=>'underline', -title=>"Click to list '$prog{$pid}->{$_}'",
-onClick=>"
BackupFormVars(form1);
form1.NEXTPAGE.value='search_progs';
form1.SEARCHFIELDS.value='name';
form1.SEARCH.value='".encode_entities('^'.$prog{$pid}->{$_}.'$')."';
form1.PAGENO.value=1;
form1.submit();
RestoreFormVars(form1);
"}, $prog{$pid}->{$_} )
);
# Channel link
} elsif ( /^channel$/ ) {
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -id=>'underline', -title=>"Click to list '$prog{$pid}->{$_}'",
-onClick=>"
BackupFormVars(form1);
form1.NEXTPAGE.value='search_progs';
form1.CHANNEL.value='".encode_entities('^'.$prog{$pid}->{$_}.'$')."';
form1.EXCLUDECHANNEL.value='';
form1.SEARCH.value='.*';
form1.PAGENO.value=1;
form1.submit();
RestoreFormVars(form1);
"}, $prog{$pid}->{$_} )
);
# Category links
} elsif ( /^categories$/ ) {
my @cats = split /,/, $prog{$pid}->{$_};
for ( @cats ) {
my $category = $_;
$_ = label( { -class=>$search_class, -id=>'underline', -title=>"Click to list '$category'",
-onClick=>"
BackupFormVars(form1);
form1.NEXTPAGE.value='search_progs';
form1.EXCLUDE.value='';
form1.CATEGORY.value='".encode_entities($category)."';
form1.EXCLUDECATEGORY.value='';
form1.SEARCH.value='.*';
form1.PAGENO.value=1;
form1.submit();
RestoreFormVars(form1);
"},
$category );
}
push @row, td( {-class=>$search_class}, @cats );
# Every other column type
} else {
push @row, td( {-class=>$search_class}, label( { -class=>$search_class, -title=>"Click for full info", -onClick=>"BackupFormVars(form1); form1.NEXTPAGE.value='show_info'; form1.INFO.value='".encode_entities("$prog{$pid}->{type}|$pid")."'; form1.target='_blank'; form1.submit(); RestoreFormVars(form1); form1.target='';" }, $prog{$pid}->{$_} ) );
}
}
push @html, Tr( {-class=>$search_class}, @row );
}
# Search form
print $fh start_form(
-name => "form1",
-method => "POST",
);
# Create options tabs and buttons
# Build tab 'buttons' (actually list labels)
# Add options buttons into the list
my @optrows_nav;
my @tablist = grep !/(BASICTAB|HIDDENTAB)/, @{ $layout->{taborder} };
for my $tabname ( @tablist ) {
my $label = $layout->{$tabname}->{title};
# Set the colour to grey and change tab appearance if it is selected
my $class = 'options_tab';
if ( defined $opt->{$tabname}->{current} && $opt->{$tabname}->{current} eq 'yes' ) {
$class = 'options_tab_sel';
}
push @optrows_nav, li( { -class=>$class, -id=>"li_${tabname}" },
label( {
-class => 'options_outer pointer_noul',
-id => 'button_'.$tabname,
-title => "Show $label tab",
-onClick => "show_options_tab( '$tabname', [ '".(join "', '", @tablist )."' ] );",
},
$label ),
)
}
# add a save button on to end of list
my $options_buttons = ul( { -class=>'options_tab' },
li( { -class=>'options_button' }, [
# Apply button (same as 'Search')
label( {
-class => 'options_outer pointer_noul',
-title => 'Apply Current Options',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=1; form1.submit(); RestoreFormVars(form1);",
-role => "button",
},
'Apply Settings',
),
# Save as Default button
label( {
-class => 'options_outer pointer_noul',
-title => 'Remember Current Options as Default',
-onClick => "BackupFormVars(form1); form1.SAVE.value=1; form1.submit(); RestoreFormVars(form1);",
-role => "button",
},
'Save As Default',
),
] )
);
# Build each tab with it's contained options tables
my @opt_td;
my @opt_td_basic;
for my $tabname ( @{ $layout->{taborder} } ) {
my $tab = $layout->{$tabname};
my @order = @{ $tab->{order} };
my $heading = $tab->{heading};
# Set displayed tab status (i.e. style) based on posted/cookie vars (always display basic tab)
$tab->{style} = "display: none; visibility: collapse;";
$tab->{style} = "display: table-cell; visibility: visible;" if $tabname eq 'BASICTAB' || ( defined $opt->{$tabname}->{current} && $opt->{$tabname}->{current} eq 'yes' );
# Each option within the tab
my @optrows;
#push @optrows, td( { -class=>'options' }, label( { -class => 'options_heading' }, $heading ) ) if $heading;
for my $optname ( @order ) {
push @optrows, build_option_html( $opt->{$optname} );
}
# Set the basic search tab to be rowspan=3
if ( $tabname eq 'BASICTAB' ) {
push @opt_td_basic, td( { -class=>'options_outer', -id=>"tab_${tabname}", -rowspan=>3, -style=>"$tab->{style}", -role=>'search' },
table( { -class=>'options' }, Tr( { -class=>'options' }, [ @optrows ] ) )
);
} else {
push @opt_td, td( { -class=>'options_outer', -id=>"tab_${tabname}", -style=>"$tab->{style}" },
table( { -class=>'options' }, Tr( { -class=>'options' }, [ @optrows ] ) )
);
}
}
# Render outer options table frame (keeping some tabs hidden)
print $fh table( { -class=>'options_outer' },
Tr( { -class=>'options_outer' }, (join '', @opt_td_basic). td( { -class=>'options_outer' }, ul( { -class=>'options_tab', -role=>'navigation', 'aria-label'=>'Settings' }, @optrows_nav ) ) ).
Tr( { -class=>'options_outer' }, (join '', @opt_td) ).
Tr( { -class=>'options_outer' }, td( { -class=>'options_outer' }, $options_buttons ) )
);
# Grey-out 'Add Current Search to PVR' button if too many programme matches
my $add_search_class_suffix;
$add_search_class_suffix = ' darker' if $matchcount > 30;
my %action_button;
$action_button{'Search'} = a(
{
-class => 'action',
-title => 'Perform search based on search options',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=1; form1.submit(); RestoreFormVars(form1);",
},
'Search'
);
$action_button{'Queue'} = a(
{
-class => 'action',
-title => 'Queue selected programmes (or Quick URL) for one-off recording',
-onClick => "if(! ( check_if_selected(document.form1, 'PROGSELECT') || form1.URL.value ) ) { alert('No Quick URL or programmes were selected'); return false; } BackupFormVars(form1); form1.SEARCH.value=''; form1.NEXTPAGE.value='pvr_queue'; form1.submit(); RestoreFormVars(form1); form1.URL.value=''; disable_selected_checkboxes(document.form1, 'PROGSELECT');",
},
'Queue'
);
$action_button{'Record'} = a(
{
-class => 'action',
-title => 'Immediately Record selected programmes (or Quick URL) in a new tab',
-onClick => "if(! ( check_if_selected(document.form1, 'PROGSELECT') || form1.URL.value ) ) { alert('No Quick URL or programmes were selected'); return false; } BackupFormVars(form1); form1.SEARCH.value=''; form1.NEXTPAGE.value='record_now'; var random=Math.floor(Math.random()*99999); form1.target='_newtab_'+random; form1.submit(); RestoreFormVars(form1); form1.target=''; form1.URL.value=''; disable_selected_checkboxes(document.form1, 'PROGSELECT');",
},
'Record'
);
$action_button{'Delete'} = a(
{
-class => 'action',
-title => 'Permanently delete selected recorded files',
-onClick => "if(! check_if_selected(document.form1, 'PROGSELECT')) { alert('No programmes were selected'); return false; } BackupFormVars(form1); form1.SEARCH.value=''; form1.NEXTPAGE.value='recordings_delete'; form1.submit(); RestoreFormVars(form1);",
},
'Delete'
);
$action_button{'Play'} = a(
{
-class => 'action',
-title => 'Get a Playlist based on selected programmes for remote file streaming in your media player',
-onClick => "if(! check_if_selected(document.form1, 'PROGSELECT')) { alert('No programmes were selected'); return false; } BackupFormVars(form1); form1.SEARCH.value=''; form1.ACTION.value='genplaylistdirect'; form1.submit(); RestoreFormVars(form1);",
},
'Play'
);
$action_button{'Play Files'} = a(
{
-class => 'action',
-title => 'Get a Playlist based on selected programmes for local file streaming in your media player',
-onClick => "if(! check_if_selected(document.form1, 'PROGSELECT')) { alert('No programmes were selected'); return false; } BackupFormVars(form1); form1.SEARCH.value=''; form1.ACTION.value='genplaylistfile'; form1.submit(); RestoreFormVars(form1);",
},
'Play Files'
);
# check for an non-whitespace advanced search entries
# excluding Programme Version and Search Future Schedule
my $num_adv_srch = grep /\S/, (
$opt->{EXCLUDE}->{current},
$opt->{EXCLUDECATEGORY}->{current},
$opt->{CATEGORY}->{current},
$opt->{CHANNEL}->{current},
$opt->{EXCLUDECHANNEL}->{current},
$opt->{SINCE}->{current},
$opt->{BEFORE}->{current}
);
(my $escaped_search = $opt->{SEARCH}->{current}) =~ s/'/\\'/g;
$action_button{'Add Search to PVR'} = a(
{
-class => 'action'.$add_search_class_suffix,
-title => 'Create a persistent PVR search using the current search terms (i.e. all below programmes)',
-onClick => "if ('".$escaped_search."' == '.*' && $num_adv_srch == 0) { alert('Search = .* will download all available programmes. Please enter a more specific search term or additional advanced search criteria (excluding $opt->{VERSIONLIST}->{title} and $opt->{FUTURE}->{title}).'); return false; } if ('".$escaped_search."' == '' ) { alert('Please enter a search term. Use Search = .* to record all programmes matching advanced search criteria.'); return false; } if ( $matchcount > 30 ) { alert('Please limit your search to result in no more than 30 current programmes'); return false; } BackupFormVars(form1); form1.NEXTPAGE.value='pvr_add'; form1.submit(); RestoreFormVars(form1);",
},
'Add Search to PVR'
);
#my $autorefresh = $cgi->cookie( 'AUTOWEBREFRESH' ) || $cgi->param( 'AUTOWEBREFRESH' );
$action_button{'Refresh Cache'} = a(
{
-class => 'action',
-title => 'Refresh the list of programmes - can take a while',
-onClick => "BackupFormVars(form1); form1.target='_newtab_refresh'; form1.NEXTPAGE.value='refresh'; form1.submit(); RestoreFormVars(form1); form1.target=''; form1.NEXTPAGE.value=''; ",
#-onClick => "window.frames['dataframe'].window.location.replace('?NEXTPAGE=refresh&AUTOWEBREFRESH=$autorefresh')",
},
'Refresh Cache'
);
# Render action bar
my @actionbar;
if ( $opt->{HISTORY}->{current} ) {
push @actionbar, div( { -class=>'action', -role=>'navigation', 'aria-label'=>'Actions' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
$action_button{'Search'},
$action_button{'Delete'},
$action_button{'Play'},
$action_button{'Play Files'},
]),
),
);
} else {
push @actionbar, div( { -class=>'action', -role=>'navigation', 'aria-label'=>'Actions' },
ul( { -class=>'action' },
li( { -class=>'action' }, [
$action_button{'Search'},
$action_button{'Record'},
$action_button{'Queue'},
$action_button{'Add Search to PVR'},
$action_button{'Refresh Cache'},
]),
),
);
}
print $fh @actionbar;
print $fh @pagetrail;
print $fh table( {-class=>'search', -role=>'main' }, @html );
print $fh @pagetrail;
print $fh @actionbar;
print $fh div( {id=>'status'} );
print $fh end_form();
return 0;
}
# Build page trail
sub pagetrail {
my ( $page, $pagesize, $count, $trailsize ) = ( @_ );
# How many pages
my $pages = int( $count / $pagesize ) + 1;
# If we request a page that is too high
$page = $pages if $page > $pages;
# Calc first and last programme numbers
my $first = $pagesize * ($page - 1);
my $last = $first + $pagesize;
$last = $count if $last > $count;
#print $se "PAGETRAIL: page=$page, first=$first, last=$first, pages=$pages, trailsize=$trailsize\n";
# Page trail
my @pagetrail;
push @pagetrail, td( { -class=>'pagetrail pointer' }, label( {
-title => "Previous Page",
-class => 'pagetrail pointer',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=$page-1; form1.submit(); RestoreFormVars(form1);",},
"<<",
)) if $page > 1;
push @pagetrail, td( { -class=>'pagetrail pointer' }, label( {
-title => "Page 1",
-class => 'pagetrail pointer',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=1; form1.submit(); RestoreFormVars(form1);",},
"1",
)) if $page > 1;
push @pagetrail, td( { -class=>'pagetrail' }, '...' ) if $page > $trailsize+2;
for (my $pn=$page-$trailsize; $pn <= $page+$trailsize; $pn++) {
push @pagetrail, td( { -class=>'pagetrail pointer' }, label( {
-title => "Page $pn",
-class => 'pagetrail pointer',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value='$pn'; form1.submit(); RestoreFormVars(form1);",},
"$pn",
)) if $pn > 1 && $pn != $page && $pn < $pages;
push @pagetrail, td( { -class=>'pagetrail' }, label( {
-title => "Current Page",
-class => 'pagetrail-current', },
"$page",
)) if $pn == $page;
}
push @pagetrail, td( { -class=>'pagetrail' }, '...' ) if $page < $pages-$trailsize-1;
push @pagetrail, td( { -class=>'pagetrail pointer' }, label( {
-title => "Page ".$pages,
-class => 'pagetrail pointer',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=$pages; form1.submit(); RestoreFormVars(form1);",},
"$pages",
)) if $page < $pages;
push @pagetrail, td( { -class=>'pagetrail pointer' }, label( {
-title => "Next Page",
-class => 'pagetrail pointer',
-onClick => "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=$page+1; form1.submit(); RestoreFormVars(form1);",},
">>",
)) if $page < $pages;
push @pagetrail, td( { -class=>'pagetrail' }, label( {
-title => "Matches",
-class => 'pagetrail',},
"($count programmes)",
));
my @html = table( { -id=>'centered', -class=>'pagetrail' }, Tr( { -class=>'pagetrail' }, @pagetrail ));
return ($first, $last, @html);
}
sub get_progs {
my @params = @_;
my $options = '';
my $fields;
$fields .= "|<$_>" for @headings;
my ( @webrequest_args ) = ( build_cmd_options( grep !/^(PVRHOLDOFF)$/, @params ), 'nopurge=1', "listformat=ENTRY${fields}" );
# Page params
if ( $opt->{PAGENO}->{current} && $opt->{PAGESIZE}->{current} ) {
push @webrequest_args, ( "page=$opt->{PAGENO}->{current}", "pagesize=$opt->{PAGESIZE}->{current}" );
}
# Sort param
push @webrequest_args, "sortreverse=$opt->{PAGENO}->{current}" if $opt->{REVERSE}->{current};
# sort reverse param
push @webrequest_args, "sortmatches=$opt->{SORT}->{current}" if $opt->{SORT}->{current} && $opt->{SORT}->{current} ne 'name';
# Run command
my @list = get_cmd_output(
$opt_cmdline->{getiplayer},
'--encoding-locale=UTF-8',
'--encoding-console-out=UTF-8',
'--nocopyright',
'--expiry=999999999',
'--webrequest',
get_iplayer_webrequest_args( @webrequest_args ),
);
return ( '0', join("\n", @list) ) if $? && not $IGNOREEXIT;
# Get total matches count
my $matchcount = pop @list;
$matchcount = $1 if $matchcount =~ m{^INFO:\s*(\d+?)\s+};
for ( grep /^ENTRY/, @list ) {
chomp();
# Strip white space
s/\|\s*$//;
my $record;
my @element = split /\|/, $_;
shift @element;
# Put data for this contact into temporary record hash for this user
for (my $i=0; $i <= $#headings; $i++) {
$record->{$headings[$i]} = $element[$i];
}
my $search_class = 'search';
# get the real path if file is defined
$record->{filename} = search_absolute_path( $record->{filename} ) if $record->{filename} && $record->{filename} ne "<filename>";
# store record in the prog global hash (prog => pid)
$prog{ $record->{'pid'} } = $record;
push @pids, $record->{'pid'};
}
return ( $matchcount, '' );
}
#
# Get the columns to display
#
sub get_display_cols {
@displaycols = ();
# Set default status for columns options tab checkboxes
my %cols_status;
# Add some default headings for history mode
push @headings_default, 'mode' if $opt->{HISTORY}->{current};
# Determine which columns to display (all if $cols not defined)
my $cols = join(",", $opt->{COLS}->{current} ) || join ',', @headings_default;
my @columns = split /,/, $cols;
# Re-sort selected display columns into original header order
for my $heading (@headings) {
if ( grep /^$heading$/, @columns ) {
# Remove display of mode and filename if not history mode
if ( ( ! $opt->{HISTORY}->{current} ) && $heading =~ /^(mode|filename)$/ ) {
# skip
} else {
push @displaycols, $heading;
}
$cols_status{$heading} = 1;
}
}
# Make sure we select all if no cols are specified
@displaycols = @headings_default if $#displaycols < 0;
# Set defaults for checkboxes
$opt->{COLS}->{status} = \%cols_status;
# Rebuild the hash for the checkboxes
%cols_order = ();
%cols_names = ();
for ( my $i = 0; $i <= $#headings; $i++ ) {
$cols_names{$headings[$i]} = $fieldname{$headings[$i]};
$cols_order{$i} = $headings[$i];
}
return 0;
}
#############################################
#
# Form Header
#
#############################################
sub form_header {
my $request_host = shift;
my $nextpage = shift || $cgi->param( 'NEXTPAGE' );
print $fh $cgi->start_form(
-name => "formheader",
-method => "POST",
);
# set $class for tab selection in nav bar
my $class = {};
$class->{search} = 'nav_tab';
$class->{recordings} = 'nav_tab';
$class->{pvrlist} = 'nav_tab';
$class->{pvrrun} = 'nav_tab';
$class->{search} = 'nav_tab_sel' if ( $nextpage eq 'search_progs' || ! $nextpage ) && ! $opt->{HISTORY}->{current};
$class->{recordings} = 'nav_tab_sel' if $nextpage eq 'search_history' || $opt->{HISTORY}->{current};
$class->{pvrrun} = 'nav_tab_sel' if $nextpage eq 'pvr_run';
$class->{pvrlist} = 'nav_tab_sel' if $nextpage =~ m{^(pvr_list|pvr_queue|pvr_del)$};
print $fh div( { -class=>'nav', -role=>'navigation' },
ul( { -class=>'nav' },
li( { -id=>'logo', -class=>'nav_tab' },
span( { -class=>'logotext' }, 'get_iplayer' )
).
li( { -class=>$class->{search} }, a( { -class=>'nav', -title=>'Main search page', -onClick => "BackupFormVars(formheader); formheader.NEXTPAGE.value='search_progs'; formheader.submit(); RestoreFormVars(formheader);" }, 'Search' ) ).
li( { -class=>$class->{recordings} }, a( { -class=>'nav', -title=>'History search page', -onClick => "BackupFormVars(formheader); formheader.NEXTPAGE.value='search_history'; formheader.submit(); RestoreFormVars(formheader);" }, 'Recordings' ) ).
li( { -class=>$class->{pvrlist} }, a( { -class=>'nav', -title=>'List all saved PVR searches', -onClick => "BackupFormVars(formheader); formheader.NEXTPAGE.value='pvr_list'; formheader.submit(); RestoreFormVars(formheader);" }, 'PVR List' ) ).
li( { -class=>$class->{pvrrun} }, a( { -class=>'nav', -title=>'Run the PVR now - wait for the PVR to complete', -onClick => "BackupFormVars(formheader); formheader.NEXTPAGE.value='pvr_run'; formheader.target='_newtab_pvrrun'; formheader.submit(); RestoreFormVars(formheader); formheader.target='';" }, 'Run PVR' ) ).
li( { -class=>'nav_tab' }, a( { -class=>'nav', -title=>'Show help and instructions', -href => "https://github.com/get-iplayer/get_iplayer/wiki/webpvr", -target => "_new" }, 'Help' ) )
),
);
print $fh hidden( -name => 'AUTOPVRRUN', -value => $opt->{AUTOPVRRUN}->{current}, -override => 1 );
print $fh hidden( -name => 'NEXTPAGE', -value => 'search_progs', -override => 1 );
print $fh $cgi->end_form();
}
# Form Footer
sub form_footer {
#print $fh "<iframe src=\"about:blank\" height=\"100\" width=\"95%\" name=\"dataframe\"></iframe>";
#print $fh "<iframe src=\"about:blank\" height=\"0\" width=\"0\" name=\"dataframe\"></iframe>";
# <script type=\"text/javascript\">window.frames['dataframe'].window.location.replace('loadData.html');</script>
print $fh p( b({-class=>"footer"},
"get_iplayer Web PVR Manager $VERSION_TEXT, ©2009-2010 Phil Lewis - Licensed under GPLv3"
));
}
# End HTML
sub html_end {
print $fh "\n</body>";
print $fh "\n</html>\n";
}
# Gets and sets the CGI parameters (POST/Cookie) in the $opt hash - also sets $opt{VAR}->{current} from default or POST
sub process_params {
# Store options definition here as hash of 'name' => [options]
$opt->{SEARCH} = {
title => 'Search', # Title
tooltip => 'Enter your partial text match (or regex expression)', # Tooltip
webvar => 'SEARCH', # webvar
optkey => 'search', # option key
type => 'text', # type
default => '.*', # default
value => 20, # width values
save => 0,
};
$opt->{URL} = {
title => 'Quick URL', # Title
tooltip => "Enter your URL for Recording (then click 'Record' or 'Play')", # Tooltip
webvar => 'URL', # webvar
type => 'text', # type
default => '', # default
value => 36, # width values
save => 0,
};
$opt->{SEARCHFIELDS} = {
title => 'Search in', # Title
tooltip => 'Select which column you wish to search', # Tooltip
webvar => 'SEARCHFIELDS', # webvar
optkey => 'fields', # option
type => 'popup', # type
label => \%fieldname, # labels
default => 'name', # default
value => [ (@headings,'name,episode','name,episode,desc') ], # values
save => 1,
};
$opt->{PAGESIZE} = {
title => 'Programmes per Page', # Title
tooltip => 'Select the number of search results displayed on each page', # Tooltip
webvar => 'PAGESIZE', # webvar
type => 'popup', # type
default => 20, # default
value => ['10','25','50','100','200','400'], # values
onChange=> "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.PAGENO.value=1; form1.submit(); RestoreFormVars(form1);",
save => 1,
};
$opt->{SORT} = {
title => 'Sort by', # Title
tooltip => 'Sort the results in this order', # Tooltip
webvar => 'SORT', # webvar
type => 'popup', # type
label => \%fieldname, # labels
default => 'index', # default
value => [@headings], # values
onChange=> "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.submit(); RestoreFormVars(form1);",
save => 1,
};
$opt->{REVERSE} = {
title => 'Reverse sort', # Title
tooltip => 'Reverse the sort order', # Tooltip
webvar => 'REVERSE', # webvar
type => 'radioboolean', # type
#onChange=> "BackupFormVars(form1); form1.NEXTPAGE.value='search_progs'; form1.submit(); RestoreFormVars(form1);",
default => '0', # value
save => 1,
};
$opt->{PROGTYPES} = {
title => 'Programme type', # Title
tooltip => 'Select the programme types you wish to search', # Tooltip
webvar => 'PROGTYPES', # webvar
optkey => 'type', # option
type => 'multiboolean', # type
label => \%prog_types, # labels
default => 'tv',
#status => \%type, # default status
value => \%prog_types_order, # order of values
save => 1,
};
$opt->{MODES} = {
title => 'Recording Modes', # Title
tooltip => 'Comma separated list of recording modes which should be tried in order. Default is "best" for HD TV (if available, with fallback to SD TV). Set to "better" (without quotes) for best available SD TV. Set to "good" (without quotes) for lower-quality SD TV.', # Tooltip
webvar => 'MODES', # webvar
optkey => 'modes', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{OUTPUT} = {
title => 'Override Recordings Folder', # Title
tooltip => 'Folder on the server where recordings should be saved', # Tooltip
webvar => 'OUTPUT', # webvar
optkey => 'output', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{PROXY} = {
title => 'Web Proxy URL', # Title
tooltip => 'e.g. http://192.168.1.2:8080', # Tooltip
webvar => 'PROXY', # webvar
optkey => 'proxy', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{VERSIONLIST} = {
title => 'Programme Version', # Title
tooltip => 'Comma separated list of versions to try to record in order (e.g., "signed,default" or "audiodescribed,default")', # Tooltip
webvar => 'VERSIONLIST', # webvar
optkey => 'versionlist', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{EXCLUDE} = {
title => 'Exclude Programmes', # Title
tooltip => 'Comma separated list of programmes to exclude. Partial word matches and regular expressions are supported', # Tooltip
webvar => 'EXCLUDE', # webvar
optkey => 'exclude', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{CATEGORY} = {
title => 'Categories Containing', # Title
tooltip => 'Comma separated list of categories to match. Partial word matches and regular expressions are supported. Only works in Recordings tab.', # Tooltip
webvar => 'CATEGORY', # webvar
optkey => 'category', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{EXCLUDECATEGORY} = {
title => 'Exclude Categories Containing', # Title
tooltip => 'Comma separated list of categories to exclude. Partial word matches and regular expressions are supported. Only works in Recordings tab.', # Tooltip
webvar => 'EXCLUDECATEGORY', # webvar
optkey => 'excludecategory', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{CHANNEL} = {
title => 'Channels Containing', # Title
tooltip => 'Comma separated list of channels to match. Partial word matches and regular expressions are supported', # Tooltip
webvar => 'CHANNEL', # webvar
optkey => 'channel', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{EXCLUDECHANNEL} = {
title => 'Exclude Channels Containing', # Title
tooltip => 'Comma separated list of channels to exclude. Partial word matches and regular expressions are supported', # Tooltip
webvar => 'EXCLUDECHANNEL', # webvar
optkey => 'excludechannel', # option
type => 'text', # type
default => '', # default
value => 30, # width values
save => 1,
};
$opt->{HIDE} = {
title => 'Hide Recorded', # Title
tooltip => 'Whether to hide programmes that have already been successfully recorded', # Tooltip
webvar => 'HIDE', # webvar
optkey => 'hide', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
$opt->{FORCE} = {
title => 'Force Recording', # Title
tooltip => "Ignore the history and re-record a programme (Please delete the existing recording first). Doesn't apply to PVR Searches or 'Add Series'", # Tooltip
webvar => 'FORCE', # webvar
optkey => 'force', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
$opt->{REFRESHFUTURE} = {
title => 'Refresh Future Schedule', # Title
tooltip => "When Refresh is clicked also get the future programme schedule. This will take a longer time to index.", # Tooltip
webvar => 'REFRESHFUTURE', # webvar
optkey => 'refreshfuture', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
my %metadata_labels = ( ''=>'Off', generic=>'Generic XML' );
$opt->{METADATA} = {
title => 'Download Metadata', # Title
tooltip => 'Format of metadata file to create when recording', # Tooltip
webvar => 'METADATA', # webvar
optkey => 'metadata', # option
type => 'popup', # type
#label => \%fieldname, # labels
label => \%metadata_labels, # labels
default => '', # default
value => [ ( '', 'generic' ) ], # values
save => 1,
};
$opt->{SUBTITLES} = {
title => 'Download Subtitles', # Title
tooltip => 'Whether to download the subtitles when recording', # Tooltip
webvar => 'SUBTITLES', # webvar
optkey => 'subtitles', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
$opt->{THUMB} = {
title => 'Download Thumbnail', # Title
tooltip => 'Whether to download the thumbnail when recording', # Tooltip
webvar => 'THUMB', # webvar
optkey => 'thumb', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
$opt->{AUTOWEBREFRESH} = {
title => 'Auto-Refresh Cache Interval', # Title
tooltip => 'Automatically refresh the default caches in another browser tab (hours)', # Tooltip
webvar => 'AUTOWEBREFRESH', # webvar
type => 'text', # type
default => 1, # default
value => 3, # width values
save => 1,
};
$opt->{AUTOPVRRUN} = {
title => 'Auto-Run PVR Interval', # Title
tooltip => 'Automatically run the PVR in another browser tab (hours)', # Tooltip
webvar => 'AUTOPVRRUN', # webvar
type => 'text', # type
default => 4, # default
value => 3, # width values
save => 1,
};
$opt->{HISTORY} = {
title => 'Search History', # Title
tooltip => 'Whether to display and search programmes in the recordings history', # Tooltip
webvar => 'HISTORY', # webvar
optkey => 'history', # option
type => 'boolean', # type
default => '0', # value
save => 0,
};
$opt->{FUTURE} = {
title => 'Search Future Schedule', # Title
tooltip => 'Whether to additionally display and search programmes in the future programmes schedule (will only work if Refresh future schedule option is enable and refreshed)', # Tooltip
webvar => 'FUTURE', # webvar
optkey => 'future', # option
type => 'radioboolean', # type
default => '0', # value
save => 1,
};
$opt->{SINCE} = {
title => 'Added Since (hours)', # Title
tooltip => 'Only show programmes added to the local programmes cache in the past number of hours', # Tooltip
webvar => 'SINCE', # webvar
optkey => 'since', # option
type => 'text', # type
value => 3, # width values
default => '',
save => 1,
};
$opt->{BEFORE} = {
title => 'Added Before (hours)', # Title
tooltip => 'Only show programmes added to the local programmes cache over this number of hours ago', # Tooltip
webvar => 'BEFORE', # webvar
optkey => 'before', # option
type => 'text', # type
value => 3, # width values
default => '',
save => 1,
};
$opt->{PVRHOLDOFF} = {
title => 'PVR Hold off period (hours)', # Title
tooltip => 'Wait this number of hours before allowing the PVR to record a programme. This sometimes helps when the flashhd version is delayed in being made available.', # Tooltip
webvar => 'PVRHOLDOFF', # webvar
optkey => 'before', # option
type => 'text', # type
value => 3, # width values
default => '',
save => 1,
};
my %vsize_labels = ( ''=>'Native', '1280x720'=>'1280x720', '832x468'=>'832x468', '640x360'=>'640x360', '512x288'=>'512x288', '480x272'=>'480x272', '320x176'=>'320x176', '176x96'=>'176x96' );
$opt->{VSIZE} = {
title => 'Remote Streaming Video Size', # Title
tooltip => "Video size '<width>x<height>' to transcode remotely played files - leave blank for native size", # Tooltip
webvar => 'VSIZE', # webvar
type => 'popup', # type
label => , \%vsize_labels, # labels
default => '', # default
value => [ (sort {$a <=> $b} keys %vsize_labels) ], # values
save => 1,
};
$opt->{BITRATE} = {
title => 'Remote Audio Bitrate', # Title
tooltip => 'Remote Audio Bitrate (in kbps) to transcode remotely played files - leave blank for native bitrate', # Tooltip
webvar => 'BITRATE', # webvar
type => 'text', # type
value => 3, # width values
default => '',
save => 1,
};
$opt->{VFR} = {
title => 'Remote Video Frame Rate', # Title
tooltip => 'Remote Video Frame Rate (in frames per second) to transcode remotely played files - leave blank for native framerate', # Tooltip
webvar => 'VFR', # webvar
type => 'text', # type
value => 2, # width values
default => '',
save => 1,
};
my %streamtype_labels = ( ''=>'Auto', 'none'=>'Disable Transcoding', 'flv'=>'Flash Video (flv)', 'mov'=>'Quicktime (mov)', 'asf'=>'Advanced Streaming Format (asf)', 'avi'=>'AVI', 'mp3'=>'MP3 (Audio Only)', 'aac'=>'AAC (Audio Only)', 'wav'=>'WAV (Audio Only)', 'flac'=>'FLAC (Audio Only)' );
$opt->{STREAMTYPE} = {
title => "Remote Streaming type", # Title
tooltip => "Force the output to be this type when using 'Play Remote' for 'PlayDirect' streaming(e.g. flv, mov). Specify 'none' to disable transcoding/remuxing. Leave blank for auto-detection", # Tooltip
webvar => 'STREAMTYPE', # webvar
type => 'popup', # type
label => , \%streamtype_labels, # labels
default => '', # default
value => [ '', 'none', 'flv', 'mov', 'asf', 'avi', 'mp3', 'aac', 'wav', 'flac' ], # values
onChange=> "form1.submit();",
save => 1,
};
# Whether to hide deleted programmes from the Recordings display.
$opt->{HIDEDELETED} = {
title => 'Hide Deleted Recordings', # Title
tooltip => 'Whether to hide deleted programmes from the recordings history list', # Tooltip
webvar => 'HIDEDELETED', # webvar
optkey => 'skipdeleted', # option
type => 'radioboolean', # type
default => 0, # value
save => 1,
};
# Which columns to display
$opt->{COLS} = {
title => 'Enable Columns', # Title
tooltip => 'Select the columns you wish to display', # Tooltip
webvar => 'COLS', # webvar
#optkey => 'type', # option
type => 'multiboolean', # type
label => \%cols_names, # labels
#status => \%cols_status, # default status
value => \%cols_order, # order of values
save => 1,
};
# Make sure we go to the correct nextpage for processing
$opt->{NEXTPAGE} = {
webvar => 'NEXTPAGE',
type => 'hidden',
default => 'search_progs',
save => 0,
};
# Make sure we go to the correct nextpage for processing
$opt->{ACTION} = {
webvar => 'ACTION',
type => 'hidden',
default => '',
save => 0,
};
# Make sure we go to the correct next page no.
$opt->{PAGENO} = {
webvar => 'PAGENO',
type => 'hidden',
default => 1,
save => 0,
};
# Remeber the status of the tab options display
for my $tabname ( grep !/BASICTAB/, @{ $layout->{taborder} } ) {
my $default = 'no';
# By default only show advanced search tab
$default = 'yes' if $tabname eq 'SEARCHTAB';
$opt->{$tabname} = {
webvar => $tabname, # webvar
type => 'hidden', # type
default => $default, # value
save => 0,
};
}
# Save the status of the Advanced Search options and preferences settings
$opt->{SAVE} = {
webvar => 'SAVE', # webvar
type => 'hidden', # type
default => '0', # value
save => 0,
};
# INFO for page info if clicked
$opt->{INFO} = {
webvar => 'INFO',
type => 'hidden',
default => 0,
save => 0,
};
# Go through each of the options defined above
for ( keys %{ $opt } ) {
# Ignore cookies if we are saving new ones
if ( not $cgi->param('SAVE') ) {
if ( defined $cgi->param($_) ) {
print $se "DEBUG: GOT Param $_ = ".$cgi->param($_)."\n" if $opt_cmdline->{debug};
$opt->{$_}->{current} = join ",", $cgi->param($_);
} elsif ( defined $cgi->cookie($_) ) {
print $se "DEBUG: GOT Cookie $_ = ".$cgi->cookie($_)."\n" if $opt_cmdline->{debug};
$opt->{$_}->{current} = join ",", $cgi->cookie($_);
} else {
$opt->{$_}->{current} = join ",", $opt->{$_}->{default};
}
print $se "DEBUG: Using $_ = $opt->{$_}->{current}\n--\n" if $opt_cmdline->{debug};
} else {
$opt->{$_}->{current} = join(",", $cgi->param($_) ) || $opt->{$_}->{default} if not defined $opt->{$_}->{current};
}
}
}
######################################################################
#
# begin_html
#
# Send HTTP headers to browser
# Sets "title", Sends <HTML> and <BODY> flags
#
######################################################################
sub begin_html {
my $request_host = shift;
my $mimetype = 'text/html';
# Save settings if selected
my @cookies;
if ( $cgi->param('SAVE') ) {
print $se "DEBUG: Sending cookies\n";
for ( %{ $opt } ) {
# skip if opt not allowed to be saved
next if not $opt->{$_}->{save};
my $cookie = $cgi->cookie( -name=>$_, -value=>$opt->{$_}->{current}, -expires=>'+1y' );
push @cookies, $cookie;
print $se "DEBUG: Sending cookie: $cookie\n" if $opt_cmdline->{debug};
}
# Ensure SAVE state is reset to off
$opt->{SAVE}->{current} = 0;
}
# Send the headers to the browser
my $headers = $cgi->header(
-type => $mimetype,
-charset => 'utf-8',
-cookie => [@cookies],
);
print $se "\nHEADERS:\n$headers\n" if $opt_cmdline->{debug};
# Build body element and page title differently depending on the type of page
# Load the refresh tab if required
my $body_element;
my $title;
my $autorefresh = $cgi->cookie( 'AUTOWEBREFRESH' ) || $cgi->param( 'AUTOWEBREFRESH' );
my $autopvrrun = $cgi->cookie( 'AUTOPVRRUN' ) || $cgi->param( 'AUTOPVRRUN' );
if ( $autorefresh && $cgi->param( 'NEXTPAGE' ) eq 'refresh' ) {
$body_element = "<BODY onLoad=\"javascript:RefreshTab( '${request_host}?NEXTPAGE=refresh&AUTOWEBREFRESH=$autorefresh&PROGTYPES=$opt->{PROGTYPES}->{current}', ".(1000*3600*$autorefresh)." );\">";
$title = 'Refreshing Cache: get_iplayer Web PVR Manager';
} elsif ( $autopvrrun && $cgi->param( 'NEXTPAGE' ) eq 'pvr_run' ) {
$body_element = "<BODY onLoad=\"javascript:RefreshTab( '${request_host}?NEXTPAGE=pvr_run&AUTOPVRRUN=$autopvrrun', ".(1000*3600*$autopvrrun)." );\">";
$title = 'Running PVR: get_iplayer Web PVR Manager';
} else {
$body_element = "<body>\n";
$title = "get_iplayer Web PVR Manager $VERSION_TEXT";
}
# Write out the page http and html headers
print $fh $headers;
print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">'."\n";
print $fh "<html>";
print $fh "<HEAD><TITLE>$title</TITLE>\n";
insert_stylesheet();
print $fh "</HEAD>\n";
insert_javascript();
print $fh $body_element;
}
#############################################
#
# Javascript Functions here
#
#############################################
sub insert_javascript {
print $fh <<EOF;
<script type="text/javascript">
function RefreshTab(url, time, force ) {
if ( force ) {
window.location.href = url;
}
setTimeout( "RefreshTab('" + url + "'," + time + ", 1 )", time );
}
// global hash table for saving copy of form
var form_backup = {};
//
// Copy all non-grouped form values into a global hash
//
function BackupFormVars( f ) {
// empty out array
for(var key in form_backup) {
delete( form_backup[key] );
}
// copy forms elements
var elem = f.elements;
for(var i = 0; i < elem.length; i++) {
// exclude radio and checkbox types - can be duplicate names in groups...
if ( elem[i].type != "checkbox" && elem[i].type != "radio" ) {
form_backup[ elem[i].name ] = elem[i].value;
}
}
}
//
// Copy all form values in the global hash into the specified form
//
function RestoreFormVars( f ) {
// copy form elements
for(var key in form_backup) {
f.elements[ key ].value = form_backup[key];
// delete element
delete( form_backup[key] );
}
}
//
// Hide show an element (and modify the text of the button/label)
// e.g. document.getElementById('advanced_opts').style.display='table';
//
// Usage: show_options_tab( SELECTEDID, [ 'TAB1', 'TAB2' ] );
// Displays first tab in list or tab suffixes
// tab_TAB1 is the table element
// option_TAB1 is the form variable
// button_TAB1 is the label
//
function show_options_tab( selectedid, tabs ) {
// selected tab element
var selected_tab = document.getElementById( 'tab_' + selectedid );
// Loop through the above tab elements
for(var i = 0; i < tabs.length; i++) {
var li = document.getElementById( 'li_' + tabs[i] );
var tab = document.getElementById( 'tab_' + tabs[i] );
var option = document.getElementById( 'option_' + tabs[i] );
var button = document.getElementById( 'button_' + tabs[i] );
if ( tab == selected_tab ) {
tab.style.display = 'table-cell';
tab.style.visibility = 'visible';
option.value = 'yes';
//button.innerHTML = '- ' + button.innerHTML.substring(2);
//button.style.color = '#F54997';
//li.style.borderBottom = '0px solid #666';
li.className = 'options_tab_sel';
} else {
tab.style.display = 'none';
tab.style.visibility = 'collapse';
option.value = 'no';
//button.innerHTML = '+ ' + button.innerHTML.substring(2);
//button.style.color = '#ADADAD';
//li.style.borderBottom = '1px solid #666';
li.className = 'options_tab';
}
}
return true;
}
//
// Check/Uncheck all checkboxes named <name>
//
function check_toggle(f, name) {
var empty_fields = "";
var errors = "";
var check;
if (f.SELECTOR.checked == true) {
check = 1;
} else {
check = 0;
}
// Loop through the elements of the form
for(var i = 0; i < f.length; i++) {
var e = f.elements[i];
if (e.type == "checkbox" && e.name == name) {
if (check == 1) {
// First check if the box is checked (don't check a disabled box)
if(e.checked == false && e.disabled == false) {
e.checked = true;
}
} else {
// First check if the box is not checked
if(e.checked == true) {
e.checked = false;
}
}
}
}
return true;
}
//
// Warn if none of the checkboxes named <name> are selected
//
function check_if_selected(f, name) {
// Loop through the elements of the form
for(var i = 0; i < f.length; i++) {
var e = f.elements[i];
if (e.type == "checkbox" && e.name == name && e.checked == true) {
return true;
}
}
return false;
}
//
// Disable checkboxes named <name> that are selected
//
function disable_selected_checkboxes(f, name) {
var empty_fields = "";
var errors = "";
var check;
// Loop through the elements of the form
for(var i = 0; i < f.length; i++) {
var e = f.elements[i];
if (e.type == "checkbox" && e.name == name) {
// First check if the box is checked
if(e.checked == true) {
e.checked = false;
e.disabled = true;
}
}
}
return true;
}
//
// Submit Search only if enter is pressed from a textfield
// Called as: onKeyDown="return submitonEnter(event);"
//
function submitonEnter(evt){
var charCode = (evt.which) ? evt.which : event.keyCode
if ( charCode == "13" ) {
document.form1.NEXTPAGE.value='search_progs';
document.form1.PAGENO.value=1;
document.form1.submit();
}
}
</SCRIPT>
EOF
}
#############################################
#
# CSS1 Styles here
#
#############################################
sub insert_stylesheet {
print $fh <<EOF;
<STYLE type="text/css">
body {
background: #000;
color: #fff;
font-family: Arial,Helvetica,sans-serif;
font-size: 100%;
}
img {
border: 0;
}
input, select {
background: #ddd;
border: 0;
}
input {
font-size: 1em;
}
a {
color: #fff;
text-decoration: none;
}
a[href], a[onclick], label[onclick], :link, :visited {
cursor: pointer;
}
ul.nav,
ul.options_tab,
ul.action {
list-style: none;
margin: 8px 0;
padding: 0;
}
ul.nav, ul.action {
font-size: 1em;
}
ul.nav {
border-bottom: 4px solid #888;
}
ul.options_tab {
border-bottom: 2px solid #888;
}
ul.nav > li,
ul.options_tab > li,
ul.action > li {
background: #444;
display: inline-block;
vertical-align: bottom;
margin: 0 4px;
}
ul.nav > li,
ul.action > li {
padding: 4px 16px;
}
ul.options_tab > li {
padding: 2px 8px;
}
ul.nav > li:hover,
ul.options_tab > li:hover,
ul.action > li:hover {
background: #666;
}
ul.nav > li.nav_tab_sel,
ul.options_tab > li.options_tab_sel {
background: #888;
}
table.options_outer > tbody > tr {
font-size: 0.875em;
}
table.options_outer td,
table.options_outer th,
table.info td,
table.info th {
vertical-align: top;
text-align: left;
}
table.options,
table_options_embedded {
border-spacing: 1;
}
table.pagetrail {
margin-left: auto;
margin-right: auto;
margin-top: 8px;
margin-bottom: 8px;
font-size: 1em;
font-weight: bold;
border-spacing: 10px 0;
padding: 0px;
}
label.pagetrail-current {
color: #F54997;
}
table.search,
table.info {
border: 2px solid #333;
border-collapse: collapse;
width: 100%;
}
table.search > tbody > tr,
table.info > tbody > tr {
background: #444;
font-size: 0.875em;
}
table.search > tbody > tr:hover,
table.info > tbody > tr:hover {
background: #666;
}
table.search > tbody > tr > th,
table.info > tbody > tr > th {
background: #000;
text-align: center;
}
table.search > tbody > tr > td,
table.search > tbody > tr > th,
table.info > tbody > tr > td,
table.info > tbody > tr > th {
border: 1px solid #333;
padding: 4px 8px;
}
table.searchhead {
width: 100%;
}
label.sorted {
color: #CFC;
}
label.sorted_reverse {
color: #FCC;
}
b.footer {
color: #777;
font-size: 0.75em;
font-weight: normal;
}
#nowrap {
white-space: nowrap;
}
#logo {
background: none;
margin: 0;
}
#logo .logotext {
color: #F54997;
font-family: "Courier New", monospace;
}
.darker {
color: #7D7D7D;
}
</STYLE>
EOF
}