[net-bittorrent commit] r47 - in trunk: . lib/Net/BitTorrent tatoeba
codesite...@google.com
Date: Wed Dec 31 10:05:14 2008
New Revision: 47
Added:
trunk/tatoeba/002-debug.pl (contents, props changed)
Modified:
trunk/Build.PL
trunk/Changes
trunk/MANIFEST
trunk/MANIFEST.SKIP
trunk/lib/Net/BitTorrent/Peer.pm
trunk/lib/Net/BitTorrent/Torrent.pm
trunk/lib/Net/BitTorrent/Version.pm
Log:
New debugging example and testing usefulness of half_open limit
- [etc] new debugging script: /tatoeba/002-debug.pl
- [etc] Don't constrain outgoing connection attempts with half_open limit
(temporary change for testing)
- [etc] Net::BitTorrent::Peer->as_string(1) tweaks (with much more to do)
- [fix] Correct MailingList metadata generated by Build.PL
Modified: trunk/Build.PL
==============================================================================
--- trunk/Build.PL (original)
+++ trunk/Build.PL Wed Dec 31 10:05:14 2008
@@ -238,8 +238,7 @@
q[http://code.google.com/p/net-bittorrent/issues/list],
homepage => q[http://sankorobinson.com/net-bittorrent/],
license =>
q[http://www.perlfoundation.org/artistic_license_2_0],
- MailingList =>
- q[http://groups.google.com/group/net-bittorrent-discuss],
+ MailingList =>
q[http://groups.google.com/group/net-bittorrent],
repository =>
q[http://code.google.com/p/net-bittorrent/source/browse/]
},
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Wed Dec 31 10:05:14 2008
@@ -1,4 +1,21 @@
-Version 0.046 |
+Version 0.0XX |
+
+ API Changes/Compatibility Information:
+ - None
+
+ Resolved Issues/Bugfixes:
+ - None
+
+ Protocol/Behavioral Changes:
+ - None
+
+ Documentation/Sample Code/Test Suite:
+ - New debugging script in /tatoeba/002-debug.pl
+
+ Notes:
+ - None
+---
+Version 0.046 | 2008-12-30 18:25:17 -0500 (Tue, 30 Dec 2008)
API Changes/Compatibility Information:
- Net::BitTorrent::Torrent::HTTP->url() is now public
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Wed Dec 31 10:05:14 2008
@@ -45,4 +45,5 @@
t/900_data/950_torrents/credits.txt
tatoeba/000-basic.pl
tatoeba/001-torrent-info.pl
+tatoeba/002-debug.pl
TODO.pod
Modified: trunk/MANIFEST.SKIP
==============================================================================
--- trunk/MANIFEST.SKIP (original)
+++ trunk/MANIFEST.SKIP Wed Dec 31 10:05:14 2008
@@ -60,6 +60,7 @@
# Don't package silly stuff
tatoeba/.+/.+
+tatoeba/.*.log$
# Don't package downloaded/perif files
\.avi
Modified: trunk/lib/Net/BitTorrent/Peer.pm
==============================================================================
--- trunk/lib/Net/BitTorrent/Peer.pm (original)
+++ trunk/lib/Net/BitTorrent/Peer.pm Wed Dec 31 10:05:14 2008
@@ -10,7 +10,7 @@
use Fcntl qw[F_SETFL O_NONBLOCK];
use version qw[qv];
our $SVN = q[$Id$];
- our $UNSTABLE_RELEASE = 0; our $VERSION = sprintf(($UNSTABLE_RELEASE ?
q[%.3f_%03d] : q[%.3f]), (version->new((qw$Rev$)[1])->numify / 1000),
$UNSTABLE_RELEASE);
+ our $UNSTABLE_RELEASE = 1; our $VERSION = sprintf(($UNSTABLE_RELEASE ?
q[%.3f_%03d] : q[%.3f]), (version->new((qw$Rev$)[1])->numify / 1000),
$UNSTABLE_RELEASE);
use lib q[../../../lib];
use Net::BitTorrent::Protocol qw[:build parse_packet :types];
use Net::BitTorrent::Util qw[:bencode];
@@ -1370,29 +1370,40 @@
(!$advanced ? q[%s:%s (%s)] : <<'ADVANCED'),
Net::BitTorrent::Peer
-Address: %s:%s
-Peer ID: %s
-Torrent: %s
-
-Current statuss:
- Interested: %s
- Interesting: %s
- Choked: %s
- Choking: %s
+Address: %s:%s
+Peer ID: %s
+Torrent: %s
+Direction: %s
+
+Interested: %s
+Interesting: %s
+Choked: %s
+Choking: %s
+Progress:
+[%s]
ADVANCED
($self->_host || q[]),
($self->_port || q[]),
($peerid{refaddr $self} ? $peerid{refaddr $self} : q[Unknown]),
- (defined $_torrent{refaddr $self}
+ ( $_torrent{refaddr $self}
? $_torrent{refaddr $self}->infohash
: q[Unknown]
),
+ ($_incoming{refaddr $self} ? q[Incoming] : q[Outgoing]),
(map { $_ ? q[Yes] : q[No] } ($_peer_interested{refaddr $self},
$_am_interested{refaddr $self},
$_am_choking{refaddr $self},
$_peer_choking{refaddr $self}
)
+ ),
+ ($_torrent{refaddr $self}
+ ? (sprintf q[%s],
+ join q[],
+ map { vec(${$_bitfield{refaddr $self}}, $_, 1) ? q[|] : q[
] }
+ 0 .. $_torrent{refaddr $self}->piece_count - 1
+ )
+ : q[NA]
)
);
return defined wantarray ? $dump : print STDERR qq[$dump\n];
Modified: trunk/lib/Net/BitTorrent/Torrent.pm
==============================================================================
--- trunk/lib/Net/BitTorrent/Torrent.pm (original)
+++ trunk/lib/Net/BitTorrent/Torrent.pm Wed Dec 31 10:05:14 2008
@@ -25,7 +25,7 @@
use Net::BitTorrent::Torrent::Tracker;
use version qw[qv];
our $SVN = q[$Id$];
- our $UNSTABLE_RELEASE = 0; our $VERSION = sprintf(($UNSTABLE_RELEASE ?
q[%.3f_%03d] : q[%.3f]), (version->new((qw$Rev$)[1])->numify / 1000),
$UNSTABLE_RELEASE);
+ our $UNSTABLE_RELEASE = 1; our $VERSION = sprintf(($UNSTABLE_RELEASE ?
q[%.3f_%03d] : q[%.3f]), (version->new((qw$Rev$)[1])->numify / 1000),
$UNSTABLE_RELEASE);
my %REGISTRY = ();
my @CONTENTS = \my (%_client, %path, %_basedir,
%size, %files, %trackers,
@@ -589,7 +589,14 @@
- scalar $self->_peers
)
)
- { last if not @nodes;
+ { #last
+ # if scalar(
+ # grep {
+ # $_->{q[Object]}->isa(q[Net::BitTorrent::Peer])
+ # and not $_->{q[Object]}->peerid
+ # } values %{$_client{refaddr $self}->_connections}
+ # ) >= $_client{refaddr $self}->_half_open;
+ last if not @nodes;
my $node = shift @nodes;
my $ok = $_client{refaddr $self}
->_event(q[ip_filter], {Address => $node});
@@ -599,13 +606,6 @@
Torrent => $self
}
);
- last
- if scalar(
- grep {
- $_->{q[Object]}->isa(q[Net::BitTorrent::Peer])
- and not defined $_->{q[Object]}->peerid
- } values %{$_client{refaddr $self}->_connections}
- ) >= $_client{refaddr $self}->_half_open;
}
return 1;
}
Modified: trunk/lib/Net/BitTorrent/Version.pm
==============================================================================
--- trunk/lib/Net/BitTorrent/Version.pm (original)
+++ trunk/lib/Net/BitTorrent/Version.pm Wed Dec 31 10:05:14 2008
@@ -5,7 +5,7 @@
use warnings;
use version qw[qv];
our $SVN = q[$Id$];
- our $VERSION_BASE = 46; our $UNSTABLE_RELEASE = 0; our $VERSION =
sprintf(($UNSTABLE_RELEASE ? q[%.3f_%03d] : q[%.3f]),
(version->new(($VERSION_BASE))->numify / 1000), $UNSTABLE_RELEASE);
+ our $VERSION_BASE = 46; our $UNSTABLE_RELEASE = 1; our $VERSION =
sprintf(($UNSTABLE_RELEASE ? q[%.3f_%03d] : q[%.3f]),
(version->new(($VERSION_BASE))->numify / 1000), $UNSTABLE_RELEASE);
our $PRODUCT_TOKEN = qq[Net::BitTorrent $VERSION];
sub gen_peerid {
Added: trunk/tatoeba/002-debug.pl
==============================================================================
--- (empty file)
+++ trunk/tatoeba/002-debug.pl Wed Dec 31 10:05:14 2008
@@ -0,0 +1,202 @@
+#!perl -w -I../lib
+use strict;
+use warnings;
+use Net::BitTorrent;
+use Data::Dumper;
+use Time::HiRes qw[time];
+$|++;
+my $OLD_STDERR = \*STDERR;
+open *STDERR, q[>], q[net-bittorrent.log]
+ or die q[Failed to create log: ] . $^E;
+
+sub l { # logs events
+ my ($line) = @_;
+ syswrite STDOUT, $line . qq[\r\n];
+ syswrite STDERR, sprintf <<END, time, $line }
+%10.8f ===========================================================
+%s
+END
+l q[Load];
+my $client = Net::BitTorrent->new();
+
+sub p {
+ l q[Current peers...];
+ l join qq[ ----------\r\n], map { $_->{q[Object]}->as_string(1) } grep
{
+ $_->{q[Object]}
+ and $_->{q[Object]}->isa(q[Net::BitTorrent::Peer])
+ } values %{$client->_connections};
+}
+l $client->as_string(1);
+my $file = shift;
+l sprintf q[Loading '%s'], $file;
+my $torrent = $client->add_torrent({Path => $file});
+if (!$torrent) {
+ l sprintf q[Failed to load '%s'], $torrent;
+ l q[Exiting...];
+ exit;
+}
+l q[Loaded torrent okay. Raw data follows...];
+l Dumper $torrent->raw_data(1);
+l q[Setting client-wide callbacks...];
+$client->on_event(
+ q[ip_filter],
+ sub {
+ my ($self, $args) = @_;
+ l q[ ip_filter | ] . $args->{q[Address]};
+ p;
+ }
+);
+$client->on_event(q[peer_connect],
+ sub { l q[ peer_connect | ] . Dumper \@_; p; });
+$client->on_event(q[peer_disconnect],
+ sub { l q[ peer_disconnect | ] . Dumper \@_; p; });
+$client->on_event(
+ q[peer_read],
+ sub {
+ l q[ peer_read | ] . Dumper \@_;
+ }
+);
+$client->on_event(q[peer_write],
+ sub { l q[ peer_write | ] . Dumper \@_; });
+$client->on_event(q[tracker_connect],
+ sub { l q[ tracker_connect | ] . Dumper \@_; });
+$client->on_event(q[tracker_disconnect],
+ sub { l q[ tracker_disconnect | ] . Dumper \@_; });
+$client->on_event(q[tracker_read],
+ sub { l q[ tracker_read | ] . Dumper \@_; });
+$client->on_event(q[tracker_write],
+ sub { l q[ tracker_write | ] . Dumper \@_; });
+$client->on_event(q[tracker_success],
+ sub { l q[ tracker_success | ] . Dumper \@_; });
+$client->on_event(q[tracker_failure],
+ sub { l q[ tracker_failure | ] . Dumper \@_; });
+$client->on_event(
+ q[piece_hash_pass],
+ sub {
+ my ($self, $args) = @_;
+ l q[ piece_hash_pass | ] . $args->{q[Index]};
+ l $args->{q[Torrent]}->as_string(1);
+ }
+);
+$client->on_event(
+ q[piece_hash_fail],
+ sub {
+ my ($self, $args) = @_;
+ l q[ piece_hash_fail | ] . $args->{q[Index]};
+ l $args->{q[Torrent]}->as_string(1);
+ }
+);
+$client->on_event(q[file_open],
+ sub { l q[ file_open | ] . Dumper \@_; });
+$client->on_event(q[file_close],
+ sub { l q[ file_close | ] . Dumper \@_; });
+$client->on_event(q[file_read],
+ sub { l q[ file_read | ] . Dumper \@_; });
+$client->on_event(q[file_write],
+ sub { l q[ file_write | ] . Dumper \@_; });
+$client->on_event(q[file_error],
+ sub { l q[ file_error | ] . Dumper \@_; });
+
+sub packet_type {
+ my $t = shift;
+ return q[Handshake] if $t == -1;
+ return q[Keepalive] if $t == q[];
+ return q[Choke] if $t == 0;
+ return q[Unchoke] if $t == 1;
+ return q[Interested] if $t == 2;
+ return q[Not interested] if $t == 3;
+ return q[Have] if $t == 4;
+ return q[Bitfield] if $t == 5;
+ return q[Request] if $t == 6;
+ return q[Piece] if $t == 7;
+ return q[Cancel] if $t == 8;
+ return q[Port] if $t == 9;
+ return q[Suggest] if $t == 13;
+ return q[Have all] if $t == 14;
+ return q[Have none] if $t == 15;
+ return q[Reject] if $t == 16;
+ return q[Allowed fast set] if $t == 17;
+ return q[ExtProtocol] if $t == 20;
+ return q[Unknown];
+}
+$client->on_event(
+ q[incoming_packet],
+ sub {
+ my ($self, $args) = @_;
+ l sprintf
+ q[ incoming_packet | Type: %d (%s) | Payload: %s |
From: %s],
+ $args->{q[Type]}, packet_type($args->{q[Type]}),
+ (keys %{$args->{q[Payload]}}
+ ? Dumper($args->{q[Payload]})
+ : q[NA]
+ ),
+ $args->{q[Peer]}->as_string(1);
+ }
+);
+$client->on_event(
+ q[outgoing_packet],
+ sub {
+ my ($self, $args) = @_;
+ l sprintf
+ q[ outoming_packet | Type: %d (%s) | Payload: %s | To: %s],
+ $args->{q[Type]}, packet_type($args->{q[Type]}),
+ (keys %{$args->{q[Payload]}}
+ ? Dumper($args->{q[Payload]})
+ : q[NA]
+ ),
+ $args->{q[Peer]}->as_string(1);
+ }
+);
+
+# make sure everything's okay...
+l q[hashchecking...];
+$torrent->hashcheck;
+l q[forcing the torrent to start];
+$torrent->start;
+l $torrent->as_string(1);
+l q[starting event loop...];
+$client->do_one_loop(0.25) && sleep(0.50) while $torrent;
+
+=pod
+
+=head1 NAME
+
+/tatoeba/002-debug.pl - Logs EVERYTHING to a file for debugging
+
+=head1 Description
+
+This logs every bit of information useful in debugging and should not be
+used under normal circumstances. Logged data is stored in
+C<net-bittorrent.log>.
+
+=head1 Synopsis
+
+ 002-debug.pl some.torrent
+
+=head1 Author
+
+Sanko Robinson <sa...@cpan.org> - http://sankorobinson.com/
+
+CPAN ID: SANKO
+
+=head1 License and Legal
+
+Copyright (C) 2008 by Sanko Robinson E<lt>sa...@cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of The Artistic License 2.0. See the F<LICENSE>
+file included with this distribution or
+http://www.perlfoundation.org/artistic_license_2_0. For
+clarification, see http://www.perlfoundation.org/artistic_2_0_notes.
+
+When separated from the distribution, all POD documentation is covered
+by the Creative Commons Attribution-Share Alike 3.0 License. See
+http://creativecommons.org/licenses/by-sa/3.0/us/legalcode. For
+clarification, see http://creativecommons.org/licenses/by-sa/3.0/us/.
+
+Neither this module nor the L<Author|/Author> is affiliated with
+BitTorrent, Inc.
+
+=for svn $Id$
+
+=cut