File Coverage

blib/lib/Protocol/BitTorrent.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Protocol::BitTorrent;
2             # ABSTRACT: abstract implementation of the bittorrent p2p protocol
3 4     4   98746 use strict;
  4         9  
  4         129  
4 4     4   21 use warnings;
  4         7  
  4         146  
5 4     4   3138 use parent qw(Protocol::BitTorrent::Bencode);
  4         1168  
  4         19  
6             use utf8;
7              
8             our $VERSION = '0.004';
9              
10             =head1 NAME
11              
12             Protocol::BitTorrent - protocol-level support for BitTorrent and .torrent files
13              
14             =head1 VERSION
15              
16             version 0.004
17              
18             =head1 SYNOPSIS
19              
20             package BitTorrent::Implementation;
21             use Protocol::BitTorrent;
22             ...
23              
24             =head1 DESCRIPTION
25              
26             This distribution provides handling for the BitTorrent protocol at an abstract
27             level. Although some utilities are provided for dealing with .torrent files,
28             the intention is for this class to act as a base for building BitTorrent
29             client/server/tracker implementations, rather than a complete independent package.
30             Specifically, no attempt is made to listen or connect to network sockets.
31              
32             See L for information on dealing with
33             .torrent files, and also check the C< examples/ > and C< bin/ > directories
34             for examples of code using these classes.
35              
36             An actual working client+tracker implementation can be found in
37             L.
38              
39             =cut
40              
41             use Protocol::BitTorrent::Metainfo;
42              
43             use Convert::Bencode_XS qw();
44             use Try::Tiny;
45              
46             =head1 METHODS
47              
48             =cut
49              
50             =head2 new
51              
52             =cut
53              
54             sub new { bless {}, shift }
55              
56             =head2 parse_metainfo
57              
58             Parse .torrent data and return a L instance.
59              
60             =cut
61              
62             sub parse_metainfo {
63             my $self = shift;
64             my $encoded = shift;
65              
66             my $decoded = try {
67             $self->bdecode($encoded);
68             } catch {
69             # Ensure we have a recognisable string at the start of the error message
70             die "Parse error: $_\n";
71             };
72             return Protocol::BitTorrent::Metainfo->new->parse_info($decoded);
73             }
74              
75             =head2 generate_metainfo
76              
77             Wrapper around L for creating new .torrent data.
78              
79             =cut
80              
81             sub generate_metainfo {
82             my $self = shift;
83             my %args = @_;
84             return Protocol::BitTorrent::Metainfo->new(%args);
85             }
86              
87             { # peer type mapping
88             my %azureus_peer_types = (
89             'AG' => 'Ares',
90             'A~' => 'Ares',
91             'AR' => 'Arctic',
92             'AT' => 'Artemis',
93             'AX' => 'BitPump',
94             'AZ' => 'Azureus',
95             'BB' => 'BitBuddy',
96             'BC' => 'BitComet',
97             'BF' => 'Bitflu',
98             'BG' => 'BTG',
99             'BL' => 'BitBlinder',
100             'BP' => 'BitTorrent Pro',
101             'BR' => 'BitRocket',
102             'BS' => 'BTSlave',
103             'BW' => 'BitWombat',
104             'BX' => '~Bittorrent X',
105             'CD' => 'Enhanced CTorrent',
106             'CT' => 'CTorrent',
107             'DE' => 'DelugeTorrent',
108             'DP' => 'Propagate Data Client',
109             'EB' => 'EBit',
110             'ES' => 'electric sheep',
111             'FC' => 'FileCroc',
112             'FT' => 'FoxTorrent',
113             'GS' => 'GSTorrent',
114             'HK' => 'Hekate',
115             'HL' => 'Halite',
116             'HM' => 'hMule',
117             'HN' => 'Hydranode',
118             'KG' => 'KGet',
119             'KT' => 'KTorrent',
120             'LC' => 'LeechCraft',
121             'LH' => 'LH-ABC',
122             'LP' => 'Lphant',
123             'LT' => 'libtorrent',
124             'lt' => 'libTorrent',
125             'LW' => 'LimeWire',
126             'MK' => 'Meerkat',
127             'MO' => 'MonoTorrent',
128             'MP' => 'MooPolice',
129             'MR' => 'Miro',
130             'MT' => 'MoonlightTorrent',
131             'NX' => 'Net Transport',
132             'OS' => 'OneSwarm',
133             'OT' => 'OmegaTorrent',
134             'PD' => 'Pando',
135             'PT' => 'PHPTracker',
136             'qB' => 'qBittorrent',
137             'QD' => 'QQDownload',
138             'QT' => 'Qt 4 Torrent example',
139             'RT' => 'Retriever',
140             'RZ' => 'RezTorrent',
141             'S~' => 'Shareaza alpha/beta',
142             'SB' => '~Swiftbit',
143             'SD' => 'Thunder (aka XunLei)',
144             'SM' => 'SoMud',
145             'SS' => 'SwarmScope',
146             'ST' => 'SymTorrent',
147             'st' => 'sharktorrent',
148             'SZ' => 'Shareaza',
149             'TN' => 'TorrentDotNET',
150             'TR' => 'Transmission',
151             'TS' => 'Torrentstorm',
152             'TT' => 'TuoTu',
153             'UL' => 'uLeecher!',
154             'UM' => 'µTorrent for Mac',
155             'UT' => 'µTorrent',
156             'VG' => 'Vagaa',
157             'WT' => 'BitLet',
158             'WY' => 'FireTorrent',
159             'XL' => 'Xunlei',
160             'XS' => 'XSwifter',
161             'XT' => 'XanTorrent',
162             'XX' => 'Xtorrent',
163             'ZT' => 'ZipTorrent',
164             );
165              
166             =head2 peer_type_from_id
167              
168             Returns the client type for a given peer_id.
169              
170             =cut
171              
172             sub peer_type_from_id {
173             my $self = shift;
174             my $peer_id = shift;
175              
176             # Handle us first
177             return "Protocol::BitTorrent v$1.$2" if $peer_id =~ /^-PB(\d)(\d{3})-/;
178              
179             # Azureus-style clients
180             if($peer_id =~ /^-(..)(....)-/) {
181             my $type = $azureus_peer_types{$1} || 'Unknown';
182             my $v = join '.', map hex, split //, $2;
183             return "$type v$v";
184             }
185             return 'unknown';
186             }
187             }
188              
189             1;
190              
191             __END__