view release on metacpan or  search on metacpan

lib/App/MFILE/WWW/Resource.pm  view on Meta::CPAN

package App::MFILE::WWW::Resource;

use strict;
use warnings;

use App::CELL qw( $CELL $log $meta $site );
use Data::Dumper;
use Encode qw( decode_utf8 encode_utf8 );
use File::Temp qw( tempfile );
use HTTP::Request::Common qw( GET PUT POST DELETE );
use JSON;
use LWP::UserAgent;
use Params::Validate qw(:all);
use Try::Tiny;

# methods/attributes not defined in this module will be inherited from:
use parent 'Web::Machine::Resource';

# user agent lookup table
our $ualt = {};

lib/App/MFILE/WWW/Resource.pm  view on Meta::CPAN

=cut

sub rest_req {
    my $self = shift;

    # process arguments
    my $ua = $self->ua();
    die "Bad user agent object" unless ref( $ua ) eq 'LWP::UserAgent';
    my %ARGS = validate( @_, {
        server =>   { type => SCALAR,  default => 'http://localhost:5000' },
        method =>   { type => SCALAR,  default => 'GET', regex => qr/^(GET|POST|PUT|DELETE)$/ },
        nick =>     { type => SCALAR,  optional => 1 },
        password => { type => SCALAR,  default => '' },
        path =>     { type => SCALAR,  default => '/' },
        req_body => { type => HASHREF, optional => 1 },
    } );
    $ARGS{'path'} =~ s/^\/*/\//;

    my $r;
    {
        no strict 'refs';
        $r = &{ $ARGS{'method'} }( $ARGS{'server'} . encode_utf8( $ARGS{'path'} ), 
                Accept => 'application/json' );
    }

    if ( $ARGS{'nick'} ) {
        $r->authorization_basic( $ARGS{'nick'}, $ARGS{'password'} );
    }

    if ( $ARGS{'method'} =~ m/^(POST|PUT)$/ ) {
        $r->header( 'Content-Type' => 'application/json' );
        if ( my $body = $ARGS{'req_body'} ) {
            my $tmpvar = JSON->new->utf8(0)->encode( $body );
            $r->content( encode_utf8( $tmpvar ) );
        }
    }

    # request is ready - send it and get response
    my $response = $ua->request( $r );