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   492 use strict;
  1         2  
  1         34  
4 1     1   6 use warnings;
  1         2  
  1         48  
5              
6             package BencodeParser;
7 1     1   5 use base qw( Parser::MGC );
  1         1  
  1         605  
8              
9 1     1   7 use Feature::Compat::Try;
  1         2  
  1         9  
10              
11             # See also
12             # https://en.wikipedia.org/wiki/Bencode
13              
14             sub parse
15             {
16 11     11   13 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         85 );
26             }
27              
28             sub parse_int
29             {
30 11     11   12 my $self = shift;
31              
32 11         26 $self->expect( 'i' );
33 6         23 my $value = $self->expect( qr/-?\d+/ );
34 6         19 $self->expect( 'e' );
35              
36 6         39 return $value;
37             }
38              
39             sub parse_bytestring
40             {
41 5     5   7 my $self = shift;
42              
43 5         17 my $len = $self->expect( qr/\d+/ );
44 3         17 $self->expect( ':' );
45              
46 3         13 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   11 sub { $self->sequence_of( 'parse' ) },
56 2         15 'e'
57             );
58             }
59              
60             sub parse_dict
61             {
62 1     1   2 my $self = shift;
63              
64             my $kvlist = $self->committed_scope_of(
65             'd',
66 1     1   6 sub { $self->sequence_of( 'parse' ) },
67 1         6 'e'
68             );
69              
70 1         10 return { @$kvlist };
71             }
72              
73 1     1   1214 use Data::Dumper;
  1         7481  
  1         220  
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;