File Coverage

blib/lib/Metabrik/String/Http.pm
Criterion Covered Total %
statement 9 43 20.9
branch 0 8 0.0
condition n/a
subroutine 3 6 50.0
pod 1 3 33.3
total 13 60 21.6


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # string::http Brik
5             #
6             package Metabrik::String::Http;
7 1     1   838 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         26  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         547  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             },
20             attributes_default => {
21             },
22             commands => {
23             decode => [ qw(string) ],
24             encode => [ qw(hash) ],
25             },
26             require_modules => {
27             'HTTP::Headers' => [ ],
28             'HTTP::Request' => [ ],
29             'HTTP::Response' => [ ],
30             },
31             };
32             }
33              
34             sub encode {
35 0     0 0   my $self = shift;
36 0           my ($hash) = @_;
37              
38 0 0         $self->brik_help_run_undef_arg('encode', $hash) or return;
39              
40 0           my $protocol = $hash->{protocol};
41 0           my $headers = HTTP::Headers->new(%{$hash->{headers}})->as_string;
  0            
42 0           my $content = $hash->{content};
43              
44 0           my @lines = ();
45              
46             # Probably a response
47 0 0         if (exists($hash->{code})) {
48 0           my $code = $hash->{code};
49 0           my $message = $hash->{message};
50              
51 0           @lines = ( "$protocol $code $message" );
52             }
53             # Probably a request
54             else {
55 0           my $method = $hash->{method};
56 0           my $uri = $hash->{uri};
57              
58 0           @lines = ( "$method $uri $protocol" );
59             }
60              
61 0           push @lines, $headers;
62 0           push @lines, $content;
63              
64 0           return join("\n", @lines);
65             }
66              
67             sub decode {
68 0     0 0   my $self = shift;
69 0           my ($string) = @_;
70              
71 0 0         $self->brik_help_run_undef_arg('decode', $string) or return;
72              
73 0           my $r;
74             my $h;
75             # Probably a response
76 0 0         if ($string =~ m{^HTTP/}) {
77 0           $r = HTTP::Response->parse($string);
78 0           $h = {
79             code => $r->code,
80             message => $r->message,
81             };
82             }
83             # Probably a request
84             else {
85 0           $r = HTTP::Request->parse($string);
86 0           $h = {
87             method => $r->method,
88             uri => $r->uri->as_string,
89             };
90             }
91              
92 0           my @list = $r->headers->flatten;
93              
94 0           $h->{headers} = { @list };
95 0           $h->{protocol} = $r->protocol;
96 0           $h->{content} = $r->content;
97 0           $h->{decoded_content} = $r->decoded_content;
98              
99 0           return $h;
100             }
101              
102             1;
103              
104             __END__