The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
use Test::Trap;
use List::Util qw/max/;
use File::Slurp;
use JSON;
use Encode;
use Data::Dumper;
use lib 't/lib';

$Data::Dumper::Indent = 1;

my @REF_FILES;
BEGIN { @REF_FILES = glob('t/data/ref/*.json') }

my %ALIASES;
BEGIN {
	open my $fh, '<', 't/data/aliases.json' or
		die "Could not open t/data/aliases.json: $!";
	my $blob = do { local $/=''; <$fh> };
	close $fh;
	%ALIASES = %{decode_json($blob)};
}

BEGIN {
	my $video_tests_n = 27; # n tests performed in video_tests() (recursive)
	plan tests => (1 + (@REF_FILES + keys %ALIASES) * $video_tests_n);
	use_ok('WWW::SVT::Play::Video')
}

sub get_number {
	my $f = shift;
	my ($n) = $f =~ m|([^/]+)\.json$|;
	return $n;
}

sub load_testdata {
	my %ref;
	my $json = JSON->new->utf8;

	for my $file (@REF_FILES) {
		my $n = get_number($file);
		my $data = read_file($file);
		$ref{$n} = $json->decode(encode('utf8', $data));
	}

	return %ref;
}

sub video_tests {
	my $url = shift;
	my($n, $ref) = @_;
	note("Tests for $url ($n)");

	my $svtp = new_ok('WWW::SVT::Play::Video', [$ref->{url}]);

	is($svtp->url, $ref->{url}, '->url()');
	is($svtp->title, $ref->{title}, '->title()');
	is($svtp->duration, $ref->{duration}, '->duration()');

	SKIP: {
		skip 'RTMP specific tests', 10 unless $ref->{has}->{rtmp};
		ok $svtp->has_rtmp, "has rtmp streams";

		my %ref_streams = map {
			$_->{bitrate} => $_->{url}
		} grep {
			$_->{type} eq 'rtmp'
		} @{$ref->{streams}};

		is_deeply(
			[sort {$a <=> $b } $svtp->rtmp_bitrates],
			[sort {$a <=> $b } keys %ref_streams],
			'->bitrates() in list context'
		);

		my $max = max $svtp->rtmp_bitrates;
		is(
			scalar $svtp->rtmp_bitrates,
			$max,
			'->bitrates() in scalar context'
		);

		my %rtmp_streams = $svtp->stream(protocol => 'rtmp');
		is_deeply(
			[ sort { $a <=> $b } keys %rtmp_streams ],
			[ sort { $a <=> $b } keys %ref_streams ],
			'expected rtmp stream bitrates'
		);

		# We got one RTMP test case, with 3 bitrates
		for my $bitrate (keys %rtmp_streams) {
			ok exists $ref_streams{$bitrate}, "expected bitrate";
			my $stream = $svtp->stream(
				protocol => 'rtmp',
				bitrate => $bitrate
			);

			is $stream->url, $ref_streams{$bitrate},
				"expected url for rtmp bitrate $bitrate";
		}
	}

	SKIP: {
		skip 'HLS specific tests', 2 unless $ref->{has}->{hls};
		ok $svtp->has_hls, "has hls streams";
		my ($hls_ref) = grep { $_->{type} eq 'hls' } @{$ref->{streams}};
		is $svtp->stream(protocol => 'hls')->url, $hls_ref->{url},
			"expected HLS url";
	}

	SKIP: {
		skip 'HDS specific tests', 2 unless $ref->{has}->{hds};
		ok $svtp->has_hds, "has hds streams";
		my ($hds_ref) = grep { $_->{type} eq 'hds' } @{$ref->{streams}};
		is $svtp->stream(protocol => 'hds')->url, $hds_ref->{url},
			"expected HDS url";
	}

	SKIP: {
		skip 'HTTP specific tests', 2 unless $ref->{has}->{http};
		ok $svtp->has_http, "has http streams";
		my ($http_ref) = grep {
			$_->{type} eq 'http'
		} @{$ref->{streams}};
		is $svtp->stream(protocol => 'http')->url, $http_ref->{url},
			"expected HTTP url";
	}

	test_filename($ref, $svtp);

	is($svtp->duration, $ref->{duration}, '->duration()');

	# The trivial case where no subtitle is available
	is_deeply(
		[$svtp->subtitles],
		$ref->{subtitles},
		'->subtitles() in list context (no subs)'
	);
	is(
		$svtp->subtitles,
		$ref->{subtitles}->[0],
		'->subtitles() in scalar context (no subs)'
	);
}

sub test_filename {
	my $ref = shift;
	my $svtp = shift;

	is($svtp->filename, $ref->{filename}, '->filename (no format)');

	is(
		$svtp->filename('rtmp'),
		"$ref->{filename}.rtmp",
		'filename method: called with type rtmp'
	);

	is(
		$svtp->filename('hds'),
		"$ref->{filename}.flv",
		'filename method: called with type hds'
	);

	is(
		$svtp->filename('hls'),
		"$ref->{filename}.mp4",
		'filename method: called with type hls'
	);

}

my %testcases = load_testdata();
for my $case (keys %testcases) {
	video_tests($testcases{$case}->{url}, $case, $testcases{$case});
}

for my $alias (keys %ALIASES) {
	video_tests($alias, $ALIASES{$alias}, $testcases{$ALIASES{$alias}});
}