File Coverage

blib/lib/HTTP/GHTTP.pm
Criterion Covered Total %
statement 17 32 53.1
branch 1 6 16.6
condition 0 2 0.0
subroutine 5 7 71.4
pod 3 3 100.0
total 26 50 52.0


line stmt bran cond sub pod time code
1             package HTTP::GHTTP;
2              
3 1     1   3923 use strict;
  1         1  
  1         24  
4 1     1   3 use warnings;
  1         0  
  1         18  
5 1     1   3 use XSLoader ();
  1         0  
  1         17  
6 1     1   2 use base qw(Exporter);
  1         2  
  1         300  
7              
8             our $VERSION = '1.080_003';
9             our $XS_VERSION = $VERSION;
10             $VERSION = eval $VERSION;
11              
12             XSLoader::load('HTTP::GHTTP', $XS_VERSION);
13              
14             our @EXPORT_OK = qw(
15             get
16             METHOD_GET
17             METHOD_POST
18             METHOD_OPTIONS
19             METHOD_HEAD
20             METHOD_PUT
21             METHOD_DELETE
22             METHOD_TRACE
23             METHOD_CONNECT
24             METHOD_PROPFIND
25             METHOD_PROPPATCH
26             METHOD_MKCOL
27             METHOD_COPY
28             METHOD_MOVE
29             METHOD_LOCK
30             METHOD_UNLOCK
31             );
32              
33             our %EXPORT_TAGS = (
34             methods => [
35             qw(
36             METHOD_GET
37             METHOD_POST
38             METHOD_OPTIONS
39             METHOD_HEAD
40             METHOD_PUT
41             METHOD_DELETE
42             METHOD_TRACE
43             METHOD_CONNECT
44             METHOD_PROPFIND
45             METHOD_PROPPATCH
46             METHOD_MKCOL
47             METHOD_COPY
48             METHOD_MOVE
49             METHOD_LOCK
50             METHOD_UNLOCK
51             )
52             ],
53             );
54              
55             sub new {
56 1     1 1 61 my $class = shift;
57 1         25 my $r = $class->_new();
58 1         1 bless $r, $class;
59 1 50       3 if (@_) {
60 0         0 my $uri = shift;
61 0 0       0 die "Blank uri not supported" unless length($uri);
62 0         0 $r->set_uri($uri);
63 0         0 while (@_) {
64 0         0 my ($header, $value) = splice(@_, 0, 2);
65 0         0 $r->set_header($header, $value);
66             }
67             }
68 1         2 return $r;
69             }
70              
71             sub get {
72 0 0   0 1   die "get() requires a URI as a parameter" unless @_;
73 0           my $r = __PACKAGE__->new(@_);
74 0           $r->process_request;
75 0           return $r->get_body();
76             }
77              
78             sub get_socket {
79 0     0 1   my $self = shift;
80 0           require IO::Handle;
81 0           my $sockno = $self->_get_socket();
82 0   0       my $sock = IO::Handle->new_from_fd($sockno, "r")
83             || die "Cannot open socket: $!";
84 0           return $sock;
85             }
86              
87             1;
88             __END__