File Coverage

blib/lib/POE/Component/Client/Icecast.pm

Criterion	Covered	Total	%
statement	24	55	43.6
branch	0	16	0.0
condition	2	20	10.0
subroutine	8	15	53.3
pod	1	1	100.0
total	35	107	32.7

package POE::Component::Client::Icecast;
use strict;
use warnings;

use Carp 'carp', 'croak';
use POE::Session;
use POE::Filter::Stream;
use POE::Component::Client::TCP;

use constant TRACE => $ENV{'ICECAST_TRACE'} || 0;
use constant DEBUG => $ENV{'ICECAST_DEBUG'} || 0;

our $VERSION = 0.6;

sub new {
	my $type   = shift;
	my $param  =  {@_};

	my $mi     = $type.'->new()'; # hi, Rocco Caputto!
	croak "$mi requires an even number of parameters" if @_ & 1;

	my $stream = $param->{'Stream'} ? _parse_stream_param($param->{'Stream'}) : {};
	my $path   = $stream->{'Path'} || $param->{'Path'} || croak "$mi requires Path param to stream";
	   $path   = "/$path" unless $path =~ m{^/};

	POE::Component::Client::TCP->new(
		(map { $_ => $stream->{$_} || $param->{$_} } 'Alias', 'RemoteAddress', 'RemotePort', 'BindAddress', 'BindPort'),

		'Filter'        => POE::Filter::Stream->new,
		'Connected'     => sub {
			$_[HEAP]->{'server'}->put(grep { DEBUG && warn $_;1 } join "\n",
				"GET $path HTTP/1.0",
				'Icy-MetaData: 1',
				('') x 2
			);
		},

		'ServerInput'   => sub {
			DEBUG && warn 'Server input ' . length $_[ARG0];
			return unless my %tag = $_[ARG0] =~ /Stream(\w+)='(.*?)';/g;
			DEBUG && warn $tag{'Title'};

			{
				local $_[ARG0] = \%tag;
				ref $param->{'GetTags'} eq 'CODE' && $param->{'GetTags'}->(@_);
			}
		},

		'Disconnected'  => sub {
			DEBUG && warn "$mi disconnected";

			if ($param->{'Reconnect'}) {
				DEBUG && warn "$mi will reconnect, delay is $param->{'Reconnect'}";
				$_[KERNEL]->delay('reconnect' => $param->{'Reconnect'});
			}
		},

		'ConnectError'  => sub {
			warn "$param->{'Stream'} connect error: " . $_[ARG2] . "\n";

			if ($param->{'Reconnect'}) {
				DEBUG && warn "$mi will reconnect, delay is $param->{'Reconnect'}";
				$_[KERNEL]->delay('reconnect' => $param->{'Reconnect'});
			}
		},
		'ServerError'   => sub {
			# XXX: can croak if args
			warn "$param->{'Stream'} server error: " . $_[ARG0] . "\n";
		},

		'SessionParams' => [ 'options' => { 'trace' => TRACE } ],
	) or croak "$mi has error: $!";
}

#

sub _parse_stream_param {
	my $stream = shift || return {};

	my($domain, $path) = $stream =~ m{^ http :// ([^/]+) / (.*) }x;
	my($addr,   $port) = $domain =~ m{^ (.*) : (.*) }x;
	return {
		'Host'          => $addr || $domain,
		'RemoteAddress' => $addr || $domain,
		'RemotePort'    => $port || 80,
		'Path'          => $path,
	};
}

1;

__END__