File Coverage

blib/lib/Net/BitTorrent/File.pm
Criterion Covered Total %
statement 94 94 100.0
branch 21 22 95.4
condition 1 3 33.3
subroutine 21 21 100.0
pod 14 14 100.0
total 151 154 98.0


line stmt bran cond sub pod time code
1              
2             package Net::BitTorrent::File;
3 3     3   80435 use strict;
  3         7  
  3         112  
4 3     3   16 use warnings;
  3         7  
  3         90  
5 3     3   2815 use Convert::Bencode qw(:all);
  3         17139  
  3         850  
6 3     3   2817 use Digest::SHA1 qw(sha1);
  3         3111  
  3         238  
7              
8             BEGIN {
9 3     3   19 use Exporter ();
  3         6  
  3         62  
10 3     3   14 use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  3         6  
  3         304  
11 3     3   7 $VERSION = 1.02;
12 3         43 @ISA = qw (Exporter);
13             #Give a hoot don't pollute, do not export more than needed by default
14 3         7 @EXPORT = qw ();
15 3         6 @EXPORT_OK = qw ();
16 3         2844 %EXPORT_TAGS = ();
17             }
18              
19             =head1 NAME
20              
21             Net::BitTorrent::File - Object for manipulating .torrent files
22              
23             =head1 SYNOPSIS
24              
25             use Net::BitTorrent::File
26              
27             # Empty N::BT::File object, ready to be filled with info
28             my $torrent = new Net::BitTorrent::File;
29              
30             # Or, create one from a existing .torrent file
31             my $fromfile = new Net::BitTorrent::File ('somefile.torrent');
32              
33             $torrent->name('Some_File_to_distribute.tar.gz');
34             $torrent->announce('http://address.of.tracker:6695');
35             # etc.
36              
37             print $torrent->name()."\n";
38             # would print "Some_File_to_distribute.tar.gz" in this case.
39              
40             =head1 DESCRIPTION
41              
42             This module handles loading and saveing of .torrent files as well as
43             providing a convenient way to store torrent file info in memory.
44             Most users of the module will most likely just call the new method
45             with the name of a existing torrent file and use the data from that.
46              
47             =head1 USAGE
48              
49             The same method is used for setting and retrieving a value, and the
50             methods have the same name as the key in the torrent file, such as C,
51             and C. If the method is called with no arguments or a undefined
52             value, then the current value is returned, otherwise its set to the value
53             passed in.
54              
55             There are two methods for generating info based on torrent data, but not
56             stored within the torrent itself. These are C and C.
57             You can use the methods C and C to return the calculated
58             values after calling there respective C methods.
59              
60             C returns the SHA1 hash of the info portion of the torrent which is
61             used in the bittorrent protocol.
62              
63             C returns a array ref of the pieces field of the torrent split
64             into the individual 20 byte SHA1 hashes. For further details on what exactly
65             these are used for, see the docs for the bittorrent protocol mentioned in
66             the SEE ALSO section.
67              
68             =head2 Methods
69              
70             =over 4
71              
72             =item * new( [$filename] )
73              
74             Creates a new Net::BitTorrent::File object, and if a filename is
75             supplied will call the load method with that filename.
76              
77             =item * load( $filename )
78              
79             Loads the file passed into it and generates the C and C
80             propertys.
81              
82             =item * save( $filename )
83              
84             Saves the torrent to I<$filename>. Note that C and C are
85             not saved to the torrent file and must be regenerated when the torrent is
86             loaded (but the C method does this for you anyway).
87              
88             =item * info_hash( [$new_value] )
89              
90             When called with no arguments returns the I value, otherwise it sets
91             it to the value in I<$new_value>. Note: Its very unlikely anyone will be using
92             to set the value of I, rather you should populate all the info
93             fields then call C to set this property.
94              
95             =item * gen_info_hash( )
96              
97             Calculates the SHA1 hash of the torrents I field and stores this in the
98             I property which can be retrieved using the C method.
99              
100             =item * pieces_array( [$new_array] )
101              
102             When called with no arguments returns a array ref whose values are the
103             SHA1 hashes contained in the I property. To set this value, do not use
104             this method, rather use the C method, after setting the
105             I property.
106              
107             =item * gen_pieces_array( )
108              
109             Divides the I property into its component 20 byte SHA1 hashes, and
110             stores them as a array ref in the I property.
111              
112             =item * name( [$value] )
113              
114             When called with no arguments returns the I propertys current value, else
115             it sets it to I<$value>. If this value is changed, the I property needs
116             to be regenerated.
117              
118             =item * announce( [$value] )
119              
120             When called with no arguments returns the I propertys current value, else
121             it sets it to I<$value>.
122              
123             =item * piece_length( [$value] )
124              
125             When called with no arguments returns the I propertys current value, else
126             it sets it to I<$value>. If this value is changed, the I property needs
127             to be regenerated.
128              
129             =item * length( [$value] )
130              
131             When called with no arguments returns the I propertys current value, else
132             it sets it to I<$value>. If this value is changed, the I property needs
133             to be regenerated.
134              
135             =item * pieces( [$value] )
136              
137             When called with no arguments returns the I propertys current value, else
138             it sets it to I<$value>. If this value is changed, the I and I
139             propertys need to be regenerated.
140              
141             =item * files( [$value] )
142              
143             When called with no arguments returns the I propertys current value, else
144             it sets it to I<$value>. I<$value> should be a array ref filled with hash refs
145             containing the keys I and I. If this value is changed, the I
146             property needs to be regenerated.
147              
148             =item * info( [$value] )
149              
150             When called with no arguments returns the I propertys current value, else
151             it sets it to I<$value>. I<$value> should be a hash ref containing the keys
152             I, I, I, I, and I. If this value is changed, the
153             I property needs to be regenerated.
154              
155             =back
156              
157             =head1 BUGS
158              
159             None that I know of yet.
160              
161             =head1 SUPPORT
162              
163             Any bugs/suggestions/problems, feel free to send me a e-mail, I'm usually
164             glad to help, and enjoy hearing from people using my code. My e-mail is
165             listed in the AUTHOR section.
166              
167             =head1 AUTHOR
168              
169             R. Kyle Murphy
170             orclev@rejectedmaterial.com
171              
172             =head1 COPYRIGHT
173              
174             This program is free software; you can redistribute
175             it and/or modify it under the same terms as Perl itself.
176              
177             The full text of the license can be found in the
178             LICENSE file included with this module.
179              
180              
181             =head1 SEE ALSO
182              
183             L, http://bitconjurer.org/BitTorrent/protocol.html
184              
185             =cut
186              
187             sub new
188             {
189 4     4 1 775 my ($class, $file) = @_;
190              
191 4   33     38 my $self = bless ({}, ref ($class) || $class);
192              
193 4 100       17 if(defined($file)) {
194 2         8 $self->load($file);
195             }
196              
197 4         15 return ($self);
198             }
199              
200             sub name {
201 2     2 1 809 my $self = shift;
202 2         4 my $name = shift;
203 2 100       10 if(defined($name)) {
204 1         10 $self->{'data'}->{'info'}->{'name'} = $name;
205             }
206 2         14 return $self->{'data'}->{'info'}->{'name'};
207             }
208              
209             sub announce {
210 2     2 1 5 my $self = shift;
211 2         4 my $announce = shift;
212 2 100       7 if(defined($announce)) {
213 1         4 $self->{'data'}->{'announce'} = $announce;
214             }
215 2         8 return $self->{'data'}->{'announce'};
216             }
217              
218             sub piece_length {
219 2     2 1 4 my $self = shift;
220 2         4 my $len = shift;
221 2 100       6 if(defined($len)) {
222 1         3 $self->{'data'}->{'info'}->{'piece_length'} = $len;
223             }
224 2         8 return $self->{'data'}->{'info'}->{'piece_length'};
225             }
226              
227             sub length {
228 2     2 1 3 my $self = shift;
229 2         5 my $len = shift;
230 2 100       9 if(defined($len)) {
231 1         4 $self->{'data'}->{'info'}->{'length'} = $len;
232             }
233 2         7 return $self->{'data'}->{'info'}->{'length'};
234             }
235              
236             sub pieces {
237 8     8 1 12 my $self = shift;
238 8         11 my $pieces = shift;
239 8 100       22 if(defined($pieces)) {
240 1         25 $self->{'data'}->{'info'}->{'pieces'} = $pieces;
241             }
242 8         41 return $self->{'data'}->{'info'}->{'pieces'};
243             }
244              
245             sub pieces_array {
246 6     6 1 21 my $self = shift;
247 6         29 my $array = shift;
248 6 100       29 if(defined($array)) {
249 3         186 $self->{'pieces_array'} = $array;
250             }
251 6         33 return $self->{'pieces_array'};
252             }
253              
254             sub gen_pieces_array {
255 3     3 1 6 my $self = shift;
256            
257 3 50       9 if(defined($self->pieces())) {
258 3         14 my @pieces = $self->pieces() =~ /.{20}/sg;
259 3         624 $self->pieces_array(\@pieces);
260             }
261             }
262              
263             sub files {
264 2     2 1 3 my $self = shift;
265 2         4 my $files = shift;
266 2 100       7 if(defined($files)) {
267 1         5 $self->{'data'}->{'info'}->{'files'} = $files;
268             }
269 2         7 return $self->{'data'}->{'info'}->{'files'};
270             }
271              
272             sub info {
273 7     7 1 1217 my $self = shift;
274 7         9 my $info = shift;
275 7 100       22 if(defined($info)) {
276 1         4 $self->{'data'}->{'info'} = $info;
277             }
278 7         37 return $self->{'data'}->{'info'};
279             }
280              
281             sub info_hash {
282 6     6 1 378 my $self = shift;
283 6         9 my $hash = shift;
284 6 100       18 if(defined($hash)) {
285 3         9 $self->{'info_hash'} = $hash;
286             }
287 6         22 return $self->{'info_hash'};
288             }
289              
290             sub gen_info_hash {
291 3     3 1 7 my ($self) = shift;
292 3         10 $self->info_hash(sha1(bencode($self->info())));
293             }
294              
295             sub load {
296 2     2 1 4 my ($self, $file) = @_;
297 2         3 my $buff = '';
298              
299 2         266 open(FILE, '< '.$file);
300 2         10 local $/;
301 2         60 $buff = ;
302 2         21 close(FILE);
303 2         10 my $root = bdecode($buff);
304 2         1303 $self->{'data'} = $root;
305 2         8 $self->gen_info_hash;
306 2         7 $self->gen_pieces_array;
307             }
308              
309             sub save {
310 1     1 1 2 my ($self, $file) = @_;
311              
312 1         5 my $data = bencode($self->{'data'});
313 1         254 open(FILE, '> '.$file);
314 1         8 print FILE $data;
315 1         61 close(FILE);
316             }
317              
318             1;
319             __END__