AC-DC

 view release on metacpan or  search on metacpan

lib/AC/DC/Callback.pm  view on Meta::CPAN

# Created: 2009-Mar-27 10:41 (EDT)
# Function: event callback mixin
#
# $Id$

package AC::DC::Callback;
use AC::DC::Debug 'callback';
use AC::Import;
use strict;

our @EXPORT = qw(set_callback clear_callback run_callback);


sub set_callback {
    my $me  = shift;
    my $cb  = shift;
    my $fnc = shift;

    $me->{_callback}{$cb} = { func => $fnc, args => [@_] };
}

sub clear_callback {
    my $me  = shift;
    my $cb  = shift;

lib/AC/DC/IO.pm  view on Meta::CPAN

    return $txt;
}

sub request_exit { $exitrequested = 1 }

sub init {
    my $me = shift;
    my $fd = shift;

    $me->{fd} = $fd;
    $me->_setnbio();
    my $n = fileno($fd);
    $fileno[ $n ] = $me;
    $maxfn = $n if $n > $maxfn;
    debug("init io fileno $n (/$maxfn) - $me->{info}");
}

sub shut {
    my $me = shift;

    $me->clear_timeout();

lib/AC/DC/IO.pm  view on Meta::CPAN

    my $data = shift;

    $me->{_wbuffer} .= $data;
    $me->wantwrite(1);
}

sub write_and_shut {
    my $me = shift;

    $me->write(@_);
    $me->set_callback('write_buffer_empty', \&shut);
}


sub _writable {
    my $me = shift;

    return $me->run_callback('writeable', undef) unless $me->{_wbuffer};

    my $len = length($me->{_wbuffer});
    my $bs = $me->{wbufsize} || $BUFSIZ;

lib/AC/DC/IO.pm  view on Meta::CPAN

sub _timeout {
    my $me = shift;

    debug("io - timeout $me->{info}");
    $me->run_callback('timeout', undef);
}

################################################################

sub _setnbio {
    my $me = shift;

    my $fd = $me->{fd};
    fcntl($fd, F_SETFL, O_NDELAY);
}

################################################################

sub _oneloop {

lib/AC/DC/IO/TCP/Server.pm  view on Meta::CPAN

    my $me = bless {
        info	  => "server tcp/$port",
        nextclass => $nextc,
        nextarg   => $arg,
    }, $class;

    my $fd;

    socket($fd, PF_INET, SOCK_STREAM, 0);
    setsockopt($fd, SOL_SOCKET, SO_REUSEADDR, 1);
    my $i = bind($fd, sockaddr_in($port, INADDR_ANY));

    fatal( "cannot bind to tcp/$port: $!" ) unless $i;

    listen( $fd, 128 );
    $me->init($fd);
    $me->wantread(1);

    return $me;
}

lib/AC/DC/IO/UDP/Server.pm  view on Meta::CPAN

    my $me = bless {
        info	  => "server udp/$port",
        nextclass => $nextc,
        nextarg   => $arg,
    }, $class;

    my $fd;

    socket($fd, PF_INET, SOCK_DGRAM, 0);
    setsockopt($fd, SOL_SOCKET, SO_REUSEADDR, 1);
    my $i = bind($fd, sockaddr_in($port, INADDR_ANY));

    fatal( "cannot bind to udp/$port: $!" ) unless $i;

    listen( $fd, 128 );
    $me->init($fd);
    $me->wantread(1);

    return $me;
}

lib/AC/DC/Protocol.pm  view on Meta::CPAN

}

sub connect_to_server {
    my $me    = shift;
    my $ipn   = shift;
    my $port  = shift;
    my $timeo = shift;

    my $s;
    socket($s, PF_INET, SOCK_STREAM, 6) || confess "cannot create socket: $!\n";
    setsockopt($s, Socket::IPPROTO_TCP(), Socket::TCP_NODELAY(), 1);

    # set non-blocking
    my $fl = fcntl($s, F_GETFL, 0);
    fcntl($s, F_SETFL, O_NDELAY);

    my $sa  = sockaddr_in($port, $ipn);
    my $to  = $timeo ? $timeo / 2 : 0.25;

    # try connecting up to 3 times
    for (1..3){
        # print STDERR "connecting\n";
        my $ok = _try_to_connect($s, $sa, $to);

        if( $ok ){
            # reset non-blocking
            fcntl($s, F_SETFL, $fl);
            return $s;
        }
    }

    my $ipa = inet_ntoa($ipn);
    confess "connect failed to $ipa:$port\n";
}

sub write_request {
    my $me    = shift;
    my $s     = shift;
    my $req   = shift;
    my $timeo = shift;

    $timeo ||= 1;

    # set non-blocking
    my $fl = fcntl($s, F_GETFL, 0);
    fcntl($s, F_SETFL, O_NDELAY);
    my $fn = fileno($s);

    my $tlen = length($req);
    my $slen = 0;

    while($tlen){
        my $wfd = "\0\0\0\0";
        vec($wfd, $fn, 1) = 1;

lib/AC/DC/Protocol.pm  view on Meta::CPAN

}

sub read_data {
    my $me    = shift;
    my $s     = shift;
    my $size  = shift;
    my $timeo = shift;

    $timeo ||= 1;

    # set non-blocking
    my $fl = fcntl($s, F_GETFL, 0);
    fcntl($s, F_SETFL, O_NDELAY);
    my $fn = fileno($s);

    my $data;
    my $start = time();
    while( my $len = $size - length($data) ){
        $len = $BUFSIZ if $len > $BUFSIZ;
        my $rfd = "\0\0\0\0";
        vec($rfd, $fn, 1) = 1;

lib/AC/Daemon.pm  view on Meta::CPAN

    my $argv = shift;

    fork && exit;	# background ourself
    $verbose = 0;

    my @argv = $argv ? @$argv : @maybe_argv;

    close STDIN;        open( STDIN,  "/dev/null" );
    close STDOUT;       open( STDOUT, "> /dev/null" );
    close STDERR;       open( STDERR, "> /dev/null" );
    setsid();

    $SIG{QUIT} = $SIG{INT} = $SIG{TERM} = sub { _signal($name, @_) };

    if( $name ){
        # save pid file
        open(PID, "> /var/run/$name.pid");
        print PID "$$\n";
        print PID "# @argv\n";
        close PID;
    }