view release on metacpan or  search on metacpan

Daemon.pm  view on Meta::CPAN

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