The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# Copyright 2011, 2012, Olof Johansson <olof@ethup.se>
# Copyright 2011, Magnus Woldrich <magnus@trapd00r.se>
#
# Copying and distribution of this file, with or without
# modification, are permitted in any medium without royalty
# provided the copyright notice are preserved. This file is
# offered as-is, without any warranty.

our $VERSION = '0.3';
our $APP  = 'svtplay';

use strict;
use warnings FATAL => 'all';
use feature qw/say/;

use WWW::SVT::Play::Video;
use Getopt::Long qw/:config gnu_getopt/;
use Pod::Usage qw/pod2usage/;
use YAML;
use List::Util qw/max/;

sub usage {
	pod2usage(
		verbose  => 99,
		exitval  => 0,
		sections => q{DESCRIPTION|OPTIONS},
	);
}

GetOptions(
	my $opts = {
		help => \&usage,
		version => sub {
			say("$APP v", __PACKAGE__->VERSION) && exit
		},
		type => 'list',
	}, qw(
		type|t=s
		bitrate|b:i
		max-bitrate|m
		download|d
		stream|s
		output|o=s
		help|h
		debug|D
		force|F
		version|v
	)
) or exit 1;

sub run_rtmp {
	my $svtp = shift;
	die "No RMTP streams available!\n" unless $svtp->has_rtmp;

	my $filename = $opts->{filename};
	$filename //= $svtp->filename('rtmp');

	my $bitrate = $opts->{bitrate};
	$bitrate = $svtp->bitrates if $opts->{'max-bitrate'};
	$bitrate //= $svtp->bitrates;

	my $stream = $svtp->stream(
		protocol => 'rtmp',
		bitrate => $bitrate
	);

	if ($opts->{download}) {
		$stream->download(
			output => $filename,
			force => $opts->{force},
		);
	} elsif ($opts->{stream}) {
		$stream->stream();
	}
}

sub run_hls {
	my $svtp = shift;
	die "No HLS streams available!\n" unless $svtp->has_hls;

	my $filename = $opts->{filename};
	$filename //= $svtp->filename('hls');

	my $stream = $svtp->stream( protocol => 'hls' );

	do_stream($svtp, $stream, $filename);
}

sub run_list {
	my $svtp = shift;
	my %streams;

	$streams{HLS} = $svtp->stream(protocol => 'hls')->url
		if $svtp->has_hls;
	$streams{HDS} = $svtp->stream(protocol => 'hds')->url
		if $svtp->has_hds;
	$streams{HTTP} = $svtp->stream(protocol => 'http')->url
		if $svtp->has_http;
	$streams{RTMP} = $svtp->stream(protocol => 'rtmp')
		if $svtp->has_rtmp;

	$streams{rtmp} = map {
		$_ => $streams{rtmp}->{$_}->url
	} keys $streams{rtmp} if $svtp->has_rtmp;

	gen_table(
		Title => $svtp->title,
		Filename => $svtp->filename,
		Duration => $svtp->duration,

		Streams => \%streams,
	);
}

sub gen_table {
	my %args = @_;

	# compute width of field names
	my $w = (max map { length } keys %args)+1;

	# ugly way to keep order of arguments, but works :(
	while (my $key = shift) {
		my $val = shift;

		if (ref $val eq 'HASH') {
			say "$key:";
			for my $k (keys %$val) {
				say ' 'x8, "$k: $val->{$k}";
			}
		} else {
			printf "%-${w}s %s\n", "$key:", $val;
		}
	}
}

sub get_action {
	return 'download' if $opts->{download};
	return 'stream'   if $opts->{stream};
	return 'output';
}

sub do_stream {
	my $svtp   = shift;
	my $stream = shift;

	my $action = get_action();

	return download($svtp, $stream) if $action eq 'download';
	return stream  ($stream)        if $action eq 'stream';

	say $stream->url;
}

sub get_filename {
	my $svtp   = shift;
	my $stream = shift;

	return $opts->{filename} if $opts->{filename};
	return $svtp->filename($stream->type);
}

sub download {
	my $svtp   = shift;
	my $stream = shift;

	$stream->download(
		output => get_filename($svtp, $stream),
		force  => $opts->{force},
	);
}

my $url = shift or usage();

my $svtp = WWW::SVT::Play::Video->new($url) or
	die "Failed?";

my %dispatch_type = (
	rtmp => \&run_rtmp,
	hls  => \&run_hls,
	list => \&run_list,
);

$dispatch_type{$opts->{type}}->($svtp)
	if exists $dispatch_type{$opts->{type}};

__END__

=pod

=head1 NAME

svtplay - extract URLs from svtplay.se

=head1 DESCRIPTION

svtplay is a script that lets you extract RTMP URLs from SVT Play.
You can feed this URL to e.g. rtmpdump and extract the video using
options to the script.

=head1 SYNOPSIS

  svtplay [OPTIONS] <URL>

=head1 OPTIONS

  -d, --download     download video
  -b, --bitrate      choose bitrate. only list available bitrates if omitted
  -m, --max-bitrate  choose the best available bitrate
  -o, --output file  specify output filename

  -h, --help         show the help and exit
  -v, --version      show version info and exit

=head1 CONTRIBUTORS

=over

=item Magnus Woldrich, magnus@trapd00r.se, http://japh.se, trapd00r on github

=back

=head1 COPYRIGHT

Copyright 2011 -- 2012, Olof Johansson <olof@ethup.se>
(and contributors...)

Copying and distribution of this file, with or without
modification, are permitted in any medium without royalty
provided the copyright notice are preserved. This file is
offered as-is, without any warranty.