File Coverage

blib/lib/WWW/OpenResty.pm

Criterion	Covered	Total	%
statement	64	80	80.0
branch	18	32	56.2
condition	5	16	31.2
subroutine	11	15	73.3
pod	5	8	62.5
total	103	151	68.2

package WWW::OpenResty;

use strict;
use warnings;

#use Smart::Comments;
use Carp qw(croak);
use Params::Util qw( _HASH0 );
use LWP::UserAgent;
use Data::Dumper;
use Digest::MD5 qw(md5_hex);

our $VERSION = '0.09';

sub new {
    ### @_
    my $class = ref $_[0] ? ref shift : shift;
    my $params = _HASH0(shift @_) or croak "Invalid params";
    ### $params
    my $server = delete $params->{server} or
        croak "No server specified.";
    if ($server !~ m{^\w+://}) {
        $server = "http://$server";
    }
    my $ignore_dup_error = delete $params->{ignore_dup_error};
    my $timer = delete $params->{timer};
    my $retries = delete $params->{retries};
    my $ua = LWP::UserAgent->new;
    $ua->cookie_jar({ file => "cookies.txt" });
    bless {
        server => $server,
        ua => $ua,
        timer => $timer,
        retries => $retries,
        ignore_dup_error => $ignore_dup_error,
    }, $class;
}

sub content_type {
    $_[0]->{content_type} = $_[1];
}

sub login {
    my ($self, $user, $password) = @_;
    if ($password) {
        $password = md5_hex($password);
        return $self->get("/=/login/$user/$password?_use_cookie=1");
    }
    $self->{_user} = $user;
}

sub get {
    my $self = shift;
    $self->request(undef, 'GET', @_);
}

sub post {
    my $self = shift;
    my $content = pop;
    $self->request($content, 'POST', @_);
}

sub put {
    my $self = shift;
    my $content = pop;
    $self->request($content, 'PUT', @_);
}

sub delete {
    my $self = shift;
    $self->request(undef, 'DELETE', @_);
}

sub request {
    my ($self, $content, $method, $url, $params) = @_;
    !defined $params or _HASH0($params) or
        croak "Params must be a hash: ", Dumper($params);
    !ref $url or croak "URL is of the wrong type: ", Dumper($url);
    $params ||= {};
    if ($self->{_user}) {
        $params->{_user} ||= $self->{_user};
    }
    my @params;
    while (my ($key, $val) = each %$params) {
        push @params, "$key=$val";
    }
    if ($url =~ /\?$/) {
        $url .= join '&', @params;
    } elsif ($url =~ /\?/) {
        $url .= "&" . join '&', @params;
    } else {
        $url .= "?" . join '&', @params;
    }
    my $type = $self->{content_type};
    $type ||= 'text/plain';
    if ($url !~ /^http:\/\//) {
        $url = $self->{server} . $url;
    }
    my $req = HTTP::Request->new($method);
    $req->header('Content-Type' => $type);
    $req->header('Accept', '*/*');
    $req->url($url);
    if ($content) {
        if ($method eq 'GET' or $method eq 'HEAD') {
            croak "HTTP 1.0/1.1 $method request should not have content: $content";
        }

        $req->content($content);
    } elsif ($method eq 'POST' or $method eq 'PUT') {
        $req->header('Content-Length' => 0);
    }
    my $timer = $self->{timer};
    my $ua = $self->{ua};
    $timer->start($method) if $timer;
    my $res = $ua->request($req);
    $timer->stop($method) if $timer;
    return $res;
}


1;
__END__