dlna-play

#!/usr/bin/perl
# Copyright (C) 2020 Graham R. Cobb
# Released under GPL V2 -- see LICENSE
# Note: parts of this code are derived from dlna-playlist-play (Graham Cobb)
# and from the documentation for Net::UPnP::AV::MediaServer (Satoshi Konno)

use strict;
use warnings;

use Getopt::Long 2.33 qw(:config gnu_getopt auto_help auto_version);
use Pod::Usage;
use Net::UPnP::ControlPoint;
use Net::UPnP::AV::MediaRenderer;
use Text::Glob qw( match_glob glob_to_regex );
use Data::Dumper;
use XML::Simple;

our $VERSION = 0.1;

my $verbosity = 1;
my $man = 0;
my $dryRun = 0;
my $wait_time = 3;
my $location;
my $stop;
my $title = "dlna-play";
my $limit_pause = 0;
my $restart_pause = 0;

#
# Logging
#
sub msgError
{
    print @_,"\n";
}
sub msgInfo
{
    print @_,"\n" if $verbosity >= 1;
}
sub msgProgress
{
    print @_,"\n" if $verbosity >= 2;
}
sub msgDebug
{
    print @_,"\n" if $verbosity >= 3;
}
# Autoflush output, otherwise errors appear in wrong place relative to logging
$| = 1;

#
# Option processing
#
#Getopt::Long::Configure ("bundling");
GetOptions(
    "dry-run|n" => \$dryRun,
    "verbose|v:+" => \$verbosity,
    "man" => \$man,
    "wait|w=s" => \$wait_time,
    "location|l=s" => \$location,
    "stop|S" => \$stop,
    "title|T=s" => \$title,
    "limit-pause|p=i" => \$limit_pause,
    "restart-pause|r=i" => \$restart_pause,
    ) or pod2usage(2);
msgDebug "man = $man";
if ($man) {
    pod2usage(-verbose => 2);
    exit;
}

# Note: we want renderer name to be optional (allowing playing on any renderer found)
# but we need the URL to be at the end of the command to allow using from 'dlna-playlist-play'
# so 1 arg is interpreted as the URL
my ($rendererName, $url);
if (scalar(@ARGV) == 1) {
    ($url) = @ARGV;
} elsif (scalar(@ARGV) == 2) {
    ($rendererName, $url) = @ARGV;
} elsif ($stop) {
    $url = '';
} else {
    msgError "one or two arguments, or --stop, must be specified";
    pod2usage(2);
    exit 1;
}
$rendererName = $rendererName || '*';
if ($limit_pause && $restart_pause) {
    msgError "No more than one of --limit-pause and --restart-pause can be specified";
    pod2usage(2);
    exit 1;
}
my $dryRunText = $dryRun ? "(dry run) " : "";
$Net::UPnP::DEBUG=1 if $verbosity >= 3;

msgDebug "url = $url";
msgDebug "rendererName = $rendererName";
msgDebug "verbosity = $verbosity";
msgDebug "dryRun = $dryRun";
msgDebug "wait_time = $wait_time";
msgDebug "location = $location" if $location;
msgDebug "stop = $stop" if $stop;
msgDebug "title = $title" if $title;
msgDebug "limit_pause = $limit_pause" if $limit_pause;
msgDebug "restart_pause = $restart_pause" if $restart_pause;

=head1 NAME

dlna-play - Play a single URL on a DLNA media renderer

=head1 SYNOPSIS

dlna-play [options] [<renderer-name>] <url>

dlna-play -?|--help|--man|--version

 Commands:

  -?, --help			brief help message
  --man 			full documentation
  --version			script version

 Options:

  -w, --wait=N			Seconds to wait for renderer to be found (default = 3)
  -l, --location=<url>		URL providing description XML for a renderer to include in the search
  -T, --title="text"		Track title to display during playback
  -S, --stop			Stop playback but do not start another track
  -n, --dry-run			Do not actually play file, just monitor
  -v, --verbose[=N]		Increment or set verbosity level (0 - quiet, 1 - info, 2 - progress, 3 - debug)
  -p, --limit-pause=N		Exit with error if paused for longer than N seconds
  -r, --restart-pause=N         Restart pause if paused for longer than N seconds

=head1 OPTIONS

=over 8

=item B<--wait>

Number of seconds to wait searching for all renderers visible on LAN. Specifying 0 disables the LAN search
meaning only renderers specified using --location will be considered.

=item B<--location>

URL of the "description XML" for a renderer to include in the search.
This is used to access renderers which are not visible on the LAN
(typically accessed over a wide area network).

The value to be provided is the same as the LOCATION: field in the
DLNA announcement messages the renderer transmits on its own LAN.

For example:

  --location http://192.168.111.222:49152/uuid-12345678-abcd-0987-ffff-1234567890abc/description.xml

If local renderers should B<not> also be considered, specify '--wait 0' as well.
See also the description below about how renderer names interact with --location.

=item B<--title>

Text for the renderer to display as the track title.

=item B<--stop>

Stop playback of the current track but do not start another. Note that any track URL is ignored:
this is to make it easy to recall an earlier playback command but add "--stop" to just stop
the playback.

=item B<--dry-run>

Do not actually play file.

=item B<--limit-pause>

Number of seconds for maximum pause time. If paused for longer than this, playback ends with an error status.

Some renderers limit the maximum time for pause, and behaviour after that time is not defined.
As an alternative to --restart-pause, this option causes dlna-play to stop playback and exit 
with an error status.

See also --restart-pause.

=item B<--restart-pause>

Number of seconds for maximum pause time. If paused for longer than this, the pause is restarted.

Some renderers limit the maximum time for pause, and behaviour after that time is not defined.
In an attempt to allow indefinite pauses, dlna-play will briefly restart playback and then
immediately pause again. However, for some renderers this doesn't work well.

See also --limit-pause.

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=back

=head1 DESCRIPTION

B<dlna-play> plays a single content file on a DLNA UPNP AV media renderer and waits for it to complete.
It is designed to be used much like "mplayer" is used.

B<renderer-name> specifies the name of the media renderer (the name is advertised by the renderer itself).
File glob style wildcards can be used. If the renderer name is omitted, the first renderer found will be used.

Note that renderer name matching is still checked even if --location is specified. In most cases, when
--location is used the renderer name should be omitted and --wait 0 specified to avoid finding a local renderer

B<url> is the file to play.

=head1 EXAMPLES

=over 8

=item B<dlna-play "HDR-2000T*" <url>>

Play the url on a Humax HDR-2000T.

=item B<dlna-play <url>>

Play the url on any renderer we can see on the network.

=item B<dlna-play --wait 0 --location=http://192.168.111.222:4321/desc <url>>

Play the url on the renderer described at the specified location whatever
name it may be advertising.

=item B<dlna-play --location http://192.168.5.215:2870/dmr.xml -w 0 -v 2 -p 240>

This incomplete command is a real example of a specification for the dlna-playlist-play --execute option.
We use this to play Christmas Music through the month of December while cooking.
Location and no wait are specified to direct to the particular renderer in the kitchen.
Limit-pause is specified as our renderer restarts playing if it is paused too long.

=back

=cut

sub create_dev_from_location {
# Code taken from ControlPoint.pm (https://metacpan.org/source/SKONNO/Net-UPnP-1.4.6/lib%2FNet%2FUPnP%2FControlPoint.pm)
    my ($dev_location) = @_;
    unless ($dev_location =~ m{http://([0-9a-z.-]+)(?::(\d+))?/(.*)}i) {
        die "$0: bad dev_location: $dev_location\n";
    }
    my $dev_addr = $1;
    my $dev_port = $2 || 80;
    my $dev_path = '/' . $3;
    msgDebug "dev_addr=$dev_addr dev_port=$dev_port dev_path=$dev_path\n";

    my $http_req = Net::UPnP::HTTP->new();
    my $post_res = $http_req->post($dev_addr, $dev_port, "GET", $dev_path, "", "");
    unless ($post_res && $post_res->getstatuscode() == 200) {
	die "$0: can't fetch description from $dev_location: ".($post_res ? $post_res->getstatuscode() : '');
    }
    msgDebug $post_res->getstatus();
    msgDebug $post_res->getheader();
    msgDebug $post_res->getcontent();
    
    my $post_content = $post_res->getcontent();
 
    my $dev = Net::UPnP::Device->new();
    $dev->setssdp("LOCATION: $dev_location\r\n");
    $dev->setdescription($post_content);
         
    #msgDebug "ssdp = $ssdp_res_msg";
    msgDebug "description = $post_content";

    return $dev;
}
 
my $control_point = Net::UPnP::ControlPoint->new();

# Search for renderers
my @dev_list;
@dev_list = $control_point->search(st =>'upnp:rootdevice', mx => $wait_time) if $wait_time;
# Add manual renderer info
my $manual_dev = create_dev_from_location($location) if $location;
push (@dev_list, $manual_dev) if $manual_dev;
 
my $renderer = Net::UPnP::AV::MediaRenderer->new();
foreach my $dev (@dev_list) {
    msgDebug "Device ", $dev->getfriendlyname(), " - ", $dev->getdevicetype(), " (", $dev->getlocation(), ")";

    # Ignore devices that do not provide the AVTransport service
    next unless $dev->getservicebyname($Net::UPnP::AV::MediaRenderer::AVTRNSPORT_SERVICE_TYPE);
    
    msgProgress "Found renderer ", $dev->getfriendlyname();
    
    if ($rendererName) {
	next unless match_glob($rendererName, $dev->getfriendlyname());
    }

    msgInfo "${dryRunText}Playing to renderer ", $dev->getfriendlyname(), "... ", $title;

    $renderer->setdevice($dev);

    last;
}

if (! $renderer->getdevice()) {
    msgError "Renderer not found";
    exit 1;
}

my $action_result;
my $instanceID = 0;

my $didl= 
    '<DIDL-Lite xmlns="urn:schemas-upnp-org:metadata-1-0/DIDL-Lite/" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:upnp="urn:schemas-upnp-org:metadata-1-0/upnp/" xmlns:dlna="urn:schemas-dlna-org:metadata-1-0/">' .
    '<item id="'.$instanceID.'" parentID="20" restricted="0">' .
    '<dc:title>'.$title.'</dc:title>' .
    '<upnp:class>object.item.audioItem.musicTrack</upnp:class>' .
    '<res protocolInfo="http-get:*:audio/mpeg:DLNA.ORG_PN=MP3;DLNA.ORG_OP=01;DLNA.ORG_CI=0">'.$url.'</res>' .
    '</item>' .
    '</DIDL-Lite>'
    ;
# Escape XML
$didl =~ s/\&/\&amp;/g;
$didl =~ s/</\&lt;/g;
$didl =~ s/>/\&gt;/g;
$didl =~ s/"/\&quot;/g;
$didl =~ s/'"'"'/\&apos;/g;
#msgDebug $didl;

# Play
unless ($dryRun) {
    $renderer->stop(); # Ignore errors

    # If --stop was specified, do not start another track
    if ($stop) {
        msgInfo "Playback stopped";
        exit;
    }

    $action_result = $renderer->setAVTransportURI(
	InstanceID => $instanceID,
	CurrentURI => $url,
	CurrentURIMetaData => $didl
	);
    unless ($action_result->getstatuscode() == 200) {
	die "$0: can't send URL to renderer: ".$action_result->getstatuscode();
    }

    $action_result = $renderer->play(InstanceID => $instanceID);
    unless ($action_result->getstatuscode() == 200) {
	die "$0: can't start playing: ".$action_result->getstatuscode();
    }
}
# Let the renderer start before polling
sleep 1;
my $playbackStarted = 0;

# Monitor
my $avtrans_service = $renderer->getdevice()->getservicebyname($Net::UPnP::AV::MediaRenderer::AVTRNSPORT_SERVICE_TYPE);
my $count = 0;
my $startRetries = 10;
my $pauseStart = 0;
MONITOR: while (sleep 1) {
    $count++;
    my %action_args = (InstanceID => $instanceID);
    $action_result = $avtrans_service->postaction("GetTransportInfo", \%action_args);
    unless ($action_result->getstatuscode() == 200) {
	die "$0: can't monitor playing: ".$action_result->getstatuscode();
    }
    my $transport_info = $action_result->getargumentlist();
    msgDebug Dumper($transport_info);

    $action_result = $avtrans_service->postaction("GetMediaInfo", \%action_args);
    unless ($action_result->getstatuscode() == 200) {
	die "$0: can't monitor media: ".$action_result->getstatuscode();
    }
    my $media_info = $action_result->getargumentlist();	
    msgDebug Dumper($media_info);
    
    $action_result = $avtrans_service->postaction("GetPositionInfo", \%action_args);
    unless ($action_result->getstatuscode() == 200) {
	die "$0: can't monitor playing: ".$action_result->getstatuscode();
    }
    my $position_info = $action_result->getargumentlist();
    msgDebug Dumper($position_info);
    
    msgProgress $media_info->{CurrentURI},
	' (',$position_info->{RelTime},'/',$position_info->{TrackDuration},')',
	' : ',$transport_info->{CurrentTransportState};

    die "$0: error during playback: ".$transport_info->{CurrentTransportStatus} if $transport_info->{CurrentTransportStatus} ne 'OK';

    # Sometimes the renderer takes a while to get going, so ignore STOPPED state until it has been something else or has timed out
    if ($transport_info->{CurrentTransportState} eq 'STOPPED') {
        $pauseStart = 0;
        last MONITOR if $playbackStarted;
        die "$0: playback did not start ($count)" if $count > $startRetries;

        # Retry Play command
        msgInfo "Retrying play command ($count)";
        msgInfo "Media info: ",Dumper($media_info);
        msgInfo "Position info: ",Dumper($position_info);
        msgInfo "Transport info: ",Dumper($transport_info);
        $action_result = $renderer->play(InstanceID => $instanceID);
	die "$0: can't restart playing: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;
    } elsif ($transport_info->{CurrentTransportState} eq 'PLAYING') {
        $pauseStart = 0;
        $playbackStarted = 1;
    } elsif ($transport_info->{CurrentTransportState} eq 'PAUSED_PLAYBACK') {
        $pauseStart = $count if ! $pauseStart;

        # The trick below, to restart pause every 4 minutes, doesn't work with some renderers.
        # So --limit-pause forces playback to stop and exit with an error instead
        # so the caller can decide what to do (dlna-playlist-play will stop the
        # playlist but can be continued if a resume file is used).
        if ($limit_pause && ($count - $pauseStart) > $limit_pause) {
            $action_result = $renderer->stop(InstanceID => $instanceID);
            die "$0: can't stop: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;

            die "$0: paused more than $limit_pause seconds";
        }

        # Some renderers limit Pause to 5 minutes - restart that limit after 4 minutes.
        if ($restart_pause && ($count - $pauseStart) > $restart_pause) {
            msgInfo "Restarting pause (".($count - $pauseStart).")";

            # Unpause briefly...
	    my $playwait=20;
	    while ($playwait > 0) {
		$action_result = $renderer->play(InstanceID => $instanceID);
		die "$0: can't unpause: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;
		$action_result = $avtrans_service->postaction("GetTransportInfo", \%action_args);
		die "$0: can't GetTransportInfo: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;
		$transport_info = $action_result->getargumentlist();
                last if $transport_info->{CurrentTransportState} eq 'PLAYING';
		$playwait--;
	    }
	    die "$0: failed to briefly restart playing: ".$transport_info->{CurrentTransportState} unless $transport_info->{CurrentTransportState} eq 'PLAYING';

            # Repause - loop to deal with renderer not being ready to pause yet
            my $repauses=20;
            while ($repauses > 0) {
                $action_result = $avtrans_service->postaction("Pause", \%action_args);
		die "$0: can't re-pause: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;
		$action_result = $avtrans_service->postaction("GetTransportInfo", \%action_args);
		die "$0: can't GetTransportInfo: ".$action_result->getstatuscode() unless $action_result->getstatuscode() == 200;
		$transport_info = $action_result->getargumentlist();
                last if $transport_info->{CurrentTransportState} eq 'PAUSED_PLAYBACK';
                $repauses--;
            }
            die "$0: re-pause failed: ".$action_result->getstatuscode()." ".Dumper($action_result) unless $transport_info->{CurrentTransportState} eq 'PAUSED_PLAYBACK' ;

            $pauseStart = $count;
        }
    } else {
        # Any other state - clear the pause timer
        $pauseStart = 0;
    }
}