Skip to content

Commit

Permalink
Move to Moo and Type::Tiny
Browse files Browse the repository at this point in the history
  • Loading branch information
sanko committed Sep 24, 2013
1 parent aa15acb commit ac05d7b
Show file tree
Hide file tree
Showing 4 changed files with 87 additions and 75 deletions.
5 changes: 3 additions & 2 deletions Build.PL
Expand Up @@ -16,7 +16,6 @@ my $mb
license => 'artistic_2', license => 'artistic_2',
dist_author => 'Sanko Robinson <sanko@cpan.org>', dist_author => 'Sanko Robinson <sanko@cpan.org>',
requires => { requires => {
'Any::Moose' => 0,
'AnyEvent' => 0, 'AnyEvent' => 0,
'AnyEvent::HTTP' => 0, 'AnyEvent::HTTP' => 0,
'AnyEvent::Handle' => 0, 'AnyEvent::Handle' => 0,
Expand All @@ -28,8 +27,10 @@ my $mb
'File::Path' => 0, 'File::Path' => 0,
'File::Spec' => 0, 'File::Spec' => 0,
'Module::Build' => 0.38, 'Module::Build' => 0.38,
'Moo' => 0,
'Net::BitTorrent::Protocol' => '1.0.0', 'Net::BitTorrent::Protocol' => '1.0.0',
'Scalar::Util' => 0, 'Scalar::Util' => 0,
'Type::Tiny' => 0,
perl => '5.16.0' perl => '5.16.0'
}, },
build_requires => {'Module::Build' => 0.38, build_requires => {'Module::Build' => 0.38,
Expand Down Expand Up @@ -69,7 +70,7 @@ sub find_cb {
return push @tests, $File::Find::name; return push @tests, $File::Find::name;
} }
__END__ __END__
Copyright (C) 2008-2012 by Sanko Robinson <sanko@cpan.org> Copyright (C) 2008-2013 by Sanko Robinson <sanko@cpan.org>
This program is free software; you can redistribute it and/or modify it This program is free software; you can redistribute it and/or modify it
under the terms of The Artistic License 2.0. See the LICENSE file under the terms of The Artistic License 2.0. See the LICENSE file
Expand Down
7 changes: 6 additions & 1 deletion Changes
@@ -1,4 +1,9 @@
Version 0.1.10 | Soon | xxxxxxxxxx Version 0.2.1 | Sometime on September 26th, 2012 | xxxxxxxxxx

API Changes/Compatibility Information:
* Move to Moo and Type::Tiny

Version 0.2.0 | Sometime on September 26th, 2012 | 9d0d7ba


Resolved Issues/Bug Fixes: Resolved Issues/Bug Fixes:
* Prevent announce flood on trackers * Prevent announce flood on trackers
Expand Down
2 changes: 1 addition & 1 deletion README
Expand Up @@ -303,7 +303,7 @@ Author
CPAN ID: SANKO CPAN ID: SANKO


License and Legal License and Legal
Copyright (C) 2011-2012 by Sanko Robinson <sanko@cpan.org> Copyright (C) 2011-2013 by Sanko Robinson <sanko@cpan.org>


This program is free software; you can redistribute it and/or modify it This program is free software; you can redistribute it and/or modify it
under the terms of The Artistic License 2.0 under the terms of The Artistic License 2.0
Expand Down
148 changes: 77 additions & 71 deletions lib/AnyEvent/BitTorrent.pm
@@ -1,11 +1,12 @@
package AnyEvent::BitTorrent; package AnyEvent::BitTorrent;
{ $AnyEvent::BitTorrent::VERSION = 'v0.2.0' } { $AnyEvent::BitTorrent::VERSION = 'v0.2.1' }
use AnyEvent; use AnyEvent;
use AnyEvent::Handle; use AnyEvent::Handle;
use AnyEvent::Socket; use AnyEvent::Socket;
use AnyEvent::HTTP; use AnyEvent::HTTP;
use Any::Moose; use Moo;
use Any::Moose '::Util::TypeConstraints'; use Type::Tiny;
use Types::Standard qw[ArrayRef CodeRef Enum HashRef Int Ref Str];
use Fcntl qw[/SEEK_/ /O_/ :flock]; use Fcntl qw[/SEEK_/ /O_/ :flock];
use Digest::SHA qw[sha1]; use Digest::SHA qw[sha1];
use File::Spec; use File::Spec;
Expand All @@ -15,14 +16,42 @@ use Scalar::Util qw[/weak/];
# #
# XXX - These should be ro attributes w/o init args: # XXX - These should be ro attributes w/o init args:
my $block_size = 2**14; my $block_size = 2**14;

# Custom types
my $FILE = Type::Tiny->new(name => 'File',
parent => Str,
constraint => sub { -f $_ },
message => sub {"$_ isn't an existing file"},
);
my $RESERVED = Type::Tiny->new(name => 'Reserved',
parent => Str,
constraint => sub { length $_ == 8 },
message => sub {'reserved data is malformed'}
);
my $PEERID = Type::Tiny->new(
name => 'PeerID',
parent => Str,
constraint => sub { length $_ == 20 },
message => sub {
'Peer ID must be 20 chars in length';
}
);
my $INFOHASH = Type::Tiny->new(
name => 'Infohash',
parent => Str,
constraint => sub { length $_ == 20 },
message => sub {
'Infohashes are 20 bytes in length';
}
);
# #
has port => (is => 'ro', has port => (is => 'ro',
isa => 'Int', isa => Int,
default => 0, default => sub {0},
writer => '_set_port' writer => '_set_port'
); );
has socket => (is => 'ro', has socket => (is => 'ro',
isa => 'Ref', isa => Ref,
init_arg => undef, init_arg => undef,
required => 1, required => 1,
predicate => '_has_socket', predicate => '_has_socket',
Expand Down Expand Up @@ -61,17 +90,12 @@ sub _build_socket {
AE::log info => "bound to $thishost, port $thisport"; AE::log info => "bound to $thishost, port $thisport";
}; };
} }
has path => ( has path => (is => 'ro',
is => 'ro', isa => $FILE,
isa => subtype( required => 1
as 'Str' => where { -f $_ } => message { 'Cannot find ' . $_ }
),
required => 1
);
has reserved => (is => 'ro',
isa => subtype(as 'Str' => where { length $_ == 8 }),
lazy_build => 1
); );
has reserved => (is => 'lazy',
isa => $RESERVED);


