{
use
lib
'../../../../../lib'
;
use
5.10.0;
our
$MAJOR
= 0.074;
our
$MINOR
= 0;
our
$DEV
= 2;
our
$VERSION
=
sprintf
(
'%1.3f%03d'
. (
$DEV
? ((
$DEV
< 0 ?
''
:
'_'
) .
'%03d'
) : (
''
)),
$MAJOR
,
$MINOR
,
abs
$DEV
);
has
'tracker'
=> (
isa
=>
'Net::BitTorrent::Protocol::BEP05::Tracker'
,
is
=>
'ro'
,
init_arg
=>
undef
,
lazy_build
=> 1
);
sub
_build_tracker {
Net::BitTorrent::Protocol::BEP05::Tracker->new(
routing_table
=>
shift
);
}
has
'nodes'
=> (
isa
=>
'HashRef[Net::BitTorrent::Protocol::BEP05::Node]'
,
is
=>
'ro'
,
init_arg
=>
undef
,
traits
=> [
'Hash'
],
handles
=> {
add_node
=>
'set'
,
get_node
=>
'get'
,
del_node
=>
'delete'
,
defined_node
=>
'defined'
,
count_nodes
=>
'count'
,
all_nodes
=>
'values'
},
default
=>
sub
{ {} }
);
around
'add_node'
=>
sub
{
my
(
$code
,
$self
,
$node
) =
@_
;
if
(!blessed
$node
) {
$node
=
Net::BitTorrent::Protocol::BEP05::Node->new(
host
=>
$node
->[0],
port
=>
$node
->[1],
routing_table
=>
$self
);
}
elsif
(!
$node
->has_routing_table) {
$node
->_routing_table(
$self
) }
return
$code
->(
$self
,
$node
->sockaddr,
$node
);
};
around
'del_node'
=>
sub
{
my
(
$code
,
$self
,
$node
) =
@_
;
$code
->(
$self
, blessed(
$node
) ?
$node
->sockaddr :
$node
);
};
after
'del_node'
=>
sub
{
$_
[1]->bucket->_del_node(
$_
[1])
if
$_
[1]->has_bucket };
has
'buckets'
=> (
isa
=>
'ArrayRef[Net::BitTorrent::Protocol::BEP05::Bucket]'
,
is
=>
'ro'
,
lazy_build
=> 1,
init_arg
=>
undef
,
traits
=> [
'Array'
],
handles
=> {
sort_buckets
=> [
'sort_in_place'
,
sub
{
$_
[0]->floor->Lexicompare(
$_
[1]->floor);
}
],
first_bucket
=>
'first'
,
grep_buckets
=>
'grep'
,
count_buckets
=>
'count'
,
add_bucket
=>
'push'
}
);
after
'add_bucket'
=>
sub
{
shift
->sort_buckets; };
sub
_build_buckets {
my
(
$self
) =
@_
;
[Net::BitTorrent::Protocol::BEP05::Bucket->new(
routing_table
=>
$self
)
];
}
has
'dht'
=> (
isa
=>
'Net::BitTorrent::DHT'
,
required
=> 1,
is
=>
'ro'
,
weak_ref
=> 1,
handles
=> [
qw[send]
],
init_arg
=>
'dht'
);
sub
nearest_bucket {
my
(
$self
,
$target
) =
@_
;
for
my
$bucket
(
reverse
@{
$self
->buckets}) {
return
$bucket
if
$bucket
->floor->Lexicompare(
$target
) != 1;
}
}
before
'nearest_bucket'
=>
sub
{
shift
->sort_buckets; };
sub
assign_node {
my
(
$self
,
$node
) =
@_
;
$self
->nearest_bucket(
$node
->nodeid)->add_node(
$node
);
}
sub
find_node_by_sockaddr {
my
(
$self
,
$sockaddr
) =
@_
;
my
$node
=
$self
->get_node(
$sockaddr
);
if
(!
$node
) {
for
my
$bucket
(@{
$self
->buckets}) {
$node
=
$bucket
->first_node(
sub
{
$_
->sockaddr eq
$sockaddr
});
last
if
$node
;
}
}
return
$node
;
}
sub
outstanding_add_nodes {
grep
{
defined
$_
&& !
$_
->has_bucket }
$_
[0]->all_nodes;
}
}
1;