AC-DC

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

--- #YAML:1.0
name:               AC-DC
version:            1.1
abstract:           Asynchronous IO Framework. plus.
author:
    - AdCopy <http://www.adcopy.com>
license:            perl
distribution_type:  module
configure_requires:
    ExtUtils::MakeMaker:  0
requires:
    Digest::SHA1:        0
    MIME::Base64:        0
    POSIX:               0
    Sys::Hostname:       0
    Sys::Syslog:         0
    Time::HiRes:         0
    Time::Local:         0
    Unicode::Normalize:  0
no_index:
    directory:

lib/AC/ConfigFile/Simple.pm  view on Meta::CPAN

    my $me   = shift;
    my $file = shift;

    my $fd;
    open($fd, $file) || die "cannot open file '$file': $!";
    $me->{fd} = $fd;

    push @{$me->{_files}}, $file;

    while( defined(my $l = $me->_nextline()) ){
        my($key, $rest) = split /\s+/, $l, 2;
        $me->handle_config( $key, $rest ) || die "invalid config '$key'\n";
    }

    close $fd;
}

sub handle_config {
    my $me   = shift;
    my $key  = shift;
    my $rest = shift;

    my $fnc = $CONFIG{$key} || $CONFIG{_default};
    return unless $fnc;
    $fnc->($me, $key, $rest);
    return 1;
}

sub _nextline {
    my $me = shift;

    my $line;
    while(1){
        my $fd = $me->{fd};

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

sub new {
    my $class = shift;
    my $addr  = shift;
    my $port  = shift;

    ($addr, $port) = $class->use_addr_port( $addr, $port );

    debug("starting new tcp client: $addr:$port");
    my $ip = inet_aton($addr);
    unless($ip){
        verbose("tcp client cannot resolve '$addr'");
        return ;
    }

    my $me = $class->SUPER::new( @_ );

    $me->{tcp_server_ip}   = $ip;
    $me->{tcp_server_addr} = $addr;
    $me->{tcp_server_port} = $port;

    return $me;

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

#       Auth PB(auth-length)
#	Data PB(data-length)
#       Content(content-length)


my $VERSION = 0x41433032;
my $BUFSIZ  = 65536;

my %MSGTYPE;
my %MSGREV;
#  status		=> { num => 0, reqc => '', 			resc => 'ACPStdReply' },


sub header_size { return 28 }

sub new {
    my $class = shift;
    return bless { @_ }, $class;
}

sub add_msg {
    my $class = shift;
    my $name  = shift;
    my $num   = shift;
    my $reqc  = shift;
    my $resc  = shift;

    my $d = {
        name	=> $name,
        num	=> $num,
        reqc	=> $reqc,
        resc	=> $resc,
    };

    $MSGTYPE{$name} = $d;
    $MSGREV{$num}   = $name;

}

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

sub encode_header {

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

sub _decode_common {
    my $me    = shift;
    my $how   = shift;
    my $reply = shift;
    my $data  = shift;

    my $mt = $MSGTYPE{ $reply->{type} };
    confess "unknown message type $reply->{type}\n" unless defined $mt;

    return unless $data || $reply->{data};
    my $res = $mt->{$how}->decode( $data || $reply->{data} || '' );
    return $res;
}

sub encode_request {
    my $me = shift;

    return $me->_encode_common( 'reqc', @_ );
}
sub encode_reply {
    my $me = shift;

    return $me->_encode_common( 'resc', @_ );
}

sub decode_request {
    my $me    = shift;

    return $me->_decode_common( 'reqc', @_ );
}

sub decode_reply {
    my $me    = shift;

    return $me->_decode_common( 'resc', @_ );
}

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

sub _try_to_connect {
    my $s  = shift;
    my $sa = shift;
    my $to = shift;

    my $fn = fileno($s);

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

    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 {

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

    $debug ||= sub {};
    $timeo ||= 0.5;
    local $SIG{ALRM} = sub{ $debug->("timeout") };

    my $s = $me->connect_to_server($ipn, $port, $timeo);

    # send request
    $debug->("sending request");
    $me->write_request($s, $req, $timeo);

    # get response or timeout
    $debug->("reading header");
    my $buf = $me->read_data($s, header_size(), $timeo);

    my $p = $me->decode_header($buf);

    # get auth
    if( $p->{auth_length} ){
	# read gpb
	$debug->("reading auth $p->{auth_length}");
        my $data = $me->read_data($s, $p->{auth_length}, $timeo);

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

    return $me;
}

sub _sched {
    my $me = shift;

    $me->timeout_abs( $me->{sched}{time} );
}

sub _resched {
    my $me = shift;
    while( $me->{sched}{time} < $^T ){ $me->{sched}{time} += $me->{sched}{freq} }
    $me->_sched();
}

sub _timeout {
    my $me = shift;

    # run specified func
    debug("running scheduled func ($me->{info})");
    $me->{sched}{func}->($me->{sched}{args});
    $me->_resched() if $me->{sched}{freq};
}


1;

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

        *stack_trace  = sub {};
    }
}

our @EXPORT = qw(daemonize run_and_watch initlog debugmsg verbose problem fatal);

my $childpid;
my $verbose = 1;
my $nomail  = 0;
my $syslog;
my @maybe_argv = @ARGV;	# save for restart (might not be available)

sub daemonize {
    my $tout = shift;
    my $name = shift;
    my $argv = shift;

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

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