sub _build_reserved { sub _build_reserved {
my $reserved = "\0" x 8; my $reserved = "\0" x 8;
Expand All @@ -82,12 +106,8 @@ sub _build_reserved {
$reserved; $reserved;
} }
has peerid => ( has peerid => (
is => 'ro', is => 'ro',
isa => subtype( isa => $PEERID,
as 'Str' => where { length $_ == 20 } => message {
'Peer ID must be 20 chars in length';
}
),
init_arg => undef, init_arg => undef,
required => 1, required => 1,
default => sub { default => sub {
Expand All @@ -109,10 +129,9 @@ has peerid => (
); );
} }
); );
has bitfield => (is => 'ro', has bitfield => (is => 'lazy',
isa => 'Str', isa => Str,
init_arg => undef, init_arg => undef,
lazy_build => 1
); );
sub _build_bitfield { pack 'b*', "\0" x shift->piece_count } sub _build_bitfield { pack 'b*', "\0" x shift->piece_count }


Expand Down Expand Up @@ -145,25 +164,18 @@ sub _left {
substr unpack('b*', $s->wanted), 0, $s->piece_count + 1; substr unpack('b*', $s->wanted), 0, $s->piece_count + 1;
} }
has $_ => (is => 'ro', has $_ => (is => 'ro',
isa => 'Num', isa => Int,
default => 0, default => sub {0},
writer => '_set_' . $_ writer => '_set_' . $_
) for qw[uploaded downloaded]; ) for qw[uploaded downloaded];
has infohash => ( has infohash => (is => 'lazy',
is => 'ro', isa => $INFOHASH,
isa => subtype( init_arg => undef,
as 'Str' => where { length $_ == 20 } => message { default => sub { sha1(bencode(shift->metadata->{info})) }
'Infohashes are 20 bytes in length';
}
),
init_arg => undef,
lazy => 1,
default => sub { sha1(bencode(shift->metadata->{info})) }
); );
has metadata => (is => 'ro', has metadata => (is => 'lazy',
isa => 'HashRef', isa => HashRef,
init_arg => undef, init_arg => undef
lazy_build => 1
); );


sub _build_metadata { sub _build_metadata {
Expand All @@ -189,22 +201,20 @@ sub piece_count {
int($count) + (($count == int $count) ? 1 : 0); int($count) + (($count == int $count) ? 1 : 0);
} }
has basedir => ( has basedir => (
is => 'ro', is => 'lazy',
isa => 'Str', isa => Str,
required => 1, required => 1,
lazy => 1,
default => sub { File::Spec->rel2abs(File::Spec->curdir) }, default => sub { File::Spec->rel2abs(File::Spec->curdir) },
trigger => sub { trigger => sub {
my ($s, $n, $o) = @_; my ($s, $n, $o) = @_;
$o // return; $o // return;
$s->_clear_files; # So they can be rebuilt with the new basedir $s->_clear_files; # So they can be rebuilt with the new basedir
} }
); );
has files => (is => 'ro', has files => (is => 'lazy',
isa => 'ArrayRef[HashRef]', isa => ArrayRef [HashRef],
lazy_build => 1, init_arg => undef,
init_arg => undef, clearer => '_clear_files'
clearer => '_clear_files'
); );


sub _build_files { sub _build_files {
Expand Down Expand Up @@ -235,7 +245,7 @@ sub _build_files {
} }
]; ];
} }
has size => (is => 'ro', isa => 'Int', lazy_build => 1, init_arg => undef); has size => (is => 'lazy', isa => Int, init_arg => undef);


