File Coverage

lib/Video/NRK/Cache/ProgramId.pm

Criterion	Covered	Total	%
statement	20	20	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	27	27	100.0

use v5.37.9;
use feature 'class';
no warnings 'experimental::class';
use utf8;

package Video::NRK::Cache::ProgramId 3.02;  # Dist::Zilla doesn't know about class yet

class Video::NRK::Cache::ProgramId;
# ABSTRACT: NRK on-demand "PRF" program ID


use Carp qw( carp croak );
use HTTP::Tiny ();
use warnings::register;


our $QUICK_ID = 1;  # skip HTML parsing if possible, rely on hard-coded API base
our $NRK_BASE = 'https://tv.nrk.no/program';
our $PSAPI_BASE = 'https://psapi.nrk.no';


field $program_id;
field $url;
field $id;
field $psapi_base :param //= $PSAPI_BASE;
field $parse :param = undef;
field $ua :param = HTTP::Tiny->new;

my $nrk_re = qr{//[^/]*nrk\.no(?:/|$)};
my $prfid_re = qr/[A-ZØÆÅ]{4}[0-9]{8}/;


method id { $id }
method url { $url }
method psapi_base { $psapi_base }


ADJUST {
	$self->parse($parse) if defined $parse;
}


method parse ($parse_) {
	$parse = $parse_;

	# Strategies to obtain the NRK on-demand "PRF" program ID:
	# 1. parse from URL
	# 2. get from HTTP header
	# 3. parse from web page meta data
	# 4. first string on web page that looks like an ID

	$self->_parse_as_string and return;
	$url = $parse;
	$self->_parse_from_header and return;
	$self->_parse_from_body and return;

	croak "Failed to discover NRK 'PRF' program ID; giving up on '$url'";
}


method _parse_as_string () {
	return unless $parse =~ m/^$prfid_re$/;

	# the user supplied the program ID instead of the URL
	$id = $parse;
	$url = "$NRK_BASE/$parse";
}


method _parse_from_header () {
	return unless $QUICK_ID;

	if ($url =~ m<^http.+/($prfid_re)(?:/|$)>) {
		return $id = $1;
	}

	$id = eval { $ua->head($url)->{headers}{'x-nrk-program-id'} } // '';
	return $id if $id =~ m/^$prfid_re$/;
}


method _parse_from_body () {
	my $res = $ua->get($url, {headers => { Accept => 'text/html' }});
	$url = $res->{url};
	carp "Warning: This doesn't look like NRK. Check the URL '$url'" if warnings::enabled && $url !~ m/^https?:$nrk_re/i;
	my $error = $res->{status} eq "599" ? ": $res->{content}" : "";
	croak "HTTP error $res->{status} $res->{reason} on $url$error" unless $res->{success};

	my $html = $res->{content};
	my ($base_url) = $html =~ m/\bdata-psapi-base-url="([^"]+)"/i;
	$psapi_base = $base_url if $base_url && $base_url =~ m/https:$nrk_re/i;
	$id = $res->{headers}{'x-nrk-program-id'} // '';  # this header might not have been present in the HEAD response
	return $id if $id =~ m/^$prfid_re$/;

	return $id if ($id) = $html =~ m/\bprogram-id(?:"\s+content)?="($prfid_re)"/i;
	return $id if ($id) = $html =~ m/"prf(?:Id"\s*:\s*"|:)($prfid_re)"/;

	carp "Warning: Failed to discover NRK 'PRF' program ID; trying harder" if warnings::enabled;
	return $id if ($id) = $html =~ m/\b($prfid_re)\b/;
	return $id if ($id) = $html =~ m/(?:\\u002[Ff]|\%2[Ff])($prfid_re)\b/;
	return $id if ($id) = $html =~ m/(?:[0-9a-z_]|\\u[0-9A-F]{4}|\%[0-9A-F]{2})($prfid_re)\b/;  # last-ditch effort
}


1;

__END__