AC-Yenta

 view release on metacpan or  search on metacpan

eg/yenta_get  view on Meta::CPAN

die "usage: get [-h host] map key\n" unless $map && $key;

my $y   = AC::Yenta::Client->new(
    # server_file, servers[], or host + port
    server_file	=> '/var/tmp/yenta.status',
    debug 	=> \&debug,
   );

my $res = $y->get($map, $key);

print dumper($res), "\n";


exit;

sub debug {
    print STDERR @_, "\n";
}

eg/yenta_get_direct  view on Meta::CPAN

use AC::Dumper;
use AC::Yenta::Direct;
use strict;

my $map  = shift @ARGV;
my $file = shift @ARGV;
my $key  = shift @ARGV;

my $y = AC::Yenta::Direct->new( $map, $file );
my $v = $y->get($key);
print  dumper($v), "\n";

eg/yenta_put  view on Meta::CPAN

# Function: put example
#
# $Id$

use AC::Yenta::Client;
use Time::HiRes 'time';
use JSON;
use strict;


my $ys = AC::Yenta::Client->new( debug => sub{ print STDERR @_, "\n"; });


my $key = 'YX3jSXD3CBRUDABm';

my $res = $ys->distribute(
    # map, key, version, data
    'mymap', $key, timet_to_yenta_version(time()),
    encode_json( {
        url_id	=> $key,
        url	=> 'http://www.example.com',

lib/AC/Yenta/Kibitz/Status/Client.pm  view on Meta::CPAN

    }

    my $prefer;
    # make sure we use all networks once in a while
    $prefer ||= $down   unless int rand(20);
    $prefer ||= $public unless int rand(20);
    # prefer private addr if available (cheaper)
    $prefer ||= $private || $public || $down;
    return unless $prefer;

    #print STDERR "using ", inet_itoa($prefer->{ipv4}), "\n";
    return ( inet_itoa($prefer->{ipv4}), ($prefer->{port} || $port) );
}


sub start {
    my $me = shift;

    $me->SUPER::start();

    # build request

lib/AC/Yenta/SixtyFour.pm  view on Meta::CPAN

# $Id$

package AC::Yenta::SixtyFour;
use strict;

# export one set of functions as x64_<name>
sub import {
    my $class  = shift;
    my $caller = caller;

    my $l = length(sprintf '%x', -1);
    my $prefix;
    if( $l >= 16 ){
        $prefix = 'native_';
    }else{
        $prefix = 'bigint_';
        require Math::BigInt;
    }

    no strict;
    no warnings;
    for my $f qw(number_to_hex hex_to_number sixty_four_ones one_million){
        *{$caller . '::' . 'x64_' . $f} = \&{ $prefix . $f };
    }
}

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

sub native_number_to_hex {
    my $v = shift;
    return sprintf '%016X', $v;
}

sub native_hex_to_number {
    my $v = shift;
    return hex($v);
}

# prevent overflow warning on 32 bit system
my $sfo = '0xFFFFFFFF_FFFFFFFF';
sub native_sixty_four_ones {

lib/AC/Yenta/SixtyFour.pm  view on Meta::CPAN

    if( ref $v ){
        my $h = $v->as_hex();

        # remove leading '0x', and pad to length 16
        $h =~ s/^0x//;
        return ('0' x (16 - length($h))) . $h;

    }else{
        # QQQ?
        return sprintf '%016X', $v;
    }
}

sub bigint_hex_to_number {
    my $v = shift;
    return Math::BigInt->new('0x' . $v);
}

sub bigint_sixty_four_ones {
    return Math::BigInt->new($sfo);

lib/AC/Yenta/Stats.pm  view on Meta::CPAN

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

sub http_notfound {
    my $url = shift;

    return ("404 NOT FOUND\nThe requested url /$url was not found on this server.\nSo sorry.\n\n", 404, "Not Found");
}

sub http_load {

    return sprintf("loadave:    %0.4f\n\n", loadave());
}

sub http_status {
    my $status = AC::Yenta::NetMon::status_dom('public');
    return "status: OK\n\n" if $status == 200;
    return("status: PROBLEM\n\n", 500, "Problem");
}

sub http_stats {

    my $res;
    for my $k (sort keys %STATS){
        $res .= sprintf("%-24s%s\n", "$k:", $STATS{$k});
    }

    my @peers = AC::Yenta::Status->allpeers();
    $res .= sprintf("%-24s%s\n", "peers:", scalar @peers);
    $res .= "\n";
    return $res;
}

sub http_data {
    my $url = shift;

    my(undef, $map, $key, $ver) = split m|/|, $url;
    my($data, $version, $file, $meta) = store_get($map, $key, $ver);

lib/AC/Yenta/Status.pm  view on Meta::CPAN

                environment	=> $pd->{environment},
                sort_metric	=> int($pd->{sort_metric}),
                capacity_metric => int($pd->{capacity_metric}),
                datacenter	=> $pd->{datacenter},
                is_local	=> ($here eq $pd->{datacenter} ? 1 : 0),
            };
            if( $pd->{subsystem} eq 'yenta' ){
                $data->{map} = $pd->{map};
            }

            print FILE encode_json( $data ), "\n";
        }

        close FILE;
        unless( rename("$file.tmp", $file) ){
            problem("cannot rename save file '$file': $!");
        }

    }
}

