File Coverage

blib/lib/MP3/Daemon.pm

Criterion	Covered	Total	%
statement	18	109	16.5
branch	0	38	0.0
condition	0	7	0.0
subroutine	6	16	37.5
pod	6	8	75.0
total	30	178	16.8

package MP3::Daemon;

use strict;
use vars qw($VERSION);

# controls mpg123
use Audio::Play::MPG123;

# unixy stuff
use POSIX qw(setsid);

# client/server communication
use IO::Socket;
use IO::Select;

$VERSION = '0.63';

# constructor that does NOT daemonize itself
#_______________________________________
sub new {
    my $class = shift; (@_ & 1) && die "Odd number of parameters\n";
    my %opt   = @_;
    my $path  = $opt{socket_path} || die("socket_path => REQUIRED!");
    my $self  = {
        player      => undef,       # instance of Audio:Play:MPG123
        server      => undef,       # instance of IO::Socket::UNIX
        client      => *STDOUT,     # nice for debugging
        socket_path => $path,
        idle        => undef,       # coderef to execute while idle
        at_exit     => [ ]          # array of coderefs to execute when done
    };
    bless ($self => $class);

    # clean-up handlers
    foreach (@{$self->{at_exit}}) { $self->atExit($_); }

    # server socket
    $self->{server} = IO::Socket::UNIX->new (
        Type   => SOCK_STREAM,
        Local  => $self->{socket_path},
        Listen => SOMAXCONN,
    ) or die($!);
    chmod(0600, $self->{socket_path});

    # player
    eval {
        $self->{player} = Audio::Play::MPG123->new || die($!);
    };
    if ($@) {
        unlink($self->{socket_path});
        die($@);
    }
    return $self;
}

# constructor that daemonizes itself
#_______________________________________
sub spawn {
    my $class = shift;

    defined(my $pid = fork)     or die "Can't fork: $!";
    unless ($pid) {
        chdir '/'               or die "Can't chdir to /: $!";
        open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
        open STDOUT, '>/dev/null'
            or die "Can't write to /dev/null: $!";
        setsid                  or die "Can't start a new session: $!";
        open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
    } else {
        # terrible hack to avoid race condition
        select(undef, undef, undef, 0.25);
        return $pid;
    }

    my $self = $class->new(@_);
    $self->main;
}

# return a socket connected to the daemon
#_______________________________________
sub client {
    my $class  = shift;
    my $socket_path = shift;
    my $client = IO::Socket::UNIX->new (
        Type   => SOCK_STREAM,
        Peer   => $socket_path,
    ) or die($!);
    $client->autoflush(1);
    return $client;
}

# add clean-up handlers
#_______________________________________
sub atExit {
    my $self = shift;
    foreach (@_) {
        unshift(@{$self->{at_exit}}, $_) if (ref eq "CODE");
    }
}

# destructor
#_______________________________________
sub DESTROY {
    my $self = shift;
    my $sub;
    foreach $sub (@{$self->{at_exit}}) { $sub->($self) }
}

# read from $fh until you get a blank line
#_______________________________________
sub readCommand {
    my $self = shift;
    my $fh   = $self->{client};
    my @line;

    while (<$fh>) {
        chomp;
        /^$/ && last;
        push(@line, $_);
    }
    return @line;
}

# delete the socket before exiting
#_______________________________________
sub setupSignals {
    my $self      = shift;
    $SIG{INT}     =
    $SIG{HUP}     =
    $SIG{PIPE}    =
    $SIG{TERM}    =
    $SIG{__DIE__} = sub {
        unlink($self->{socket_path});
        exit 1;
    };
}

# repeatedly executed during the idle loop
#_______________________________________
sub idle {
    my $self = shift;
    if (@_) {
        $self->{idle} = shift;
    } else {
        if (defined $self->{idle} && ref($self->{idle}) eq "CODE") {
            $self->{idle}->($self);
        }
    }
}

# the event loop
#_______________________________________
sub main {
    my $self   = shift;
    my $server = $self->{server};
    my $player = $self->{player};
    my $mpg123 = $player->IN;
    my $client;

    $self->setupSignals;

    my $s = IO::Select->new;
    $s->add($server);
    $s->add($mpg123);
    my (@ready, $fh);

    while (@ready = $s->can_read) {

        foreach $fh (@ready) {

        # [(    handle request from client    )]

            if ($fh == $server) {
                $client = $server->accept();
                $self->{client} = $client;
                $client->autoflush(1);
                my @args = $self->readCommand;
                my $do_this = "_" . shift(@args);

                if ($self->can($do_this)) {
		    # print STDERR "method => $do_this\n";
		    # print STDERR map { "| $_\n" } @args;
                    eval { $self->$do_this(@args) };
                    if ($@) { warn($@); }
                } else {
                    print $client "$do_this is not supported.\n";
                }
                close($client);
                $self->{client} = *STDOUT;  # nice for debugging

        # idle ._,-'~`._,-'~`-._,-'~`-._,-'~`-.

            } else {
                $player->poll(0);
                $self->idle();
                my $s = $player->state();
                $self->next() if ($s == 0);
                print "(" . $player->{frame}[2] . ") [$s] \n";
            }
        }
    }
}

1;

__END__