File Coverage

lib/Egg/Plugin/HTTP/HeadParser.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Egg::Plugin::HTTP::HeadParser;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: HeadParser.pm 337 2008-05-14 12:30:09Z lushe $
6             #
7 1     1   2647 use strict;
  1         2  
  1         46  
8 1     1   6 use warnings;
  1         3  
  1         31  
9 1     1   17 use Egg::Response;
  0            
  0            
10              
11             our $VERSION = '3.00';
12              
13             my $cregix= qr{(?:$Egg::Response::CRLF|\r\n|\r|\n)};
14              
15             sub parse_http_header {
16             my $e = shift;
17             my $head= shift || return 0;
18             $head=~s{^$cregix+} [];
19             $head=~s{$cregix+$} [];
20             my %header;
21             for (split /$cregix/, $head) {
22             $_ || last;
23             if (my($name, $value)= m{^(.+?)\s*\:\s+(.+)}) {
24             $name=~s{\-} [_]g;
25             $header{lc($name)}= $value;
26             }
27             }
28             if ($head=~m{^(HTTP/[\d\.]+) +(\d+( +[^\r\n]+)?)[\r\n]+}) {
29             $header{status}= "$1 $2";
30             } elsif ($head=~m{^(GET|POST|HEAD|PUT|DELETE) +([^\:\r\n]+)[\r\n]+}) {
31             $header{method}= "$1 $2";
32             }
33             \%header;
34             }
35              
36             1;
37              
38             __END__
39              
40             =head1 NAME
41              
42             Egg::Plugin::HTTP::HeadParser - Analysis of request header and response header.
43              
44             =head1 SYNOPSIS
45              
46             use Egg qw/ HTTP::HeadParser /;
47            
48             $header= <<END_HEADER;
49             Content-Tyle: text/html
50             Content-Language: ja
51            
52             content ....
53             END_HEADER
54            
55             my $hash= $e->parse_http_header($header);
56              
57             =head1 METHODS
58              
59             =head2 parse_http_header ( [HEADER_TEXT] )
60              
61             HEADER_TEXT is analyzed and the result is returned by the HASH reference.
62              
63             GET of the request header and the header such as POST preserve the content in
64             'method' key.
65              
66             The header following the response header HTTP/\d + preserves the content in
67             'status' key.
68              
69             Other headers can be referred to with the key that makes all the names a small
70             letter.
71              
72             =head1 SEE ALSO
73              
74             L<Egg::Release>,
75              
76             =head1 AUTHOR
77              
78             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
79              
80             =head1 COPYRIGHT AND LICENSE
81              
82             Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>.
83              
84             This library is free software; you can redistribute it and/or modify
85             it under the same terms as Perl itself, either Perl version 5.8.6 or,
86             at your option, any later version of Perl 5 you may have available.
87              
88             =cut
89