view release on metacpan or  search on metacpan

lib/Brownie/Session.pm  view on Meta::CPAN

package Brownie::Session;

use strict;
use warnings;
use Carp ();
use Class::Load;
use Sub::Install;
use Plack::Runner;
use Test::TCP;

use Brownie::Driver;
use Brownie::Node;
use Brownie::XPath;

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

    my $self = +{
        scopes   => [],
        driver   => $class->_create_driver($args{driver}),
        app_host => $args{app_host},
    };

    if ($args{app}) {
        my $server = $class->_create_server($args{app});
        if ($server) {
            $self->{server}   = $server;
            $self->{app_host} = 'http://localhost:' . $server->port;
        }
    }

    return bless $self => $class;
}

sub DESTROY {
    my $self = shift;
    delete $self->{driver} if exists $self->{driver};
    delete $self->{server} if exists $self->{server};
}

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

    $opts ||= { name => 'Mechanize' };
    $opts = { name => $opts } unless ref $opts;

    my $klass = $opts->{class} || 'Brownie::Driver::' . $opts->{name};
    Class::Load::load_class($klass);

    return $klass->new(%{ $opts->{args} || {} });
}

sub _create_server {
    my ($class, $app, %args) = @_;
    return unless $app;

    my $server = Test::TCP->new(
        code => sub {
            my $port = shift;

            my $r = Plack::Runner->new(app => $app);
            $r->parse_options('--port' => $port, '--env' => 'test');
            $r->set_options(%args);
            $r->run;
        },
    );
}

sub driver   { shift->{driver} }
sub server   { shift->{server} }
sub app_host { shift->{app_host} }

for my $method (qw/
    current_url
    current_path
    status_code
    response_headers
    title
    source
    screenshot
    execute_script
    evaluate_script
/) {
    Sub::Install::install_sub({
        code => sub { shift->driver->$method(@_) },
        as   => $method,
    });
}

*body = \&source;

sub visit {