package Test::Mojo; use Mojo::Base -base; use Mojo::IOLoop; use Mojo::Message::Response; use Mojo::UserAgent; use Mojo::Util 'decode'; use Test::More (); has ua => sub { Mojo::UserAgent->new->ioloop(Mojo::IOLoop->singleton) }; has 'tx'; # Silent or loud tests $ENV{MOJO_LOG_LEVEL} ||= $ENV{HARNESS_IS_VERBOSE} ? 'debug' : 'fatal'; # "Ooh, a graduate student huh? # How come you guys can go to the moon but can't make my shoes smell good?" sub new { my $self = shift->SUPER::new; # Application if (@_ % 2) { $self->app(shift) } # DEPRECATED in Smiling Face With Sunglasses! elsif (@_) { warn <<EOF; Test::Mojo->new(app => 'MyApp') is DEPRECATED in favor of Test::Mojo->new('MyApp')!!! EOF my $args = {@_}; for my $key (qw/app max_redirects tx ua/) { $self->$key($args->{$key}) if $args->{$key}; } } return $self; } sub app { my $self = shift; return $self->ua->app unless @_; $self->ua->app(@_); return $self; } sub content_is { my ($self, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is $self->_get_content($self->tx), $value, $desc || 'exact match for content'; return $self; } sub content_isnt { my ($self, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt $self->_get_content($self->tx), $value, $desc || 'no match for content'; return $self; } sub content_like { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::like $self->_get_content($self->tx), $regex, $desc || 'content is similar'; return $self; } sub content_unlike { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::unlike $self->_get_content($self->tx), $regex, $desc || 'content is not similar'; return $self; } # "Marge, I can't wear a pink shirt to work. # Everybody wears white shirts. # I'm not popular enough to be different." sub content_type_is { my ($self, $type) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is $self->tx->res->headers->content_type, $type, "Content-Type: $type"; return $self; } sub content_type_isnt { my ($self, $type) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt $self->tx->res->headers->content_type, $type, "not Content-Type: $type"; return $self; } sub content_type_like { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::like $self->tx->res->headers->content_type, $regex, $desc || 'Content-Type is similar'; return $self; } sub content_type_unlike { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::unlike $self->tx->res->headers->content_type, $regex, $desc || 'Content-Type is not similar'; return $self; } # "A job's a job. I mean, take me. # If my plant pollutes the water and poisons the town, # by your logic, that would make me a criminal." sub delete_ok { shift->_request_ok('delete', @_) } sub element_exists { my ($self, $selector, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::ok $self->tx->res->dom->at($selector), $desc || qq/"$selector" exists/; return $self; } sub element_exists_not { my ($self, $selector, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::ok !$self->tx->res->dom->at($selector), $desc || qq/"$selector" exists not/; return $self; } sub finish_ok { my ($self, $desc) = @_; $self->tx->finish; Mojo::IOLoop->singleton->one_tick while !$self->{finished}; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::ok 1, $desc || 'finished websocket'; return $self; } sub get_ok { shift->_request_ok('get', @_) } sub head_ok { shift->_request_ok('head', @_) } sub header_is { my ($self, $name, $value) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is scalar $self->tx->res->headers->header($name), $value, "$name: " . ($value ? $value : ''); return $self; } sub header_isnt { my ($self, $name, $value) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt scalar $self->tx->res->headers->header($name), $value, "not $name: " . ($value ? $value : ''); return $self; } sub header_like { my ($self, $name, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::like scalar $self->tx->res->headers->header($name), $regex, $desc || "$name is similar"; return $self; } sub header_unlike { my ($self, $name, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::unlike scalar $self->tx->res->headers->header($name), $regex, $desc || "$name is not similar"; return $self; } sub json_content_is { my ($self, $struct, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is_deeply $self->tx->res->json, $struct, $desc || 'exact match for JSON structure'; return $self; } sub max_redirects { my $self = shift; return $self->ua->max_redirects unless @_; $self->ua->max_redirects(@_); return $self; } sub message_is { my ($self, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is $self->_message, $value, $desc || 'exact match for message'; return $self; } sub message_isnt { my ($self, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt $self->_message, $value, $desc || 'no match for message'; return $self; } sub message_like { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::like $self->_message, $regex, $desc || 'message is similar'; return $self; } sub message_unlike { my ($self, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::unlike $self->_message, $regex, $desc || 'message is not similar'; return $self; } # "God bless those pagans." sub post_ok { shift->_request_ok('post', @_) } sub post_form_ok { my $self = shift; my $url = shift; $self->tx($self->ua->post_form($url, @_)); local $Test::Builder::Level = $Test::Builder::Level + 1; my $desc = "post $url"; utf8::encode $desc; Test::More::ok $self->tx->is_done, $desc; return $self; } # "WHO IS FONZY!?! Don't they teach you anything at school?" sub put_ok { shift->_request_ok('put', @_) } sub reset_session { my $self = shift; $self->ua->cookie_jar->empty; $self->tx(undef); return $self; } sub send_message_ok { my ($self, $message, $desc) = @_; $self->tx->send_message($message, sub { Mojo::IOLoop->stop }); Mojo::IOLoop->start; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::ok 1, $desc || 'send message'; return $self; } # "Internet! Is that thing still around?" sub status_is { my ($self, $status) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is $self->tx->res->code, $status, "$status " . Mojo::Message::Response->new(code => $status)->default_message; return $self; } sub status_isnt { my ($self, $status) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt $self->tx->res->code, $status, "not $status " . Mojo::Message::Response->new(code => $status)->default_message; return $self; } sub test_server { shift->ua->test_server(@_) } sub text_is { my ($self, $selector, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::is $self->_text($selector), $value, $desc || $selector; return $self; } sub text_isnt { my ($self, $selector, $value, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::isnt $self->_text($selector), $value, $desc || $selector; return $self; } # "Hello, my name is Barney Gumble, and I'm an alcoholic. # Mr Gumble, this is a girl scouts meeting. # Is it, or is it you girls can't admit that you have a problem?" sub text_like { my ($self, $selector, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::like $self->_text($selector), $regex, $desc || $selector; return $self; } sub text_unlike { my ($self, $selector, $regex, $desc) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::unlike $self->_text($selector), $regex, $desc || $selector; return $self; } sub websocket_ok { my $self = shift; my $url = shift; my $desc = "websocket $url"; utf8::encode $desc; $self->{messages} = []; $self->{finished} = 0; $self->ua->websocket( $url, @_, sub { $self->tx(my $tx = pop); $tx->on_finish(sub { $self->{finished} = 1 }); $tx->on_message(sub { push @{$self->{messages}}, pop }); Mojo::IOLoop->stop; } ); Mojo::IOLoop->start; local $Test::Builder::Level = $Test::Builder::Level + 1; Test::More::ok $self->tx->res->code eq 101, $desc; return $self; } sub _get_content { my ($self, $tx) = @_; # Charset my $charset; ($tx->res->headers->content_type || '') =~ /charset=\"?([^"\s]+)\"?/ and $charset = $1; # Content my $content = $tx->res->body; decode $charset, $content if $charset; return $content; } sub _message { my $self = shift; Mojo::IOLoop->singleton->one_tick while !$self->{finished} && !@{$self->{messages}}; return shift @{$self->{messages}}; } # "Are you sure this is the Sci-Fi Convention? It's full of nerds!" sub _request_ok { my ($self, $method, $url, $headers, $body) = @_; $body = $headers if !ref $headers && @_ > 3; $headers = {} if !ref $headers; # Perform request against application $self->tx($self->ua->$method($url, %$headers, $body)); local $Test::Builder::Level = $Test::Builder::Level + 2; my ($error, $code) = $self->tx->error; my $desc = "$method $url"; utf8::encode $desc; Test::More::diag $error if !(my $ok = !$error || $code) && $error; Test::More::ok $ok, $desc; return $self; } sub _text { my ($self, $selector) = @_; my $text; if (my $e = $self->tx->res->dom->at($selector)) { $text = $e->text } return $text; } 1; __END__ =head1 NAME Test::Mojo - Testing Mojo! =head1 SYNOPSIS use Test::More tests => 10; use Test::Mojo; my $t = Test::Mojo->new('MyApp'); $t->get_ok('/welcome') ->status_is(200) ->content_like(qr/Hello!/, 'welcome message'); $t->post_form_ok('/search', {title => 'Perl', author => 'taro'}) ->status_is(200) ->content_like(qr/Perl.+taro/); $t->delete_ok('/something') ->status_is(200) ->header_is('X-Powered-By' => 'Mojolicious (Perl)') ->header_isnt('X-Bender' => 'Bite my shiny metal ass!'); ->content_is('Hello world!'); $t->websocket_ok('/echo') ->send_message_ok('hello') ->message_is('echo: hello') ->finish_ok; =head1 DESCRIPTION L<Test::Mojo> is a collection of testing helpers for everyone developing L<Mojo> and L<Mojolicious> applications. =head1 ATTRIBUTES L<Test::Mojo> implements the following attributes. =head2 C<tx> my $tx = $t->tx; $t = $t->tx(Mojo::Transaction::HTTP->new); Current transaction, usually a L<Mojo::Transaction::HTTP> object. =head2 C<ua> my $ua = $t->ua; $t = $t->ua(Mojo::UserAgent->new); User agent used for testing, defaults to a L<Mojo::UserAgent> object. =head1 METHODS L<Test::Mojo> inherits all methods from L<Mojo::Base> and implements the following new ones. =head2 C<new> my $t = Test::Mojo->new; my $t = Test::Mojo->new('MyApp'); my $t = Test::Mojo->new(MyApp->new); Construct a new L<Test::Mojo> object. =head2 C<app> my $app = $t->app; $t = $t->app(MyApp->new); Alias for L<Mojo::UserAgent/"app">. my $secret = $t->app->secret; $t->app->log->level('fatal'); $t->app->defaults(testing => 'oh yea!'); =head2 C<content_is> $t = $t->content_is('working!'); $t = $t->content_is('working!', 'right content'); Check response content for exact match. =head2 C<content_isnt> $t = $t->content_isnt('working!'); $t = $t->content_isnt('working!', 'different content'); Opposite of C<content_is>. =head2 C<content_like> $t = $t->content_like(qr/working!/); $t = $t->content_like(qr/working!/, 'right content'); Check response content for similar match. =head2 C<content_unlike> $t = $t->content_unlike(qr/working!/); $t = $t->content_unlike(qr/working!/, 'different content'); Opposite of C<content_like>. =head2 C<content_type_is> $t = $t->content_type_is('text/html'); Check response C<Content-Type> header for exact match. =head2 C<content_type_isnt> $t = $t->content_type_isnt('text/html'); Opposite of C<content_type_is>. =head2 C<content_type_like> $t = $t->content_type_like(qr/text/); $t = $t->content_type_like(qr/text/, 'right content type'); Check response C<Content-Type> header for similar match. =head2 C<content_type_unlike> $t = $t->content_type_unlike(qr/text/); $t = $t->content_type_unlike(qr/text/, 'different content type'); Opposite of C<content_type_like>. =head2 C<delete_ok> $t = $t->delete_ok('/foo'); Perform a C<DELETE> request and check for success, takes the exact same arguments as L<Mojo::UserAgent/"delete">. =head2 C<element_exists> $t = $t->element_exists('div.foo[x=y]'); $t = $t->element_exists('html head title', 'has a title'); Checks for existence of the CSS3 selectors first matching XML/HTML element with L<Mojo::DOM>. =head2 C<element_exists_not> $t = $t->element_exists_not('div.foo[x=y]'); $t = $t->element_exists_not('html head title', 'has no title'); Opposite of C<element_exists>. =head2 C<finish_ok> $t = $t->finish_ok; $t = $t->finish_ok('finished successfully'); Finish C<WebSocket> connection. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<get_ok> $t = $t->get_ok('/foo'); Perform a C<GET> request and check for success, takes the exact same arguments as L<Mojo::UserAgent/"get">. =head2 C<head_ok> $t = $t->head_ok('/foo'); Perform a C<HEAD> request and check for success, takes the exact same arguments as L<Mojo::UserAgent/"head">. =head2 C<header_is> $t = $t->header_is(Expect => 'fun'); Check response header for exact match. =head2 C<header_isnt> $t = $t->header_isnt(Expect => 'fun'); Opposite of C<header_is>. =head2 C<header_like> $t = $t->header_like(Expect => qr/fun/); $t = $t->header_like(Expect => qr/fun/, 'right header'); Check response header for similar match. =head2 C<header_unlike> $t = $t->header_like(Expect => qr/fun/); $t = $t->header_like(Expect => qr/fun/, 'different header'); Opposite of C<header_like>. =head2 C<json_content_is> $t = $t->json_content_is([1, 2, 3]); $t = $t->json_content_is([1, 2, 3], 'right content!'); $t = $t->json_content_is({foo => 'bar', baz => 23}, 'right content!'); Check response content for JSON data. =head2 C<max_redirects> my $max_redirects = $t->max_redirects; $t = $t->max_redirects(3); Alias for the L<Mojo::UserAgent/"max_redirects">. =head2 C<message_is> $t = $t->message_is('working!'); $t = $t->message_is('working!', 'right message'); Check WebSocket message for exact match. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<message_isnt> $t = $t->message_isnt('working!'); $t = $t->message_isnt('working!', 'different message'); Opposite of C<message_is>. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<message_like> $t = $t->message_like(qr/working!/); $t = $t->message_like(qr/working!/, 'right message'); Check WebSocket message for similar match. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<message_unlike> $t = $t->message_unlike(qr/working!/); $t = $t->message_unlike(qr/working!/, 'different message'); Opposite of C<message_like>. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<post_ok> $t = $t->post_ok('/foo'); Perform a C<POST> request and check for success, takes the exact same arguments as L<Mojo::UserAgent/"post">. =head2 C<post_form_ok> $t = $t->post_form_ok('/foo' => {test => 123}); Submit a C<POST> form and check for success, takes the exact same arguments as L<Mojo::UserAgent/"post_form">. =head2 C<put_ok> $t = $t->put_ok('/foo'); Perform a C<PUT> request and check for success, takes the exact same arguments as L<Mojo::UserAgent/"put">. =head2 C<reset_session> $t = $t->reset_session; Reset user agent session. =head2 C<send_message_ok> $t = $t->send_message_ok('hello'); $t = $t->send_message_ok('hello', 'sent successfully'); Send C<WebSocket> message. Note that this method is EXPERIMENTAL and might change without warning! =head2 C<status_is> $t = $t->status_is(200); Check response status for exact match. =head2 C<status_isnt> $t = $t->status_isnt(200); Opposite of C<status_is>. =head2 C<test_server> my $url = $t->test_server; my $url = $t->test_server('http'); my $url = $t->test_server('https'); Alias for L<Mojo::UserAgent/"test_server">. Note that this method is EXPERIMENTAL and might change without warning! $t->get_ok($t->test_server->userinfo('sri:secr3t')->path('/protected')); =head2 C<text_is> $t = $t->text_is('div.foo[x=y]' => 'Hello!'); $t = $t->text_is('html head title' => 'Hello!', 'right title'); Checks text content of the CSS3 selectors first matching XML/HTML element for exact match with L<Mojo::DOM>. =head2 C<text_isnt> $t = $t->text_isnt('div.foo[x=y]' => 'Hello!'); $t = $t->text_isnt('html head title' => 'Hello!', 'different title'); Opposite of C<text_is>. =head2 C<text_like> $t = $t->text_like('div.foo[x=y]' => qr/Hello/); $t = $t->text_like('html head title' => qr/Hello/, 'right title'); Checks text content of the CSS3 selectors first matching XML/HTML element for similar match with L<Mojo::DOM>. =head2 C<text_unlike> $t = $t->text_unlike('div.foo[x=y]' => qr/Hello/); $t = $t->text_unlike('html head title' => qr/Hello/, 'different title'); Opposite of C<text_like>. =head2 C<websocket_ok> $t = $t->websocket_ok('/echo'); Open a C<WebSocket> connection with transparent handshake, takes the exact same arguments as L<Mojo::UserAgent/"websocket">. Note that this method is EXPERIMENTAL and might change without warning! =head1 SEE ALSO L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. =cut