File Coverage

blib/lib/Metabrik/Network/Http.pm
Criterion Covered Total %
statement 9 28 32.1
branch 0 14 0.0
condition 0 5 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 54 24.0


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::http Brik
5             #
6             package Metabrik::Network::Http;
7 1     1   736 use strict;
  1         2  
  1         32  
8 1     1   5 use warnings;
  1         1  
  1         27  
9              
10 1     1   5 use base qw(Metabrik::Client::Tcp);
  1         2  
  1         571  
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             host_header => [ qw(host_header) ],
20             },
21             commands => {
22             probe => [ qw(host port|OPTIONAL) ],
23             },
24             require_modules => {
25             'Metabrik::String::Parse' => [ ],
26             },
27             };
28             }
29              
30             sub probe {
31 0     0 0   my $self = shift;
32 0           my ($host, $port) = @_;
33              
34 0   0       $host ||= $self->host;
35 0   0       $port ||= 80;
36 0 0         $self->brik_help_run_undef_arg('probe', $host) or return;
37              
38 0           my $probe = "GET / HTTP/1.0\r\n\r\n";
39 0 0         if ($self->host_header) {
40 0           $probe = "GET / HTTP/1.1\r\nHost: ".$self->host_header."\r\n\r\n";
41             }
42              
43 0           $self->host($host);
44 0           $self->port($port);
45 0 0         $self->connect or return;
46 0 0         $self->write($probe) or return;
47 0 0         my $response = $self->read or return;
48 0           $self->disconnect;
49              
50 0 0         if (length($response)) {
51 0 0         my $sp = Metabrik::String::Parse->new_from_brik_init($self) or return;
52 0           return $sp->to_array($response);
53             }
54              
55 0           return $response;
56             }
57              
58             1;
59              
60             __END__