File Coverage

blib/lib/Perinci/Access.pm

Criterion	Covered	Total	%
statement	17	66	25.7
branch	0	18	0.0
condition	0	32	0.0
subroutine	6	10	60.0
pod	3	3	100.0
total	26	129	20.1

package Perinci::Access;

our $DATE = '2015-12-17'; # DATE
our $VERSION = '0.44'; # VERSION

use 5.010001;
use strict;
use warnings;
use Log::Any::IfLOG '$log';

use Scalar::Util qw(blessed);
use URI::Split qw(uri_split uri_join);

our $Log_Request  = $ENV{LOG_RIAP_REQUEST}  // 0;
our $Log_Response = $ENV{LOG_RIAP_RESPONSE} // 0;

sub new {
    my ($class, %opts) = @_;

    $opts{riap_version}           //= 1.1;
    $opts{handlers}               //= {};
    $opts{handlers}{''}           //= 'Perinci::Access::Schemeless';
    $opts{handlers}{pl}           //= 'Perinci::Access::Perl';
    $opts{handlers}{http}         //= 'Perinci::Access::HTTP::Client';
    $opts{handlers}{https}        //= 'Perinci::Access::HTTP::Client';
    $opts{handlers}{'riap+tcp'}   //= 'Perinci::Access::Simple::Client';
    $opts{handlers}{'riap+unix'}  //= 'Perinci::Access::Simple::Client';
    $opts{handlers}{'riap+pipe'}  //= 'Perinci::Access::Simple::Client';

    $opts{_handler_objs}          //= {};
    bless \%opts, $class;
}

sub _request_or_parse_url {
    my $self = shift;
    my $which = shift;

    my ($action, $uri, $extra, $copts);
    if ($which eq 'request') {
        ($action, $uri, $extra, $copts) = @_;
    } else {
        ($uri, $copts) = @_;
    }

    my ($sch, $auth, $path, $query, $frag) = uri_split($uri);
    $sch //= "";
    die "Can't handle scheme '$sch' in URL" unless $self->{handlers}{$sch};

    # convert riap://perl/Foo/Bar to pl:/Foo/Bar/ as Perl only accepts pl
    if ($sch eq 'riap') {
        $auth //= '';
        die "Unsupported auth '$auth' in riap: scheme, ".
            "only 'perl' is supported" unless $auth eq 'perl';
        $sch = 'pl';
        $auth = undef;
        $uri = uri_join($sch, $auth, $path, $query, $frag);
    }

    unless ($self->{_handler_objs}{$sch}) {
        if (blessed($self->{handlers}{$sch})) {
            $self->{_handler_objs}{$sch} = $self->{handlers}{$sch};
        } else {
            my $modp = $self->{handlers}{$sch};
            $modp =~ s!::!/!g; $modp .= ".pm";
            require $modp;
            #$log->tracef("TMP: Creating Riap client object for schema %s with args %s", $sch, $self->{handler_args});
            $self->{_handler_objs}{$sch} = $self->{handlers}{$sch}->new(
                riap_version => $self->{riap_version},
                %{ $self->{handler_args} // {}});
        }
    }

    my $res;
    if ($which eq 'request') {
        if ($Log_Request && $log->is_trace) {
            $log->tracef(
                "Riap request (%s): %s -> %s (%s)",
                ref($self->{_handler_objs}{$sch}),
                $action, $uri, $extra, $copts);
        }
        $res = $self->{_handler_objs}{$sch}->request(
            $action, $uri, $extra, $copts);
        if ($Log_Response && $log->is_trace) {
            $log->tracef("Riap response: %s", $res);
        }
    } else {
        $res = $self->{_handler_objs}{$sch}->parse_url($uri, $copts);
    }
    $res;
}

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

sub parse_url {
    my $self = shift;
    $self->_request_or_parse_url('parse_url', @_);
}

1;
# ABSTRACT: Wrapper for Perinci Riap clients

__END__