File Coverage

blib/lib/Plack/Util/Load.pm

Criterion	Covered	Total	%
statement	56	83	67.4
branch	21	38	55.2
condition	4	9	44.4
subroutine	12	14	85.7
pod	0	3	0.0
total	93	147	63.2

package Plack::Util::Load;
use strict;
use warnings;

our $VERSION = '0.1';

use parent 'Exporter';
our @EXPORT = qw(load_app);

use Plack::Util;
use Plack::Request;
use Plack::Response;
use HTTP::Tiny;
use URI;

use Carp;
our @CARP_NOT = ('Plack::Util');

our $VERBOSE = 0;

sub load_app {
    my ($app, %options) = @_;

    if ( !defined $options{verbose} ) {
        $options{verbose} = $VERBOSE;
    }

    if ( ref $app ) {
        if (ref $app eq 'CODE') {
            return $app;
        } elsif ( eval { $app->can('to_app') } ) {
            return $app->to_app;
        } else {
            croak "failed to load app from object or reference " . ref $app;
        }
    } elsif ( !defined $app or $app eq '' ) {
        $app = 'app.psgi';
    }

    if ( $app =~ /^:?(\d+)$/ and $1 > 0 ) {
        return load_url("http://localhost:$1/", %options);
    } elsif ( $app eq 'localhost' ) {
        return load_url("http://localhost/", %options);
    } elsif ( $app =~ /^https?:\/\// ) {
        return load_url($app, %options);
    } elsif ( -f $app ) {
        return Plack::Util::load_psgi($app);
    } elsif ( $app =~ /^[a-zA-Z0-9\_\:]+$/ ) {
        return load_package($app, %options);
    }

    croak "failed to load app $app";
}

sub load_package {
    my ($module, %options) = @_;

    # check defined module
    no strict 'refs';
    if ( %{ $module.'::' } ) {
        my $app = eval { $module->new->to_app };
        if ( ref $app ) {
            print "# load_app defined package $module\n" if $options{verbose};
            return $app;
        }
        croak "failed to load app $module from package";
    }


    # load and instanciate new module
    Plack::Util::load_class( $module );
    my $app = $module->new->to_app;
    print "# load_app new package $module\n" if $options{verbose};

    return $app;
}

sub load_url {
    my ($url, %options) = @_ % 2 ? @_ : (undef, @_);

    $url = URI->new($url);
    my ($scheme, $host, $port) = ($url->scheme, $url->host, $url->port);

    my $verbose = $options{verbose};

    return sub {
        my $req = Plack::Request->new($_[0]);
        my @headers;
        $req->headers->scan(sub { push @headers, @_ });
        my $options = { headers => {} };
        $options->{headers} = Hash::MultiValue->new(@headers)->mixed if @headers;
        delete $options->{headers}->{Host}; # not allowed by HTTP::Tiny
        $options->{content} = $req->content if length($req->content);
        my $uri = $req->uri;
        $uri->scheme($scheme);
        $uri->host($host);
        $uri->port($port);

        if ($verbose) {
            printf "# %s %s\n", $req->method, $uri;
        }

        my $res = HTTP::Tiny->new->request( $req->method, $uri, $options );

        if ($res->{status} == 599 and $verbose) {
            print STDERR "# ".$res->{content};
        }

        return Plack::Response->new( $res->{status}, $res->{headers}, $res->{content} )->finalize;
    };
}

1;
__END__