AC-DC

 view release on metacpan or  search on metacpan

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

    my $fd = $me->{fd};
    return unless $fd;
    my $n  = fileno($fd);
    debug("shutting down fileno $n $me->{info}");
    $me->wantread(0);
    $me->wantwrite(0);

    delete $me->{fd};
    close $fd;
    $fileno[$n] = undef;

    $me->run_callback('shutdown', undef);
    delete $me->{_callback};

    if( $n >= $maxfn ){
        while( $maxfn && !$fileno[$maxfn] ){ $maxfn -- }
    }
}

sub wantread {
    my $me = shift;
    my $v  = shift;

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

    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;
    $len = $bs if $len > $bs;
    my $buf = substr($me->{_wbuffer}, 0, $len);
    my $i = syswrite( $me->{fd}, $buf );

    if( defined $i ){
        # debug("wrote $i bytes to $me->{info}");
        substr($me->{_wbuffer}, 0, $i) = '';
        if( length($me->{_wbuffer}) ){
            $me->timeout_rel( $me->{writebuf_timeout} ) if $me->{writebuf_timeout};
        }else{
            $me->wantwrite(0);
            $me->run_callback('write_buffer_empty', undef);
        }
    }else{
        my $e = $!;
        debug( "write failed ($e) for $me->{info}");
        $me->run_callback('error', {
            cause	=> 'write',
            error	=> $e,
        });
        $me->shut();
    }
}

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

sub _readable {
    my $me = shift;

    $me->run_callback('readable', undef);
}

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);
}

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

    $^T = $t0;
    my $r = $rvec;
    my $w = $wvec;

    my $t;
    if( @timeout ){
        $t = $timeout[0]{_timeout} - $^T;
        $t = 0 if $t < 0;
    }

    my $i = select($r, $w, undef, $t);

    if( $i == -1 ){
        return if $! == EINTR;
        fatal( "select failed: $!" );
    }

    my $t1 = time();
    $^T = $t1;

    # dispatch

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

        debug("read error");
        $me->run_callback('error', {
            cause	=> 'read',
            error	=> $e,
        });
        $me->shut();
        return ;
    }
    unless( $i ){
        debug("read eof");
        $me->run_callback('read_eof', undef);
        $me->shut();
        return ;
    }

    debug("forked read $i bytes");
    $me->run_callback('read', { data => $buf, size => $i } );

}

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

        debug("read error - $me->{info}");
        $me->run_callback('error', {
            cause	=> 'read',
            error	=> $e,
        });
        $me->shut();
        return ;
    }
    unless( $i ){
        debug("read eof - $me->{info}");
        $me->run_callback('read_eof', undef);
        $me->shut();
        return ;
    }

    $me->run_callback('read', { data => $buf, size => $i } );

}

1;

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

        if( $i ){
            my $e = $! = $i;
            debug("tcp client connect failed: $! ($me->{info})");
            $me->run_callback('error', { cause => 'connect', error => "connect failed: $e" });
            $me->shut();
            return;
        }

        debug("tcp client connected $me->{info}");
        $me->{_connected} = 1;
        $me->run_callback('connect', undef);
    }

    $me->SUPER::_writable(@_);
}

sub use_addr_port {
    my $class = shift;

    return @_;
}

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

    my $fn = fileno($s);
    my $wfd = "\0\0\0\0";
    vec($wfd, $fn, 1) = 1;

    my $i = connect($s, $sa);
    return 1 if $i;	# connected
    return unless $! == EISCONN || $! == EALREADY || $! == EINPROGRESS;

    # wait until connected or timeout
    my $is = select(undef, $wfd, undef, $to);
    return if $is == -1;
    return 1 if vec($wfd, $fn, 1);
    return;
}

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

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

    my $fn = fileno($s);

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

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

        my $si = select(undef, $wfd, undef, $to);
        confess "write data failed: $!\n" if $si == -1;
        confess "write timeout\n" unless vec($wfd, $fn, 1);

        my $l = $tlen > $BUFSIZ ? $BUFSIZ : $tlen;
        my $i = syswrite($s, $req, $l, $slen);
        confess "write failed $!\n" unless $i >= 1;
        $tlen -= $i;
        $slen += $i;
    }

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

    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;
        my $to = $start + $timeo - time();
        my $t0 = time();

        my $si = select($rfd, undef, undef, $to);
        next if $si == -1 && $! == EINTR;
        confess "read data failed: $!\n" if $si == -1;
        confess "read timeout " . (time() - $t0) . "\n" unless vec($rfd, $fn, 1);

        my $i = sysread($s, $data, $len, length($data));
        next if !defined($i) && $! == EINTR;
        confess "read failed: connection closed (read " . length($data) . " of $len)\n" if $i == 0;
    }

    fcntl($s, F_SETFL, $fl);

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

        close PID;
    }

    # run as 2 processes
    while(1){
	$childpid = fork;
	die "cannot fork: $!\n" unless defined $childpid;
        if( $childpid ){
            # parent
            wait;
            $childpid = undef;
            sleep $tout;
        }else{
            # child
            return;
        }
    }
}

sub _signal {
    my $name = shift;