File Coverage

blib/lib/Net/BitTorrent/Protocol/BEP03/Bencode.pm
Criterion Covered Total %
statement 45 45 100.0
branch 32 34 94.1
condition 15 16 93.7
subroutine 6 6 100.0
pod 2 2 100.0
total 100 103 97.0


line stmt bran cond sub pod time code
1             package Net::BitTorrent::Protocol::BEP03::Bencode;
2 3     3   712 use strict;
  3         4  
  3         84  
3 3     3   11 use warnings;
  3         4  
  3         145  
4             our $VERSION = "1.5.2";
5 3     3   10 use vars qw[@EXPORT_OK %EXPORT_TAGS];
  3         3  
  3         140  
6 3     3   10 use Exporter qw[];
  3         3  
  3         1489  
7             *import = *import = *Exporter::import;
8             @EXPORT_OK = qw[bencode bdecode];
9             %EXPORT_TAGS = (all => [@EXPORT_OK], bencode => [@EXPORT_OK]);
10              
11             sub bencode {
12 98   100 98 1 3664 my $ref = shift // return;
13 97 100 100     595 return (((length $ref) && $ref =~ m[^([-\+][1-9])?\d*$]) ?
    100          
14             ('i' . $ref . 'e')
15             : (length($ref) . ':' . $ref)
16             ) if !ref $ref;
17 30 100       55 return join('', 'l', (map { bencode($_) } @{$ref}), 'e')
  30         36  
  11         33  
18             if ref $ref eq 'ARRAY';
19             return
20             join('', 'd',
21 33         74 (map { length($_) . ':' . $_ . bencode($ref->{$_}) }
22 19 100       40 sort keys %{$ref}
  17         75  
23             ),
24             'e'
25             ) if ref $ref eq 'HASH';
26 2         7 return '';
27             }
28              
29             sub bdecode {
30 104   50 104 1 180 my $string = shift // return;
31 104         74 my ($return, $leftover);
32 104 100       438 if ($string =~ s[^(0+|[1-9]\d*):][]) {
    100          
    100          
    100          
33 54         61 my $size = $1;
34 54 100       85 $return = '' if $size =~ m[^0+$];
35 54         88 $return .= substr($string, 0, $size, '');
36 54 100       76 return if length $return < $size;
37 53 100       155 return $_[0] ? ($return, $string) : $return; # byte string
38             }
39             elsif ($string =~ s[^i([-\+]?\d+)e][]) { # integer
40 20         38 my $int = $1;
41 20 100 100     76 $int = () if $int =~ m[^-0] || $int =~ m[^0\d+];
42 20 100       65 return $_[0] ? ($int, $string) : $int;
43             }
44             elsif ($string =~ s[^l(.*)][]s) { # list
45 6         11 $leftover = $1;
46 6   100     22 while ($leftover and $leftover !~ s[^e][]s) {
47 12         16 (my ($piece), $leftover) = bdecode($leftover, 1);
48 12         47 push @$return, $piece;
49             }
50 6 100       25 return $_[0] ? (\@$return, $leftover) : \@$return;
51             }
52             elsif ($string =~ s[^d(.*)][]s) { # dictionary
53 13         27 $leftover = $1;
54 13   100     62 while ($leftover and $leftover !~ s[^e][]s) {
55 27         18 my ($key, $value);
56 27         52 ($key, $leftover) = bdecode($leftover, 1);
57 27 50       56 ($value, $leftover) = bdecode($leftover, 1) if $leftover;
58 27 50       146 $return->{$key} = $value if defined $key;
59             }
60 13 100       81 return $_[0] ? (\%$return, $leftover) : \%$return;
61             }
62 11         33 return;
63             }
64             1;
65              
66             =pod
67              
68             =head1 NAME
69              
70             Net::BitTorrent::Protocol::BEP03::Bencode - Utility functions for BEP03: The BitTorrent Protocol Specification
71              
72             =head1 Importing From Net::BitTorrent::Protocol::BEP03::Bencode
73              
74             By default, nothing is exported.
75              
76             You may import any of the following functions by name or with one or more of
77             these tags:
78              
79             =over
80              
81             =item C<:all>
82              
83             You get the two Bencode-related functions: L
84             and L. For more on Bencoding, see the
85             BitTorrent Protocol documentation.
86              
87             =back
88              
89             =head1 Functions
90              
91             =over
92              
93             =item C
94              
95             Expects a single value (basic scalar, array reference, or hash reference) and
96             returns a single string.
97              
98             Bencoding is the BitTorrent protocol's basic serialization and data
99             organization format. The specification supports integers, lists (arrays),
100             dictionaries (hashes), and byte strings.
101              
102             =item C
103              
104             Expects a bencoded string. The return value depends on the type of data
105             contained in the string.
106              
107             =back
108              
109             =head1 See Also
110              
111             =over
112              
113             =item The BitTorrent Protocol Specification
114              
115             http://bittorrent.org/beps/bep_0003.html#the-connectivity-is-as-follows
116              
117             =item Other Bencode related modules:
118              
119             =over
120              
121             =item L
122              
123             =item L
124              
125             =item L
126              
127             =back
128              
129             =back
130              
131             =head1 Author
132              
133             Sanko Robinson - http://sankorobinson.com/
134              
135             CPAN ID: SANKO
136              
137             =head1 License and Legal
138              
139             Copyright (C) 2008-2010 by Sanko Robinson
140              
141             This program is free software; you can redistribute it and/or modify it under
142             the terms of
143             L.
144             See the F file included with this distribution or
145             L
146             for clarification.
147              
148             When separated from the distribution, all original POD documentation is
149             covered by the
150             L.
151             See the
152             L.
153              
154             Neither this module nor the L is affiliated with BitTorrent,
155             Inc.
156              
157             =for rcs $Id: Bencode.pm a7f61f8 2010-06-27 02:13:37Z sanko@cpan.org $
158              
159             =cut