File Coverage

blib/lib/Template/Plugin/WebService.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Template::Plugin::WebService;

use strict;

use base qw(Template::Plugin);

use vars qw($VERSION);

$VERSION = '0.16';

use CGI::Ex;

use Carp qw(confess);
use CGI::Cookie;
use Storable qw(thaw);
use WWW::Mechanize;

sub new {
    my $class   = shift;
    my $context = shift;
    bless { _CONTEXT => $context, }, $class;
}

sub load {
    my ($class, $context) = @_;
    return $class;
}

sub URLEncode {
    my $arg = shift;
    my ($ref, $return) = ref($arg) ? ($arg, 0) : (\$arg, 1);

    $$ref =~ s/([^\w\.\ -])/sprintf("%%%02X",ord($1))/eg;
    $$ref =~ tr/\ /+/;

    return $return ? $$ref : '';
}

sub get_outserial {
    my $self = shift;
    my $url = shift;
    my $form = shift;

    my $outserial_key = $self->outserial_key;

    my $outserial = 'json';

    if($form->{$outserial_key}) {
        $outserial = $form->{$outserial_key};
    } elsif($url =~ /\b$outserial_key=(\w+)/) {
        $outserial = $1;
    }

    return $outserial;
}

sub make_form {
    return '' if !@_;
    my ($hash, $keys);
    if (ref $_[0]) {
        $hash = shift;
        $keys = shift() if @_ && ref $_[0];
    } else {
        $hash = {@_};
    }
    $keys ||= [ sort keys %$hash ];
    my $str = "";
    foreach my $key (@$keys) {
        $hash->{$key} = "" if !exists($hash->{$key});
        my $ref = ref($hash->{$key});
        next if $ref && $ref eq 'HASH';
        my $array = ($ref eq 'ARRAY') ? $hash->{$key} : [ $hash->{$key} ];
        foreach my $val (@$array) {
            my $ref2 = ref($val);
            next if $ref2 && $ref2 eq 'HASH';
            my $array2 = ($ref2 eq 'ARRAY') ? $val : [$val];
            foreach (@$array2) {
                $str .= URLEncode($key) . "=" . URLEncode($_ . '') . "&";
            }
        }
    }
    chop $str;
    return $str;
}

sub content_cleanup {
    my $self = shift;
    my $content_ref = shift;
}

sub default_host {
    return '127.0.0.1';
}

sub outserial_key {
    return 'outserial';
}

sub webservice_call {
    my $self = shift;
    my $url  = shift || confess 'need a url';
    my $form = shift || {};

    confess 'form needs to be a hash ref' unless(UNIVERSAL::isa($form, 'HASH'));

    my $host;

    if($url =~ m@^https?://([^/]+)@) {
        $host = $1;
    } else {
        $host = $self->default_host;
        $url = "http://$host$url";
    }

    if (scalar keys %$form) {
        $url .= ($url =~ /\?/) ? '&' : '?';
        $url .= make_form($form);
    }

    my $mech = WWW::Mechanize->new;

    my %cookies = fetch CGI::Cookie;

    my $content;

    if(%cookies && scalar keys %cookies) {
        require HTTP::Cookies;
        require WWW::Mechanize;

        my $cj = HTTP::Cookies->new();
        foreach my $cookie_key (keys %cookies) {
            $cj->set_cookie(0, $cookie_key, $cookies{$cookie_key}->value, '/', $host);
        }
        $mech = WWW::Mechanize->new(cookie_jar => $cj);
        $content = $mech->get($url)->content;
    } else {
        require LWP::Simple;
        $content = LWP::Simple::get($url);
    }

    $self->content_cleanup(\$content);

    my $obj;

    my $outserial = $self->get_outserial($url, $form);

    if($outserial eq 'storable') {
        require Storable;
        $obj = Storable::thaw($content);
    } elsif($outserial eq 'xml') {
        require XML::Simple;
        $obj = XML::Simple::XMLin($content);
    } elsif($outserial eq 'yaml') {
        require YAML;
        $obj = YAML::Load($content);
    } else {
        require JSON;
        $obj = JSON::from_json($content);
    }

    return $obj;
}

1;

__END__