| 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; |