File.pm 8.1 KB

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