File Coverage

blib/lib/Protocol/BitTorrent/Message/Piece.pm
Criterion Covered Total %
statement 23 25 92.0
branch n/a
condition n/a
subroutine 10 11 90.9
pod 3 8 37.5
total 36 44 81.8


line stmt bran cond sub pod time code
1             package Protocol::BitTorrent::Message::Piece;
2             {
3             $Protocol::BitTorrent::Message::Piece::VERSION = '0.004';
4             }
5 1     1   5 use strict;
  1         2  
  1         37  
6 1     1   5 use warnings FATAL => 'all', NONFATAL => 'redefine';
  1         2  
  1         38  
7 1     1   6 use parent qw(Protocol::BitTorrent::Message);
  1         1  
  1         5  
8              
9             =head1 NAME
10              
11             Protocol::BitTorrent::Message::Piece - contains partial piece data
12              
13             =head1 VERSION
14              
15             version 0.004
16              
17             =cut
18              
19             =head1 METHODS
20              
21             =cut
22              
23             =head2 new
24              
25             =cut
26              
27             sub new_from_data {
28 1     1 0 3 my $class = shift;
29 1         3 my $data = shift;
30 1         4 my ($index, $begin, $block) = unpack 'N1N1a*', $data;
31 1         5 $class->new(
32             piece_index => $index,
33             offset => $begin,
34             block => $block,
35             );
36             }
37              
38             sub new {
39 1     1 1 2 my $class = shift;
40 1         5 my %args = @_;
41 1         6 my $self = bless {
42             piece_index => $args{piece_index},
43             offset => $args{offset},
44             block => $args{block},
45             }, $class;
46 1         6 $self;
47             }
48              
49 2     2 1 14 sub type { 'piece' }
50              
51 1     1 0 3 sub piece_index { shift->{piece_index} }
52 1     1 0 4 sub offset { shift->{offset} }
53 1     1 0 9 sub block { shift->{block} }
54              
55             =head2 as_string
56              
57             Returns a stringified version of this message.
58              
59             =cut
60              
61             sub as_string {
62 1     1 1 2 my $self = shift;
63 1         4 return sprintf '%s, %d bytes, index = %d, begin = %d, length = %d', $self->type, $self->packet_length, $self->piece_index, $self->offset, length($self->block);
64             }
65              
66             sub as_data {
67 0     0 0   my $self = shift;
68 0           return pack 'N1C1N1N1a*', 9 + length($self->block), $self->type_id, $self->piece_index, $self->offset, $self->block;
69             }
70              
71             1;
72              
73             __END__