view release on metacpan or  search on metacpan

lib/Algorithm/Kademlia.pm  view on Meta::CPAN

use v5.42;
use experimental 'class';
#
package Algorithm::Kademlia v1.1.1 {
    use parent 'Exporter';
    our @EXPORT_OK = qw[xor_distance xor_bucket_index];
    #
    sub xor_distance ( $id1_bin, $id2_bin ) { $id1_bin^.$id2_bin }

    sub xor_bucket_index ( $id1_bin, $id2_bin ) {
        my $dist  = $id1_bin^.$id2_bin;
        my @bytes = unpack( 'C*', $dist );
        my $len   = scalar @bytes;
        for my $i ( 0 .. $#bytes ) {
            next if $bytes[$i] == 0;
            my $byte = $bytes[$i];
            for ( my $j = 7; $j >= 0; $j-- ) {

                # Standard Kademlia: bucket i covers distance [2^i, 2^{i+1})
                return ( ( $len - 1 - $i ) * 8 ) + $j if $byte & ( 1 << $j );
            }
        }
        return undef;    # Same ID
    }
    class Algorithm::Kademlia::RoutingTable v1.1.0 {
        field $local_id_bin : param : writer : reader;
        field $k : param //= 20;
        field @buckets : reader;
        #
        ADJUST {
            my $id_len      = length $local_id_bin;
            my $num_buckets = $id_len * 8;
            @buckets = map { [] } 0 .. $num_buckets - 1
        }

        method add_peer ( $peer_id_bin, $peer_data ) {
            my $idx = Algorithm::Kademlia::xor_bucket_index( $local_id_bin, $peer_id_bin );
            return undef unless defined $idx;
            my $bucket = $buckets[$idx];

            # Find existing
            my $existing_idx = -1;
            for my $i ( 0 .. $#$bucket ) {
                if ( $bucket->[$i]{id} eq $peer_id_bin ) {
                    $existing_idx = $i;
                    last;
                }
            }
            if ( $existing_idx != -1 ) {    # Move to tail (most recent)
                my $peer = splice( @$bucket, $existing_idx, 1 );
                $peer->{data} = $peer_data;    # Update data
                push @$bucket, $peer;
                return undef;
            }
            if ( scalar @$bucket < $k ) {
                push @$bucket, { id => $peer_id_bin, data => $peer_data };
                return undef;
            }
            $bucket->[0];    # Bucket is full. Return oldest peer to be pinged.
        }

        method evict_peer ($peer_id_bin) {
            my $idx    = Algorithm::Kademlia::xor_bucket_index( $local_id_bin, $peer_id_bin ) // return;
            my $bucket = $buckets[$idx];
            @$bucket = grep { $_->{id} ne $peer_id_bin } @$bucket;
        }

        method find_closest ( $target_id_bin, $count = undef ) {
            $count //= $k;
            my @all_peers;
            push @all_peers, @$_ for @buckets;
            my @sorted = sort { ( $a->{id} ^.$target_id_bin ) cmp( $b->{id} ^.$target_id_bin ) } @all_peers;
            splice @sorted, 0, $count;
        }

        method size () {
            my $count = 0;
            $count += scalar @$_ for @buckets;
            $count;
        }

        method import_peers ($peer_list) {
            for my $p (@$peer_list) {

                # Directly push to avoid eviction logic during restore
                my $idx = Algorithm::Kademlia::xor_bucket_index( $local_id_bin, $p->{id} );
                next unless defined $idx;
                push $buckets[$idx]->@*, $p;
            }
        }
    };