Net::Shoutcast::Admin - administration of Shoutcast servers

    use Net::Shoutcast::Admin;

    my $shoutcast = Net::Shoutcast::Admin->new(
                                    host => 'server hostname',
                                    port => 8000,
                                    admin_password => 'mypassword',
    );

    if ($shoutcast->source_connected) {
        printf "%s is currently playing %s by %s",
            $shoutcast->dj_name,
            $shoutcast->currentsong->title,
            $shoutcast->currentsong->artist
        ;
    } else {
        print "No source is currently connected.";
    }

  

package Net::Shoutcast::Admin;
# $Id: Admin.pm 229 2008-02-13 00:10:09Z davidp $

use warnings;
use strict;
use Carp;
use Net::Shoutcast::Admin::Song;
use Net::Shoutcast::Admin::Listener;
use URI::Escape;
use LWP::UserAgent;
use XML::Simple;

use vars qw($VERSION);
$VERSION = '0.02';

sub new {

    my ($class, %params) = @_;
    
    my $self = bless {}, $class;
        
    $self->{last_update} = 0;
    
    my %acceptable_params = map { $_ => 1 } 
        qw(host port admin_password timeout agent);
    
    # make sure we haven't been given any bogus parameters:
    if (my @bad_params = grep { ! $acceptable_params{$_} } keys %params) {
        carp "Net::Shoutcast::Admin does not recognise param(s) "
            . join ',', @bad_params;
        return;
    }
    
    # 
    $self->{$_} = $params{$_} for keys %acceptable_params;
    
    # set decent defaults for optional params:
    $self->{port}    ||= 8000;
    $self->{timeout} ||= 10;
    # In my initial testing, it seems the Shoutcast server will not respond
    # with the status XML if the User-Agent does not contain "Mozilla"
    # (Why?  That's just lame!)
    $self->{agent}   ||= "Mozilla";
    
    if (my @missing_params = grep { ! $self->{$_} } keys %acceptable_params) {
        carp "Net::Shoutcast::Admin->new() must be supplied with params: "
            . join ',', @missing_params;
        return;
    }
    
    # get an LWP::UserAgent object to make our requests with:
    my $ua = new LWP::UserAgent;
    if ($ua) {
        $ua->agent(   $self->{agent}   );
        $ua->timeout( $self->{timeout} );
        $self->{ua} = $ua;
    } else {
        warn "Failed to create LWP::UserAgent object";
        return;
    }
    
    return $self;

}


# if we haven't fetched the status XML recently, fetch it.  Returns true if
# we either fetched it successfully or it was fresh enough to not need
# re-fetching, or false if we couldn't get it.
sub _update_if_necessary {
    my $self = shift;
    if ($self->{last_update} and (time - $self->{last_update}) < 5) {
            # status was updated not long ago
            return 1;
    }
    
    my ($fetched, $msg) = $self->_fetch_status_xml;
    if (!$fetched) {
        warn "Failed to fetch status from Shoutcast server: $msg";
        return;
    }
    
    # all good.
    return 1;
}


sub _fetch_status_xml {
    my $self = shift;
        
    my ($host, $port) = @$self{qw(host port)};
    my $pass = URI::Escape::uri_escape( $self->{admin_password} );
    
    my $url = "http://$host:$port/admin.cgi?pass=$pass&mode=viewxml";
    
    my $response = $self->{ua}->get($url);
    
    if (!$response->is_success) {
        my $err = "Failed to fetch status XML - " . $response->status_line;
        carp $err;
        return wantarray? (0, $err) : 0;
    }
    
    my $data = XML::Simple::XMLin($response->content, 
        forceArray => [qw(LISTENER SONG)]);
    
    if (!$data) {
        return wantarray? (0, 'Failed to parse XML') : 0;
    }
    
    $self->{data} = $data;
    $self->{last_update} = time;
    
    return wantarray? (1, undef) : 1;
}

sub currentsong {
    my $self = shift;
    $self->_update_if_necessary or return;
    
    my $song = Net::Shoutcast::Admin::Song->new( 
        title => $self->{data}->{SONGTITLE}
    );   
    return $song;
}

sub song_history {
    my $self = shift;
    my @song_objects;
    $self->_fetch_status_xml;
    
    for my $song (@{ $self->{data}->{SONGHISTORY}->{SONG} }) {
        push @song_objects, Net::Shoutcast::Admin::Song->new(
            title => $song->{TITLE},
            played_at => $song->{PLAYEDAT},
        );
    }
    
    return (@song_objects);
}

sub listeners {
    my $self = shift;
    $self->_fetch_status_xml;
    
    if (!wantarray) {
        # okay, it's nice and simple:
        return $self->{data}->{CURRENTLISTENERS};
    } else {
        # okay, we need to return a list of N:S:A::Listener objects:
        return if !$self->{data}->{CURRENTLISTENERS};
        
        my @listener_objects;
        for my $listener (@{ $self->{data}->{LISTENERS}->{LISTENER} }) {
            push @listener_objects, Net::Shoutcast::Admin::Listener->new(
                host         => $listener->{HOSTNAME},
                connect_time => $listener->{CONNECTTIME},
                underruns    => $listener->{UNDERRUNS} || 5,
                agent        => $listener->{USERAGENT},
            );
        }
            
        return (@listener_objects);
    }
}

sub source_connected {
    my $self = shift;
    $self->_fetch_status_xml;   
    return ($self->{data}->{STREAMSTATUS});
}


1; # Magic true value required at end of module
__END__