| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package TSVRPC::Parser; | 
| 2 | 7 |  |  | 7 |  | 17008 | use strict; | 
|  | 7 |  |  |  |  | 7 |  | 
|  | 7 |  |  |  |  | 215 |  | 
| 3 | 7 |  |  | 7 |  | 29 | use warnings; | 
|  | 7 |  |  |  |  | 11 |  | 
|  | 7 |  |  |  |  | 148 |  | 
| 4 | 7 |  |  | 7 |  | 24 | use base qw/Exporter/; | 
|  | 7 |  |  |  |  | 7 |  | 
|  | 7 |  |  |  |  | 627 |  | 
| 5 | 7 |  |  | 7 |  | 3198 | use URI::Escape qw/uri_escape uri_unescape/; | 
|  | 7 |  |  |  |  | 7431 |  | 
|  | 7 |  |  |  |  | 454 |  | 
| 6 | 7 |  |  | 7 |  | 3291 | use MIME::QuotedPrint qw/encode_qp decode_qp/; | 
|  | 7 |  |  |  |  | 9084 |  | 
|  | 7 |  |  |  |  | 369 |  | 
| 7 | 7 |  |  | 7 |  | 35 | use MIME::Base64 qw/encode_base64 decode_base64/; | 
|  | 7 |  |  |  |  | 8 |  | 
|  | 7 |  |  |  |  | 2409 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | our @EXPORT = qw/encode_tsvrpc decode_tsvrpc/; | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | my %ENCODERS = ( | 
| 12 |  |  |  |  |  |  | 'U' => \&uri_escape, | 
| 13 |  |  |  |  |  |  | 'Q' => sub { encode_qp($_[0], '') }, | 
| 14 |  |  |  |  |  |  | 'B' => sub { encode_base64($_[0], '') }, | 
| 15 |  |  |  |  |  |  | ); | 
| 16 |  |  |  |  |  |  | my %DECODERS = ( | 
| 17 |  |  |  |  |  |  | 'U' => \&uri_unescape, | 
| 18 |  |  |  |  |  |  | 'Q' => sub { decode_qp($_[0]) }, | 
| 19 |  |  |  |  |  |  | 'B' => sub { decode_base64($_[0]) }, | 
| 20 |  |  |  |  |  |  | ); | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | sub encode_tsvrpc { | 
| 23 | 5 |  |  | 5 | 1 | 590 | my ($data, $encoding) = @_; | 
| 24 | 5 | 100 |  | 2 |  | 15 | my $encoder = $encoding ? $ENCODERS{$encoding} : sub { $_[0] }; | 
|  | 2 |  |  |  |  | 6 |  | 
| 25 | 5 |  |  |  |  | 6 | my @res; | 
| 26 | 5 |  |  |  |  | 21 | while (my ($k, $v) = each %$data){ | 
| 27 | 6 |  |  |  |  | 15 | push @res, (scalar($encoder->($k)) . "\t" . scalar($encoder->($v))); | 
| 28 |  |  |  |  |  |  | } | 
| 29 | 5 |  |  |  |  | 64 | return join "\n", @res; | 
| 30 |  |  |  |  |  |  | } | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | sub decode_tsvrpc { | 
| 33 | 4 |  |  | 4 | 1 | 725 | my ($data, $encoding) = @_; | 
| 34 | 4 | 100 |  | 2 |  | 11 | my $decoder = $encoding ? $DECODERS{$encoding} : sub { $_[0] }; | 
|  | 2 |  |  |  |  | 3 |  | 
| 35 | 4 |  |  |  |  | 2 | my %res; | 
| 36 | 4 |  |  |  |  | 13 | for my $line (split "\n", $data) { | 
| 37 | 4 |  |  |  |  | 7 | my ($k, $v) = map { scalar $decoder->($_) } split("\t", $line); | 
|  | 8 |  |  |  |  | 23 |  | 
| 38 | 4 |  |  |  |  | 25 | $res{$k} = $v; | 
| 39 |  |  |  |  |  |  | } | 
| 40 | 4 | 50 |  |  |  | 22 | return wantarray ? %res : \%res; | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | 1; | 
| 44 |  |  |  |  |  |  | __END__ |