Created
September 28, 2012 07:09
-
-
Save marcusramberg/3798404 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package Capybara; | |
use Mojo::Base -base; | |
use Test::More; | |
use Mojo::Parameters; | |
use Mojo::URL; | |
use Data::Dumper; | |
has 'test'; | |
has 'tx'; | |
has 'dom'; | |
our $scope; | |
sub app { shift->test->app } | |
sub ua { shift->test->ua->max_redirects(5) } | |
sub scope { | |
$scope // shift->dom; | |
} | |
sub find { | |
my $self = shift; | |
$self->scope->find(@_)->map(sub { | |
Capybara::Node->new(dom => $_, session => $self) | |
}); | |
} | |
sub at { | |
my $self = shift; | |
my $dom = $self->scope->at(@_); | |
$dom && Capybara::Node->new(dom => $dom, session => $self); | |
} | |
sub within { | |
my ($self, $selector, $code) = @_; | |
local $scope = $self->scope->at($selector); | |
$code->(); | |
} | |
sub current_page { | |
my $self = shift; | |
$self->tx && $self->tx->req->url; | |
} | |
sub _do { | |
my $self = shift; | |
my $msg = shift; | |
my $name = shift; | |
my $tx = $self->ua->$name(@_); | |
is $tx->res->code, 200, $msg; | |
$self->tx($tx); | |
$self->dom($tx->res->dom); | |
} | |
sub visit { | |
my $self = shift; | |
my $url = $self->app->url_for(@_); | |
$self->_do("Visiting $url", get => $url); | |
} | |
sub click_link { | |
my ($self, $rel) = @_; | |
my $link = $self->at("a[rel~=$rel]"); | |
ok $link, "Finding link with rel=$rel"; | |
$link->click; | |
} | |
sub fill_in { | |
my ($self, $name, $value) = @_; | |
my $input = $self->at("input[name=$name]"); | |
ok $input, "Finding input with name=$name"; | |
$input->fill($value); | |
} | |
sub select { | |
my ($self, $name, $option) = @_; | |
my $select = $self->at("select[name=$name]"); | |
ok $select, "Finding select with name=$name"; | |
$select->select($option); | |
} | |
sub click_button { | |
my ($self, $action) = @_; | |
my $input = $self->find("input[type=submit]")->first(sub { $_->dom->{'data-rel'} eq $action }); | |
ok $input, "Finding input with data-rel=$action"; | |
$input->click; | |
} | |
sub _submit { | |
my $self = shift; | |
my $form = shift; | |
my $button = shift // ''; | |
my $params = Mojo::Parameters->new; | |
$form->find('input, select')->each(sub { | |
my $i = shift; | |
next if $i->{disabled}; | |
given ($i->type) { | |
when ("input") { | |
given ($i->{type}) { | |
when ("submit") { | |
if ($i eq $button) { | |
$params->append($i->{name} => $i->{value}); | |
} | |
} | |
default { | |
$params->append($i->{name} => $i->{value}); | |
} | |
} | |
} | |
when ("select") { | |
my $opt = $i->at('option[selected]') || $i->at('option'); | |
$params->append($i->{name} => $opt->{value} // $opt->text); | |
} | |
} | |
}); | |
my $url = Mojo::URL->new($form->{action}); | |
$url->base($self->current_page); | |
if ($form->{method} && lc $form->{method} eq 'post') { | |
$self->_do("Posting $url", post_form => $url->to_abs, $params->to_hash); | |
} else { | |
$url->query($params); | |
$self->_do("Querying $url", get => $url->to_abs); | |
} | |
} | |
package Capybara::Node; | |
use Mojo::Base -base; | |
use Test::More; | |
has 'dom'; | |
has 'session'; | |
sub click { | |
my $self = shift; | |
if ($self->dom->type eq 'a') { | |
$self->session->visit($self->dom->{href}); | |
} elsif ($self->dom->type eq 'input') { | |
my $form = $self->dom; | |
$form = $form->parent until $form->type eq 'form'; | |
ok $form, "Finding form"; | |
$self->session->_submit($form, $self->dom); | |
} | |
} | |
sub fill { | |
my ($self, $value) = @_; | |
$self->dom->{value} = $value; | |
} | |
sub select { | |
my ($self, $option) = @_; | |
$self->dom->find('option[selected]')->each(sub { | |
delete $_->{selected} | |
}); | |
my $o = $self->dom->find('option')->first(sub { | |
$_->{value} eq $option or $_->text eq $option | |
}); | |
ok $o, "Finding option with value $option"; | |
$o->{selected} = 'selected'; | |
} | |
sub submit { | |
my $self = shift; | |
$self->session->_submit($self->dom); | |
} | |
1; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment