xmms2-mcabbertune

#!/usr/bin/perl
#
#   xmms2-mcabbertune -- Sends XEP-0118 User Tune with mcabber pipe from XMMS2
#   Copyright (c)2008 Kacper Gutowski mwgamera at gmail dot com
#
#  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/>.
#
use strict;
use Audio::XMMSClient;

# Location of a FIFO
use constant FIFOPATH => $ENV{HOME}.'/.mcabber/mcabber.fifo';

# connect to demon
my $xc = Audio::XMMSClient->new('xmms2-mcabbertune');
$xc->connect or die $xc->get_last_error;

# data
my $status = eval { $xc->playback_status->wait->value };
my $cid    = eval { $xc->playback_current_id->wait->value };
my %info   = eval { %{$xc->medialib_get_info($cid)->wait->value} };
my $id     = 0;

# publish initial values
save();

# catch termination to clear tune file
$xc->disconnect_callback_set( sub {
		$cid = $status = -1; undef %info;
		save(); print STDERR"Abnormal termination.\n";
		exit 1;
	});
eval { $xc->broadcast_quit->notifier_set( sub {
		$cid = $status = -1; undef %info;
		save(); print STDERR"Server quit.\n";
		exit 0;
	}); 1 } or die $xc->get_last_error;

# catch signals
$SIG{INT} = $SIG{TERM} = 
sub { $cid = $status = -1; undef %info; save(); exit 0; };

# setup event handlers
eval { $xc->broadcast_medialib_entry_changed->notifier_set( sub {
		if ($cid == (my$r=shift->value)) {
			my %i = getinfo();
			my %ti = %info; %info = %i;
			save() if inse(%ti) ne inse(%i);
		}
	}); 1 } or die $xc->get_last_error;
eval { $xc->broadcast_playback_status->notifier_set( sub {
		my$r=shift->value;
		my $ts = $status; $status = $r;
		save() if $ts != $r && $r != 2;
	}); 1 } or die $xc->get_last_error;
eval { $xc->broadcast_playback_current_id->notifier_set( sub {
		my $r=shift->value;
		my $tc = $cid; $cid = $r;
		%info = getinfo();
		save() if $tc != $r;
	}); 1 } or die $xc->get_last_error;

# main loop
$xc->loop;

exit;

# get info hash of current (ID=$cid) position
sub getinfo { return eval{%{$xc->medialib_get_info($cid)->wait->value}} }

# synchronise data with file
sub save {
	# construct pubsub item
	my $tune = '';

	if ($status == 1) {
		$tune  = '<tune xmlns="http://jabber.org/protocol/tune">';
		$tune .= '<artist>'.xmle($info{artist}).'</artist>';
		$tune .= '<title>'.xmle($info{title}).'</title>';
		$tune .= '<source>'.xmle($info{album}).'</source>';
		$tune .= '<track>'.int($info{tracknr}).'</track>';
		$tune .= '<length>'.int($info{duration}/1000).'</length>';
		$tune .= '<rating>'.int(1+9*($info{rating}-1)/4).'</rating>'
			if $info{rating};
		# Not sending http://jabber.org/protocol/tune : url for privacy reasons
		$tune .= '</tune>';
	} else { $tune = '<tune xmlns="http://jabber.org/protocol/tune"/>' }

	# construct stanza
	my $stanza = '';
	$stanza .= '<iq type="set" id="xmms2tune'.int(time+$id++).'">';
	$stanza .= '<pubsub xmlns="http://jabber.org/protocol/pubsub">';
	$stanza .= '<publish node="http://jabber.org/protocol/tune">';
	$stanza .= '<item id="current">'.$tune.'</item>';
	$stanza .= '</publish>';
	$stanza .= '</pubsub>';
	$stanza .= '</iq>';


	# publish to pipe
	print(STDERR"$0: No pipe found\n"), return 0 unless -p FIFOPATH;
	open  FIFO,'>'.FIFOPATH or return $!;
	print FIFO "/RAWXML send $stanza\n";
	close FIFO or die $!;

	# diagnostic
	print STDERR"$0: Stopped.\n"  if $status<1;
	print STDERR"$0: Published #$cid $info{artist} - $info{title} ".
		($info{duration}?sprintf("[%d:%02d]",
				int($info{duration}/60000),
				int($info{duration}/1000)%60):'')."\n"
		if $status == 1;
	print STDERR"$0: SENT IQ STANZA: $stanza\n";

	return 0;
}

# escape XML entitieS
sub xmle {
	$_=shift;
	s,&,&amp;,g;
	s,<,&lt;,g;
	s,>,&gt;,g;
	return$_;
}

# serialise info hash for comparison
sub inse {
	(%_) = @_;
	return "$_{id}\1$_{tracknr}\1$_{title}\1"
	."$_{artist}\1$_{duration}\1$_{url}\1";
}

__END__