Permalink
Browse files

Incomplete client example

  • Loading branch information...
1 parent 1464cae commit 89ea9c635b1ac590dbbaa57c2a78990017f3d2a4 @sanko committed Feb 1, 2011
Showing with 143 additions and 0 deletions.
  1. +1 −0 MANIFEST
  2. +142 −0 examples/client.pl
View
@@ -1,5 +1,6 @@
Build.PL
Changes
+examples/client.pl
examples/generate_torrent.pl
examples/standalone_dht.pl
examples/swarm_statistics.pl
View
@@ -0,0 +1,142 @@
+use strict;
+use warnings;
+use autodie;
+
+# Track every object including where they're created
+#use Devel::Leak::Object qw{ GLOBAL_bless };
+#$Devel::Leak::Object::TRACKSOURCELINES = 1;
+
+#
+use AnyEvent::Impl::Perl;
+use Data::Dump;
+use lib '../lib';
+use Net::BitTorrent;
+$|++;
+our $MAJOR = 0; our $MINOR = 74; our $DEV = 13; our $VERSION = sprintf('%0d.%03d' . ($DEV ? (($DEV < 0 ? '' : '_') . '%03d') : ('')), $MAJOR, $MINOR, abs $DEV);
+my $x = 0;
+
+#
+my $cli;
+$cli = Net::BitTorrent->new(
+ port => 1138,
+ on_peer_id => sub {
+ my ($s, $a) = @_;
+ warn $a->{'message'};
+ },
+ on_peer_packet => sub {
+ my ($s, $a) = @_;
+ warn $a->{'message'};
+ },
+ on_peer_connect => sub {
+ my ($s, $a) = @_;
+ warn 'Connect: ' . $a->{'message'};
+ },
+ on_peer_disconnect => sub {
+ my ($s, $a) = @_;
+ #
+ warn 'Disconnect: ' . $a->{'message'};
+ },
+ on_peer_packet_in => sub {
+ my ($s, $a) = @_;
+ # warn $a->{'message'}; # ddx $a->{'packet'};
+ },
+ on_peer_packet_out => sub { ...; },
+ on_piece_hash_pass => sub {
+ my ($s, $i) = @_;
+ warn sprintf '+ We now have piece %-3d', $i;
+ #exit if $s->torrent(0)->seed;
+
+ $cli->send if $s->torrent(0)->seed;
+ },
+ on_piece_hash_fail => sub {
+ my ($s, $i) = @_;
+ warn sprintf '- We do not have piece %-3d', $i;
+ },
+ on_peer_bitfield => sub {
+ my ($s, $a) = @_;
+ warn 'Bitfield packet: ' . $a->{'message'};
+ $x++;
+ }
+);
+
+#
+my $t = $cli->add_torrent(
+ path => 'Jazz_and_Beatles_(2010)..5907000.TPB.torrent');
+$t->hash_check;
+
+#
+require AnyEvent::Handle::Throttle;
+AnyEvent::Handle::Throttle->global_upload_limit(1024 * 5);
+
+#
+$cli->recv;
+__END__
+# Standalone node with user-defined port and boot_nodes
+my $dht = Net::BitTorrent::DHT->new(
+ port => [1337 .. 1340, 0],
+ boot_nodes =>
+ [['router.bittorrent.com', 6881], ['router.utorrent.com', 6881]]
+);
+
+# Two 'quests' for peers (these are two popular Ubuntu swarms)
+my $quest_A
+ = $dht->get_peers('3e16157f0879eb43e9e51f45d485feff90a77283', \&dht_cb);
+my $quest_B
+ = $dht->get_peers('a1425e0d6630336cdd9fb320f3fff1030098975a', \&dht_cb);
+
+# Let's stay up to date with what's going on in the routing table
+my $timer = AE::timer 60 * 2, 60 * 5,
+ sub { $dht->dump_ipv4_buckets; $dht->dump_ipv6_buckets };
+END { $dht->dump_ipv4_buckets && $dht->dump_ipv6_buckets if $dht }
+
+# tick, tick, tick, ...
+AnyEvent->condvar->recv;
+
+sub dht_cb {
+ my ($infohash, $node, $peers) = @_;
+ say sprintf 'We found %d peers for %s from %s:%d via DHT',
+ scalar(@$peers),
+ $infohash->to_Hex, $node->host, $node->port;
+ say join ', ', map { sprintf '%s:%d', @$_ } @$peers;
+}
+
+=pod
+
+=head1 NAME
+
+standalone_dht - Quick/dirty demo of a standalone DHT node
+
+=head1 Description
+
+This is just perfect for research. I'll breakdown what's going on in a later
+version
+
+=head1 Author
+
+Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/
+
+CPAN ID: SANKO
+
+=head1 License and Legal
+
+Copyright (C) 2008-2010 by Sanko Robinson <sanko@cpan.org>
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of
+L<The Artistic License 2.0|http://www.perlfoundation.org/artistic_license_2_0>.
+See the F<LICENSE> file included with this distribution or
+L<notes on the Artistic License 2.0|http://www.perlfoundation.org/artistic_2_0_notes>
+for clarification.
+
+When separated from the distribution, all original POD documentation is
+covered by the
+L<Creative Commons Attribution-Share Alike 3.0 License|http://creativecommons.org/licenses/by-sa/3.0/us/legalcode>.
+See the
+L<clarification of the CCA-SA3.0|http://creativecommons.org/licenses/by-sa/3.0/us/>.
+
+Neither this module nor the L<Author|/Author> is affiliated with BitTorrent,
+Inc.
+
+=for rcs $Id$
+
+=cut

0 comments on commit 89ea9c6

Please sign in to comment.