AC-DC

 view release on metacpan or  search on metacpan

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

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

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

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

    # run as 2 processes
    while(1){
	$childpid = fork;
	die "cannot fork: $!\n" unless defined $childpid;
        if( $childpid ){
            # parent
            wait;

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

    syslog( 'err', '%s', $msg ) if $syslog;
    _to_stderr( $msg );
    exit -1;
}

sub _to_stderr {
    my $msg = shift;

    my $tx = Time::HiRes::time();
    my $f  = $tx - int($tx);
    $f = sprintf('%.6f', $f);
    $f =~ s/^0\.//;
    my $t = strftime '%H:%M:%S', localtime($tx);
    print STDERR "[$$ $t.$f] $msg\n";

}

sub _send_trace {

    # email a stack trace to developer
    problem("sigusr2");
}

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

    if( ref($val) && $val =~ 'HASH' ){
        return '{}' unless keys %$val;
        my $out  = "{\n";
	# align nicely
        my $maxl = 0;
        $maxl = (length($_) > $maxl) ? length($_) : $maxl for keys %$val;
        for my $k (sort keys %$val){
            my $v = _dump($val->{$k}, $seen);
            $v =~ s/\n(.)/\n  $1/gm;	 # indent
            $out .= sprintf "  %-${maxl}s => %s\n", $k, $v;
        }
        $out .= "}";
        return $out;
    }

    if( ref($val) && $val =~ 'ARRAY' ){
        return '[]' unless @$val;
        my $out = "[\n";
        for my $k (@$val){
            my $v = _dump($k, $seen);

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

use strict;
our @EXPORT = qw(isotime timeiso);

# convert time_t => iso8601
sub isotime {
    my $t = shift;
    my $precision = shift;

    return unless $t;
    $precision ||= 6;
    my $f = sprintf("%.${precision}f", $t - int($t));
    $f =~ s/^0//;
    $f = '' if $f =~ /\.0+$/;
    return strftime( '%Y%m%dT%H%M%S', gmtime($t)) . $f . 'Z';

}

# convert iso8601 => time_t
sub timeiso {
    my $iso = shift;

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

    my $s = shift;
    my $r;
    my $off = 0;

    while( my $l = substr($s,0, 16, '') ){
	(my $t = $l) =~ s/\W/\./g;
	my $h = unpack('H*', $l) . ('  ' x (16 - length($l)));
	$h =~ s/(..)/$1 /g;
	$h =~ s/(.{24})/$1 /;

	$r .= sprintf('%04X: ', $off) . "$h $t\n";
	$off += 16;
    }

    $r;
}

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

sub encode_base64_safe {
    my $t = shift;

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

    $u .= '=' x (4-$l) if $l;

    return decode_base64($u);
}

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

sub url_encode {
    my $txt = shift;

    $txt =~ s/([^a-z0-9_\.\-])/sprintf('%%%02x',ord($1))/gei;
    return $txt;
}

sub url_decode {
    my $txt = shift;

    $txt =~ s/%(..)/chr(hex $1)/ge;
    return $txt;
}