Permalink
Browse files

Add tests for BEP 07

  • Loading branch information...
1 parent 2d2d26a commit 2e6d4e545957b0ca3c855d27eca74c4905a1af8d @sanko committed Dec 29, 2011
Showing with 47 additions and 13 deletions.
  1. +1 −0 Changes
  2. +1 −0 MANIFEST
  3. +11 −13 lib/Net/BitTorrent/Protocol/BEP07.pm
  4. +34 −0 t/0007_net_bittorrent_protocol_bep07.t
View
@@ -6,6 +6,7 @@ Version 1.0.0 | Soon | xxxxxxxxxx
Documentation/Sample Code/Test Suite:
* Example script is now a standalone module: AnyEvent::BitTorrent
* BEP06 functions are now documented
+ * BEP07 functions now have tests
Version 0.9.1 | The wee hours of December 19th, 2011 | 5506598358
View
@@ -16,5 +16,6 @@ t/0000_net_bittorrent_protocol.t
t/0003_net_bittorrent_protocol_bep03.t
t/0003_net_bittorrent_protocol_bep03_bencode.t
t/0006_net_bittorrent_protocol_bep06.t
+t/0007_net_bittorrent_protocol_bep07.t
t/0010_net_bittorrent_protocol_bep10.t
TODO
@@ -2,28 +2,28 @@ package Net::BitTorrent::Protocol::BEP07;
use strict;
use warnings;
use Carp qw[carp];
-our $MAJOR = 0; our $MINOR = 9; our $PATCH = 0; our $DEV = 'rc5'; our $VERSION = sprintf('%0d.%0d.%0d' . ($DEV =~ m[S] ? '-%s' : ''), $MAJOR, $MINOR, $PATCH, $DEV);
+our $MAJOR = 1; our $MINOR = 0; our $PATCH = 0; our $DEV = 'rc5'; our $VERSION = sprintf('%0d.%0d.%0d' . ($DEV =~ m[S] ? '-%s' : ''), $MAJOR, $MINOR, $PATCH, $DEV);
use vars qw[@EXPORT_OK %EXPORT_TAGS];
use Exporter qw[];
*import = *import = *Exporter::import;
@EXPORT_OK = qw[compact_ipv6 uncompact_ipv6];
%EXPORT_TAGS = (all => [@EXPORT_OK], bencode => [@EXPORT_OK]);
sub uncompact_ipv6 {
- my %peers;
- $peers{sprintf("%X:%X:%X:%X:%X:%X:%X:%X:%s", unpack('n9', $1))}++
- while ($_[0] =~ s[^(.{18})][]g);
- return keys %peers;
+ return $_[0] ?
+ map {
+ my (@h) = unpack 'n*', $_;
+ [sprintf('%X:%X:%X:%X:%X:%X:%X:%X', @h), $h[-1]]
+ } $_[0] =~ m[(.{20})]g
+ : ();
}
sub compact_ipv6 {
- my (@peers) = @_;
- @peers || return;
my $return;
my %seen;
-PEER: for my $peer (grep(defined && !$seen{$_}++, @peers)) {
- next if not $peer;
- my ($ip, $port) = ($peer =~ m[^([\da-f:]+):(\d+)$]i);
+PEER: for my $peer (grep(defined && !$seen{$_}++, @_)) {
+ my ($ip, $port) = @$peer;
+ $ip // next;
if ($port > 2**16) {
carp 'Port number beyond ephemeral range: ' . $peer;
}
@@ -49,9 +49,7 @@ PEER: for my $peer (grep(defined && !$seen{$_}++, @peers)) {
}
$ip =~ s/::/:::/ while $c++ < 7; # expand compressed fields
$ip .= 0 if $ip =~ /:$/;
- my @hex = split(/:/, $ip);
- $hex[$_] = hex($hex[$_] || 0) foreach (0 .. $#hex);
- $return .= uc pack('n9', @hex, $port);
+ $return .= pack('H36', join '', split /:/, $ip) . pack 'n', $port;
}
}
return $return;
@@ -0,0 +1,34 @@
+use Test::More;
+use lib './lib', '../lib';
+$|++;
+
+# Does it return 1?
+use_ok 'Net::BitTorrent::Protocol::BEP07', ':all';
+
+#
+is compact_ipv6(['2001:0db8:85a3:0000:0000:8a2e:0370:7334', 2223]),
+ pack('H*', '20010db885a3000000008a2e03707334000008af'),
+ 'compact_ipv6( ... )';
+
+#
+is_deeply uncompact_ipv6(
+ pack('H*', '20010db885a3000000008a2e03707334000008af')
+ ),
+ ['2001:DB8:85A3:0:0:8A2E:370:7334', 2223],
+ 'uncompact_ipv6( ... )';
+
+# We're finished!
+done_testing;
+__END__
+Copyright (C) 2008-2012 by Sanko Robinson <sanko@cpan.org>
+
+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
+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/.

0 comments on commit 2e6d4e5

Please sign in to comment.