File Coverage

examples/parse-bencode.pl
Criterion Covered Total %
statement 33 35 94.2
branch n/a
condition n/a
subroutine 12 13 92.3
pod n/a
total 45 48 93.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3 1     1   375 use strict;
  1         2  
  1         25  
4 1     1   4 use warnings;
  1         2  
  1         30  
5              
6             package BencodeParser;
7 1     1   4 use base qw( Parser::MGC );
  1         2  
  1         464  
8              
9 1     1   5 use Feature::Compat::Try;
  1         1  
  1         4  
10              
11             # See also
12             # https://en.wikipedia.org/wiki/Bencode
13              
14             sub parse
15             {
16 11     11   12 my $self = shift;
17              
18             $self->any_of(
19             'parse_int',
20             'parse_bytestring',
21             'parse_list',
22             'parse_dict',
23              
24 0     0   0 sub { $self->commit; $self->fail( "Expected int, bytestring, list or dict" ) },
  0         0  
25 11         40 );
26             }
27              
28             sub parse_int
29             {
30 11     11   11 my $self = shift;
31              
32 11         20 $self->expect( 'i' );
33 6         16 my $value = $self->expect( qr/-?\d+/ );
34 6         15 $self->expect( 'e' );
35              
36 6         30 return $value;
37             }
38              
39             sub parse_bytestring
40             {
41 5     5   6 my $self = shift;
42              
43 5         12 my $len = $self->expect( qr/\d+/ );
44 3         9 $self->expect( ':' );
45              
46 3         9 return $self->take( $len );
47             }
48              
49             sub parse_list
50             {
51 2     2   3 my $self = shift;
52              
53             $self->committed_scope_of(
54             'l',
55 1     1   4 sub { $self->sequence_of( 'parse' ) },
56 2         8 'e'
57             );
58             }
59              
60             sub parse_dict
61             {
62 1     1   1 my $self = shift;
63              
64             my $kvlist = $self->committed_scope_of(
65             'd',
66 1     1   3 sub { $self->sequence_of( 'parse' ) },
67 1         3 'e'
68             );
69              
70 1         6 return { @$kvlist };
71             }
72              
73 1     1   831 use Data::Dumper;
  1         5767  
  1         143  
74              
75             if( !caller ) {
76             my $parser = __PACKAGE__->new;
77              
78             while( defined( my $line = ) ) {
79             try {
80             my $ret = $parser->from_string( $line );
81             print Dumper( $ret );
82             }
83             catch ( $e ) {
84             print $e;
85             }
86             }
87             }
88              
89             1;