sub _build_size { sub _build_size {
my $s = shift; my $s = shift;
Expand Down Expand Up @@ -290,7 +300,7 @@ sub _open {
else {return} else {return}
return $s->files->[$i]->{mode} = $m; return $s->files->[$i]->{mode} = $m;
} }
has piece_cache => (is => 'ro', isa => 'HashRef', default => sub { {} }); has piece_cache => (is => 'ro', isa => HashRef, default => sub { {} });


sub _cache_path { sub _cache_path {
my $s = shift; my $s = shift;
Expand Down Expand Up @@ -500,9 +510,8 @@ sub hashcheck (;@) {
: $s->_trigger_hash_fail($index); : $s->_trigger_hash_fail($index);
} }
} }
has peers => (is => 'ro', has peers => (is => 'lazy',
isa => 'HashRef', isa => HashRef,
lazy => 1,
clearer => '_clear_peers', clearer => '_clear_peers',
builder => '_build_peers' builder => '_build_peers'
); );
Expand Down Expand Up @@ -550,9 +559,8 @@ sub _del_peer {
} }
my $shuffle; my $shuffle;
has trackers => ( has trackers => (
is => 'ro', is => 'lazy',
isa => 'ArrayRef[HashRef]', isa => ArrayRef [HashRef],
lazy => 1,
required => 1, required => 1,
init_arg => undef, init_arg => undef,
default => sub { default => sub {
Expand Down Expand Up @@ -683,7 +691,7 @@ sub _announce_tier {
} }
has _choke_timer => ( has _choke_timer => (
is => 'bare', is => 'bare',
isa => 'Ref', isa => Ref,
init_arg => undef, init_arg => undef,
required => 1, required => 1,
default => sub { default => sub {
Expand Down Expand Up @@ -711,7 +719,7 @@ has _choke_timer => (
); );
has _fill_requests_timer => ( has _fill_requests_timer => (
is => 'bare', is => 'bare',
isa => 'Ref', isa => Ref,
init_arg => undef, init_arg => undef,
required => 1, required => 1,
default => sub { default => sub {
Expand Down Expand Up @@ -757,10 +765,9 @@ has _fill_requests_timer => (
); );
} }
); );
has _peer_timer => (is => 'ro', has _peer_timer => (is => 'lazy',
isa => 'Ref', isa => Ref,
init_arg => undef, init_arg => undef,
lazy => 1,
clearer => '_clear_peer_timer', clearer => '_clear_peer_timer',
builder => '_build_peer_timer' builder => '_build_peer_timer'
); );
Expand Down Expand Up @@ -1112,9 +1119,8 @@ sub _consider_peer { # Figure out whether or not we find a peer interesting
} }
} }
} }
has working_pieces => (is => 'ro', has working_pieces => (is => 'lazy',
isa => 'HashRef', isa => HashRef,
lazy => 1,
init_arg => undef, init_arg => undef,
default => sub { {} } default => sub { {} }
); );
Expand Down Expand Up @@ -1219,17 +1225,17 @@ sub _request_pieces {


# Cheap callback system # Cheap callback system
has on_hash_pass => ( has on_hash_pass => (
isa => 'CodeRef',
is => 'rw', is => 'rw',
isa => CodeRef,
default => sub { default => sub {
sub { !!1 } sub { !!1 }
}, },
clearer => '_no_hash_pass' clearer => '_no_hash_pass'
); );
sub _trigger_hash_pass { shift->on_hash_pass()->(@_) } sub _trigger_hash_pass { shift->on_hash_pass()->(@_) }
has on_hash_fail => ( has on_hash_fail => (
isa => 'CodeRef',
is => 'rw', is => 'rw',
isa => CodeRef,
default => sub { default => sub {
sub { !!1 } sub { !!1 }
}, },
Expand All @@ -1238,9 +1244,9 @@ has on_hash_fail => (
sub _trigger_hash_fail { shift->on_hash_fail()->(@_) } sub _trigger_hash_fail { shift->on_hash_fail()->(@_) }
# #
has state => (is => 'ro', has state => (is => 'ro',
isa => enum([qw[active stopped paused]]), isa => Enum [qw[active stopped paused]],
writer => '_set_state', writer => '_set_state',
default => 'active' default => sub {'active'}
); );


sub stop { sub stop {
Expand Down Expand Up @@ -1702,7 +1708,7 @@ CPAN ID: SANKO
=head1 License and Legal =head1 License and Legal
Copyright (C) 2011-2012 by Sanko Robinson <sanko@cpan.org> Copyright (C) 2011-2013 by Sanko Robinson <sanko@cpan.org>
This program is free software; you can redistribute it and/or modify it under This program is free software; you can redistribute it and/or modify it under
the terms of the terms of
Expand Down

0 comments on commit ac05d7b

Please sign in to comment.