################################################################
# diagnostic reports
sub report {

    my $res;

    for my $v (AC::Yenta::Kibitz::Status::_myself(), AC::Yenta::Monitor::export(), values %{$DATA->{allpeer}} ){
        my $id = sprintf '%-28s', $v->{server_id};
        my $metric = int( $v->{sort_metric} );
        $res .= "$id $v->{hostname}\t$v->{datacenter}\t$v->{subsystem}\t$v->{environment}\t$v->{status}\t$metric\n";
    }

    return $res;
}

sub report_long {

    my $res;

lib/AC/Yenta/Status.pm  view on Meta::CPAN

    }
    return $res;
}
################################################################

sub my_port { $PORT }


sub my_instance_id {
    my $class = shift;
    return my_server_id() . sprintf('/%04x', $$);
}

sub peer {
    my $class = shift;
    my $id    = shift;

    return $DATA->{allpeer}{$id};
}

sub allpeers {

lib/AC/Yenta/Store/BDBI.pm  view on Meta::CPAN

    }
    $cursor->c_close();
    $me->_finish();

    return @k;
}

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

sub _sig {
    print STDERR "bdbi signal @_\n", AC::Error::stack_trace(), "\n";
    exit(-1);
}

sub _start {
    my $me = shift;

    $me->{alarmold} = alarm($TIMEOUT);
    return unless $me->{hasenv};

    # as long as perl handles the signals, everything gets cleaned up

lib/AC/Yenta/Store/File.pm  view on Meta::CPAN

    umask $mask;

    # save file
    my $f;
    unless( open($f, "> $base/$name.tmp") ){
        problem("cannot save file '$base/$name.tmp': $!");
        return;
    }

    debug("saving file '$base/$name'");
    print $f $$cont;
    close $f;
    rename "$base/$name.tmp", "$base/$name";

    return 1;
}


1;

lib/AC/Yenta/Store/Merkle.pm  view on Meta::CPAN

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

sub _mkey {
    my $me    = shift;
    my $shard = shift;
    my $ver   = shift;
    my $lev   = shift;

    # 10/000484D6594DB72B
    sprintf '%02X/%s', $lev, $me->_ver_lev($ver, $lev);
}

sub _decode_mkey {
    my $me = shift;
    my $mk = shift;

    # 10/000484D6594DB72B
    my($l,$sv) = split m|/|, $mk, 2;
    # level, shard, version
    return ($l, undef, $sv);

lib/AC/Yenta/Store/Sharded.pm  view on Meta::CPAN

    my $shard = shift;
    my $ver   = shift;
    my $lev   = shift;

    # L/<S & mask>:V

    # least significant only
    $shard = ('0' x (16 - $SHARDLEN)) . substr($shard, - $SHARDLEN);

    if( $lev == $me->{merkle_height} ){
        return sprintf '%02X/%s:%s', $lev, $shard, $ver;
    }

    if( $lev >= $SHARDLEN ){
        return sprintf '%02X/%s:%s', $lev, $shard, $me->_shver_lev($ver, $lev - $SHARDLEN);
    }

    return sprintf '%02X/%s:%s', $lev, $me->_shver_lev($shard, 16 + $lev - $SHARDLEN), ('0' x 16);
}

sub _decode_mkey {
    my $me = shift;
    my $mk = shift;

    # 20/8843d7f92416211d:0000000049D2A314
    my($l,$sv) = split m|/|, $mk, 2;
    my($s,$v)  = split /:/, $sv, 2;
    return ($l, $s, $v);

lib/AC/Yenta/Store/Tokyo.pm  view on Meta::CPAN

        problem("no dbfile specified for '$name'");
        return;
    }

    debug("opening Tokyo DB file=$file");

    my $db = TokyoCabinet::BDB->new();
    my $flags = $conf->{readonly} ? ($db->OREADER | $db->ONOLCK) : ($db->OWRITER | $db->OCREAT);
    if(!$db->open($file, $flags)){
        #my $ecode = $db->ecode();
        #printf STDERR ("open error: %s\n", $db->errmsg($ecode));
        problem("cannot open db file $file");
    }

    # web server will need access
    chmod 0666, $file;

    return bless {
        file	=> $file,
        db	=> $db,
    }, $class;