Test-WWW-Mechanize-Mojo-v0.0.14000755000764000764 012246042416 16464 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/MANIFEST000444000764000764 60512246042416 17733 0ustar00shlomifshlomif000000000000buildlib/Test/Run/Builder.pm Build.PL CHANGES lib/Test/WWW/Mechanize/Mojo.pm Makefile.PL MANIFEST This list of files META.yml README scripts/tag-release.pl t/auth-test.t t/cookies.t t/form_submit.t t/lib/Catty.pm t/lib/CattySession.pm t/lib/ExternalCatty.pm t/lib/mojjy.pl t/pod-coverage.t t/pod.t t/redirect.t t/simple.t t/style-trailing-space.t t/useragent.t t/white_label.t META.json Test-WWW-Mechanize-Mojo-v0.0.14/Build.PL000444000764000764 237512246042416 20124 0ustar00shlomifshlomif000000000000use lib "./buildlib"; use Test::Run::Builder; use strict; use warnings; my $build = Test::Run::Builder->new( module_name => "Test::WWW::Mechanize::Mojo", configure_requires => { 'Module::Build' => '0.36', }, test_requires => { 'Test::Exception'=> '0', 'Test::More' => '0', 'Test::Mojo' => 0, }, requires => { 'base' => 0, 'Carp' => 0, 'Encode' => 0, 'HTML::Entities' => 0, 'LWP' => '5.816', 'Mojolicious::Lite' => 0, 'Mojolicious' => '4.07', 'strict' => 0, 'Test::WWW::Mechanize' => '1.14', 'utf8' => 0, 'warnings' => 0, 'WWW::Mechanize' => '1.50', }, dist_version_from => "lib/Test/WWW/Mechanize/Mojo.pm", license => "perl", create_makefile_pl => 'traditional', meta_merge => { resources => { repository => "http://bitbucket.org/shlomif/perl-test-www-mechanize-mojo", homepage => "http://web-cpan.berlios.de/modules/Test-WWW-Mechanize-Mojo/", }, keywords => [ ], }, ); $build->create_build_script; Test-WWW-Mechanize-Mojo-v0.0.14/Makefile.PL000444000764000764 142712246042416 20577 0ustar00shlomifshlomif000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4007 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Test::WWW::Mechanize::Mojo', 'VERSION_FROM' => 'lib/Test/WWW/Mechanize/Mojo.pm', 'PREREQ_PM' => { 'Carp' => 0, 'Encode' => 0, 'HTML::Entities' => 0, 'LWP' => '5.816', 'Mojolicious' => '4.07', 'Mojolicious::Lite' => 0, 'Test::WWW::Mechanize' => '1.14', 'WWW::Mechanize' => '1.50', 'base' => 0, 'strict' => 0, 'utf8' => 0, 'warnings' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Test-WWW-Mechanize-Mojo-v0.0.14/META.yml000444000764000764 172512246042416 20077 0ustar00shlomifshlomif000000000000--- abstract: 'Test::WWW::Mechanize for Mojo / Mojolicious' author: - unknown build_requires: {} configure_requires: Module::Build: 0.36 dynamic_config: 1 generated_by: 'Module::Build version 0.4007, CPAN::Meta::Converter version 2.132830' keywords: [] license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Test-WWW-Mechanize-Mojo provides: Test::WWW::Mechanize::Mojo: file: lib/Test/WWW/Mechanize/Mojo.pm version: v0.0.14 requires: Carp: 0 Encode: 0 HTML::Entities: 0 LWP: 5.816 Mojolicious: 4.07 Mojolicious::Lite: 0 Test::WWW::Mechanize: 1.14 WWW::Mechanize: 1.50 base: 0 strict: 0 utf8: 0 warnings: 0 resources: homepage: http://web-cpan.berlios.de/modules/Test-WWW-Mechanize-Mojo/ license: http://dev.perl.org/licenses/ repository: http://bitbucket.org/shlomif/perl-test-www-mechanize-mojo version: v0.0.14 x_test_requires: Test::Exception: 0 Test::Mojo: 0 Test::More: 0 Test-WWW-Mechanize-Mojo-v0.0.14/META.json000444000764000764 312012246042416 20236 0ustar00shlomifshlomif000000000000{ "abstract" : "Test::WWW::Mechanize for Mojo / Mojolicious", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.132830", "keywords" : [], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-WWW-Mechanize-Mojo", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.36" } }, "runtime" : { "requires" : { "Carp" : "0", "Encode" : "0", "HTML::Entities" : "0", "LWP" : "5.816", "Mojolicious" : "4.07", "Mojolicious::Lite" : "0", "Test::WWW::Mechanize" : "1.14", "WWW::Mechanize" : "1.50", "base" : "0", "strict" : "0", "utf8" : "0", "warnings" : "0" } } }, "provides" : { "Test::WWW::Mechanize::Mojo" : { "file" : "lib/Test/WWW/Mechanize/Mojo.pm", "version" : "v0.0.14" } }, "release_status" : "stable", "resources" : { "homepage" : "http://web-cpan.berlios.de/modules/Test-WWW-Mechanize-Mojo/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://bitbucket.org/shlomif/perl-test-www-mechanize-mojo" } }, "version" : "v0.0.14", "x_test_requires" : { "Test::Exception" : "0", "Test::Mojo" : "0", "Test::More" : "0" } } Test-WWW-Mechanize-Mojo-v0.0.14/README000444000764000764 207612246042416 17506 0ustar00shlomifshlomif000000000000Test::WWW::Mechanize::Mojo - Test::WWW::Mechanize for Mojo Test::WWW::Mechanize::Mojo is a module to test Mojo applications using Test::WWW::Mechanize and WWW::Mechanize. It is based on Test::WWW::Mechanize::Catalyst . INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test ./Build install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Test::WWW::Mechanize::Mojo You can also look for information at: Search CPAN http://search.cpan.org/dist/Test-WWW-Mechanize-Mojo/ CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test::WWW::Mechanize::Mojo AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Test::WWW::Mechanize::Mojo CPAN Ratings: http://cpanratings.perl.org/d/Test::WWW::Mechanize::Mojo COPYRIGHT AND LICENCE Copyright (C) 2005-8, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Test-WWW-Mechanize-Mojo-v0.0.14/CHANGES000444000764000764 1436612246042416 17646 0ustar00shlomifshlomif000000000000Revision history for Perl module Test::WWW::Mechanize::Mojo : v0.0.14 Fri 29 Nov 09:36:57 IST 2013 - Remove some old PODded-out code. - Caused a false positive at: - https://rt.cpan.org/Public/Bug/Display.html?id=91042 v0.0.13 Sat 25 May 23:27:16 IDT 2013 - Fix the tests for Mojolicious 4.07. v0.0.12 Tue 21 May 21:10:56 IDT 2013 - Add t/style-trailing-space.t and get rid of trailing space. v0.0.11 Wed 1 Aug 20:55:21 IDT 2012 - Got the POD coverage ( t/pod-coverage.t ) to pass again. v0.0.10 Sun May 13 23:16:58 IDT 2012 - Update the module for recent versions of Mojolicious where $t->max_redirects() was removed (after being deprecated). - Thanks to tempire on #mojo on irc.perl.org for shedding some light on this issue. - This release coincides with the birthday of Sebastian Riedel ( https://metacpan.org/author/SRI ), the creator and maintainer of Mojolicious (and Catalyst previously). Happy birthday, Sebastian! v0.0.9 Thu May 19 23:14:29 IDT 2011 - Got rid of warnings by switching from $t->client to $t->ua. - Thanks to Mirko Westermeier v0.0.8 Wed Jan 26 14:56:01 IST 2011 - Convert the mentioning of CATALYST_SERVER to MOJO_SERVER. - thanks to Insurgent Software. v0.0.7 Mon Jan 17 15:55:00 IST 2011 - Fixed mojjy.pl and the lib/Test/WWW/Mechanize/Mojo.pm code in recent Mojo versions. - app->start instead of shagadelic. - some tweaks to the ->$method->res. v0.0.6 Fri Sep 3 20:43:26 IDT 2010 - Fixed mojjy.pl to avoid double encoding in recent Mojo versions. v0.0.5 Mon Jun 14 21:54:45 IDT 2010 - Removed the call to Test::Mojo->redirect() which is no longer implemented in recent Mojos. v0.0.4 Wed Mar 17 16:01:20 IST 2010 - Now evaluating the GET parameters in requests by using URI.pm's ->path_query() instead of ->path(). v0.0.3 Thu Mar 4 00:35:10 IST 2010 - Fix submit_form_ok on the contemporary Mojo::Client . (with a test). v0.0.2 Tue Mar 2 23:27:43 IST 2010 - Add a missing empty line before an "=end". Without it, the POD was not displayed properly by perldoc and by http://search.cpan.org/ . - Add a t/pod-coverage.t test. v0.0.1 Tue Mar 2 20:59:50 IST 2010 - Ported to Mojo from Test::WWW::Mechanize::Catalyst - Convert from Module::Install to Module::Build . - All rights disclaimed. Revision history for Perl module Test::WWW::Mechanize::Catalyst: 0.51 Mon Mar 16 10:00 GMT 2009 - Doc updates from thejester - User agent fixes from ANDREMAR - Fix bug where redirect was followed on a 500 response - All remote requests (i.e. CATALYST_SERVER env var) now use our own mechanize object, rather than an unconfigurable one from Catalyst:Test 0.50 Tue Feb 17 09:12 GMT 2009 - Remove warning in HTTP::Cookies - Call BUILDALL 0.50_2 Thur Feb 12 09:47 GMT 2009 - Make t/multi_content_type.t handle case when server cant be started, which is almost always due to port in use. 0.50_1 Thur Feb 5 09:02 GMT 2009 - App classname no longer has to be passed to import: $m = T::W::M::C->new(catalyst_app => 'Catty') now works. - Can now use TWMC two test two different apps in the same perl interpreter due to the above change - Removed Test::WWW::Mechanize::Catalyst::Aux package as it isn't needed any more - Add 'host' accessor for white-label testing - Moosification - Can now test against remote CATALYST_SERVER without having to load the app class 0.45 Mon Nov 24 20:39:19 GMT 2008 - be forwards-compatible with Catalyst 5.80's virtual domain testing (thanks Jason Gottshall) 0.44 Mon Oct 27 13:48:22 GMT 2008 - fix longstanding bug with recent LWP, requiring WWW::Mechanize 1.50 (thanks to petdance, mst, dakkar) - add machine- and human-readable license, add abstract 0.43 Mon Aug 18 15:42:03 BST 2008 - add missing prereqs to Catalyst::Plugin::Session::State::Cookie and Catalyst::Plugin::Session::Store::Dummy (thanks kd) 0.42 Tue Apr 29 20:25:06 BST 2008 - stop multi_content_type.t killing smoke testing (patch by Andreas König) - fix a case where HTTP::Cookies dies when trying to extract_cookies (patch by Andreas Marienborg) - add Test::Exception as a prerequisite 0.41 Mon Sep 17 20:28:59 BST 2007 - fix to cope with gzipped content and the test from the rt.cpan queue about multiple content types (patch by Ash Berlin) 0.40 Tue Aug 21 20:51:13 BST 2007 - external requests (as per last release) are now only allowed if you set allow_external (sorry about that) 0.39 Sat Aug 4 08:01:38 BST 2007 - external requests are now allowed (patch by Edmund von der Burg) - remove Build.PL 0.38 Sat Jun 30 14:07:24 BST 2007 - document and test that you can use URLs without schema or hostname - add debug screen error to test diagnostics (patch by Jonathan Swartz) - add basic authentication support (patch by Gareth Kirwan) - add test for charset=utf-8 (patch by Chris Dolan) - added CATALYST_SERVER mention in the documentation (patch by Kieren Diment) 0.37 Tue Jun 6 08:54:07 BST 2006 - patch to follow LWP's $m->requests_redirectable() and small docpatch (thanks to Daniel McBrearty) - mention Catalyst::Test (thanks to guest) 0.36 Mon Apr 17 11:27:17 BST 2006 - perltidy - Catalyst debug screens are now failures (thanks to Kieren Diment) 0.35 Tue Jan 22 17:06:00 GMT 2006 - handle redirects (patch by Mark Fowler) 0.33 Tue Jun 7 17:38:45 BST 2005 - we need at least version 1.04 of Test::WWW::Mechanize (spotted by Jesse Vincent, patch by Shlomi Fish) 0.32 Tue May 3 16:14:40 BST 2005 - removed 'use Image::Size' in test, as spotted by SMPETERS 0.31 Sun Apr 17 10:30:18 BST 2005 - update for Catalyst 5.00 0.30 Fri Mar 25 04:34:50 GMT 2005 - add Test::WWW::Mechanize to prereqs - remove useless "use URI" - "borrow" lots of docs from Test::WWW::Mechanize - Catalyst 4.30 adds support for HTTP::Request objects in Catalyst::Test::request(), so use it (thanks to Christian Hansen) 0.29 Thu Mar 17 22:42:04 EST 2005 - initial release Test-WWW-Mechanize-Mojo-v0.0.14/buildlib000755000764000764 012246042416 20252 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/buildlib/Test000755000764000764 012246042416 21171 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/buildlib/Test/Run000755000764000764 012246042416 21735 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/buildlib/Test/Run/Builder.pm000444000764000764 316712246042416 24025 0ustar00shlomifshlomif000000000000package Test::Run::Builder; use strict; use warnings; use Module::Build; use vars qw(@ISA); @ISA = (qw(Module::Build)); sub ACTION_runtest { my ($self) = @_; my $p = $self->{properties}; $self->depends_on('code'); local @INC = @INC; # Make sure we test the module in blib/ unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'), File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')); $self->do_test_run_tests; } sub ACTION_distruntest { my ($self) = @_; $self->depends_on('distdir'); my $start_dir = $self->cwd; my $dist_dir = $self->dist_dir; chdir $dist_dir or die "Cannot chdir to $dist_dir: $!"; # XXX could be different names for scripts $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile or die "Error executing 'Build.PL' in dist directory: $!"; $self->run_perl_script('Build') or die "Error executing 'Build' in dist directory: $!"; $self->run_perl_script('Build', [], ['runtest']) or die "Error executing 'Build test' in dist directory"; chdir $start_dir; } sub do_test_run_tests { my $self = shift; require Test::Run::CmdLine::Iface; my $test_run = Test::Run::CmdLine::Iface->new( { 'test_files' => [glob("t/*.t")], } # 'backend_params' => $self->_get_backend_params(), ); return $test_run->run(); } sub ACTION_tags { return system(qw( ctags -f tags --recurse --totals --exclude=blib/** --exclude=t/lib/** --exclude=.svn --exclude='*~' --languages=Perl --langmap=Perl:+.t )); } 1; Test-WWW-Mechanize-Mojo-v0.0.14/lib000755000764000764 012246042416 17232 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/lib/Test000755000764000764 012246042416 20151 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/lib/Test/WWW000755000764000764 012246042416 20635 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/lib/Test/WWW/Mechanize000755000764000764 012246042416 22540 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/lib/Test/WWW/Mechanize/Mojo.pm000444000764000764 4075112246042416 24166 0ustar00shlomifshlomif000000000000package Test::WWW::Mechanize::Mojo; use strict; use warnings; use Carp qw/croak/; use Encode qw(); use HTML::Entities; use base 'Test::WWW::Mechanize'; use Test::Mojo; our $VERSION = '0.0.14'; our $APP_CLASS; my $Test = Test::Builder->new(); sub mojo_app { my $self = shift; return $self->{mojo_app}; } sub has_mojo_app { my $self = shift; return exists($self->{mojo_app}); } sub allow_external { my $self = shift; if (@_) { $self->{allow_external} = shift; } return $self->{allow_external}; } sub host { my $self = shift; if (@_) { $self->{host} = shift; } return $self->{host}; } sub clear_host { my $self = shift; delete($self->{host}); return; } sub has_host { my $self = shift; return exists($self->{host}); } sub tester { my $self = shift; if (@_) { $self->{tester} = shift; } return $self->{tester}; } sub new { my $class = shift; my $args = ref $_[0] ? $_[0] : { @_ }; my $tester = delete($args->{tester}); my $self = $class->SUPER::new(%$args); if ($tester) { $self->tester($tester); } else { $self->tester(Test::Mojo->new()); } $self->{allow_external} = 0; return $self; } sub _make_request { my ( $self, $request ) = @_; my $response = $self->_do_mojo_request($request); $response->header( 'Content-Base', $response->request->uri ) unless $response->header('Content-Base'); $self->cookie_jar->extract_cookies($response) if $self->cookie_jar; # fail tests under the Catalyst debug screen if ( !$self->{catalyst_debug} && $response->code == 500 && $response->content =~ /on Catalyst \d+\.\d+/ ) { my ($error) = ( $response->content =~ /(.*?)<\/code>/s ); $error ||= "unknown error"; decode_entities($error); $Test->diag("Catalyst error screen: $error"); $response->content(''); $response->content_type(''); } # check if that was a redirect if ( $response->header('Location') && $response->is_redirect && $self->redirect_ok( $request, $response ) ) { # remember the old response my $old_response = $response; # *where* do they want us to redirect to? my $location = $old_response->header('Location'); # no-one *should* be returning non-absolute URLs, but if they # are then we'd better cope with it. Let's create a new URI, using # our request as the base. my $uri = URI->new_abs( $location, $request->uri )->as_string; # make a new response, and save the old response in it $response = $self->_make_request( HTTP::Request->new( GET => $uri ) ); my $end_of_chain = $response; while ( $end_of_chain->previous ) # keep going till the end { $end_of_chain = $end_of_chain->previous; } # of the chain... $end_of_chain->previous($old_response); # ...and add us to it } else { $response->{_raw_content} = $response->content; } return $response; } sub _do_mojo_request { my ($self, $request) = @_; my $uri = $request->uri; $uri->scheme('http') unless defined $uri->scheme; $uri->host('localhost') unless defined $uri->host; $request = $self->prepare_request($request); $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar; # Woe betide anyone who unsets MOJO_SERVER return $self->_do_remote_request($request) if $ENV{MOJO_SERVER}; # If there's no Host header, set one. unless ($request->header('Host')) { my $host = $self->has_host ? $self->host : $uri->host; $request->header('Host', $host); } my $res = $self->_check_external_request($request); return $res if $res; my @creds = $self->get_basic_credentials( "Basic", $uri ); $request->authorization_basic( @creds ) if @creds; my $t = $self->tester; # Client my $client = $t->ua; $client->app($t->app); my $method = lc($request->method()); my %headers = ( map { $_ => $request->header($_) } $request->header_field_names() ); my $mojo_res = $client->$method($uri->path_query(), { %headers }, $request->content, )->res; my $response = HTTP::Response->new( $mojo_res->code(), $mojo_res->message(), [ %{$mojo_res->headers->to_hash()} ], $mojo_res->body() ); # LWP would normally do this, but we dont get down that far. $response->request($request); return $response; } sub _check_external_request { my ($self, $request) = @_; # If there's no host then definatley not an external request. $request->uri->can('host_port') or return; if ( $self->allow_external && $request->uri->host_port ne 'localhost:80' ) { return $self->SUPER::_make_request($request); } return undef; } sub _do_remote_request { my ($self, $request) = @_; my $res = $self->_check_external_request($request); return $res if $res; my $server = URI->new( $ENV{MOJO_SERVER} ); if ( $server->path =~ m|^(.+)?/$| ) { my $path = $1; $server->path("$path") if $path; # need to be quoted } # the request path needs to be sanitised if $server is using a # non-root path due to potential overlap between request path and # response path. if ($server->path) { # If request path is '/', we have to add a trailing slash to the # final request URI my $add_trailing = $request->uri->path eq '/'; my @sp = split '/', $server->path; my @rp = split '/', $request->uri->path; shift @sp;shift @rp; # leading / if (@rp) { foreach my $sp (@sp) { $sp eq $rp[0] ? shift @rp : last } } $request->uri->path(join '/', @rp); if ( $add_trailing ) { $request->uri->path( $request->uri->path . '/' ); } } $request->uri->scheme( $server->scheme ); $request->uri->host( $server->host ); $request->uri->port( $server->port ); $request->uri->path( $server->path . $request->uri->path ); return $self->SUPER::_make_request($request); } 1; __END__ =head1 NAME Test::WWW::Mechanize::Mojo - Test::WWW::Mechanize for Mojo / Mojolicious =head1 SYNOPSIS # We're in a t/*.t test script... use Test::WWW::Mechanize::Mojo; my $tester = Test::Mojo->new(); # To test a Mojo application my $mech = Test::WWW::Mechanize::Mojo->new(tester => $tester); $mech->get_ok("/"); # no hostname needed is($mech->ct, "text/html"); $mech->title_is("Root", "On the root page"); $mech->content_contains("This is the root page", "Correct content"); $mech->follow_link_ok({text => 'Hello'}, "Click on Hello"); # ... and all other Test::WWW::Mechanize methods # White label site testing $mech->host("foo.com"); $mech->get_ok("/"); =head1 DESCRIPTION L is an MVC Web Application Framework. L is a subclass of L that incorporates features for web application testing. The L module meshes the two to allow easy testing of L applications without needing to starting up a web server. Testing web applications has always been a bit tricky, normally requiring starting a web server for your application and making real HTTP requests to it. This module allows you to test L web applications but does not require a server or issue HTTP requests. Instead, it passes the HTTP request object directly to L. Thus you do not need to use a real hostname: "http://localhost/" will do. However, this is optional. The following two lines of code do exactly the same thing: $mech->get_ok('/action'); $mech->get_ok('http://localhost/action'); Links which do not begin with / or are not for localhost can be handled as normal Web requests - this is handy if you have an external single sign-on system. You must set allow_external to true for this: $mech->allow_external(1); You can also test a remote server by setting the environment variable MOJO_SERVER; for example: $ MOJO_SERVER=http://example.com/myapp prove -l t will run the same tests on the application running at http://example.com/myapp regardless of whether or not you specify http:://localhost for Test::WWW::Mechanize::Mojo. Furthermore, if you set MOJO_SERVER, the server will be regarded as a remote server even if your links point to localhost. Thus, you can use Test::WWW::Mechanize::Mojo to test your live webserver running on your local machine, if you need to test aspects of your deployment environment (for example, configuration options in an http.conf file) instead of just the Mojo request handling. This makes testing fast and easy. L provides functions for common web testing scenarios. For example: $mech->get_ok( $page ); $mech->title_is( "Invoice Status", "Make sure we're on the invoice page" ); $mech->content_contains( "Andy Lester", "My name somewhere" ); $mech->content_like( qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" ); This module supports cookies automatically. To use this module you must pass it the name of the application. See the SYNOPSIS above. Note that Mojo has a special developing feature: the debug screen. By default this module will treat responses which are the debug screen as failures. If you actually want to test debug screens, please use: $mmech->{catalyst_debug} = 1; An alternative to this module is L. =head1 CONSTRUCTOR =head2 new Behaves like, and calls, L's C method. Any params passed in get passed to WWW::Mechanize's constructor. Note that we need to pass the name of the Catalyst application to the "use": use Test::WWW::Mechanize::Catalyst; use Test::Mojo; my $tester = Test::Mojo->new(); my $mech = Test::WWW::Mechanize::Catalyst->new(tester => $tester); In addition, one can specify a C<'tester'> argument as the Test::Mojo instance. =head1 METHODS =head2 allow_external Links which do not begin with / or are not for localhost can be handled as normal Web requests - this is handy if you have an external single sign-on system. You must set allow_external to true for this: $m->allow_external(1); =head2 mojo_app The name of the Mojo app which we are testing against. Read-only. =head2 has_mojo_app For internal use. =head2 tester For internal use. =head2 host The host value to set the "Host:" HTTP header to, if none is present already in the request. If not set (default) then Catalyst::Test will set this to localhost:80 =head2 clear_host Unset the host attribute. =head2 has_host Do we have a value set for the host attribute =head2 $mech->get_ok($url, [ \%LWP_options ,] $desc) A wrapper around WWW::Mechanize's get(), with similar options, except the second argument needs to be a hash reference, not a hash. Returns true or false. =head2 $mech->title_is( $str [, $desc ] ) Tells if the title of the page is the given string. $mech->title_is( "Invoice Summary" ); =head2 $mech->title_like( $regex [, $desc ] ) Tells if the title of the page matches the given regex. $mech->title_like( qr/Invoices for (.+)/ =head2 $mech->title_unlike( $regex [, $desc ] ) Tells if the title of the page does NOT match the given regex. $mech->title_unlike( qr/Invoices for (.+)/ =head2 $mech->content_is( $str [, $desc ] ) Tells if the content of the page matches the given string =head2 $mech->content_contains( $str [, $desc ] ) Tells if the content of the page contains I<$str>. =head2 $mech->content_lacks( $str [, $desc ] ) Tells if the content of the page lacks I<$str>. =head2 $mech->content_like( $regex [, $desc ] ) Tells if the content of the page matches I<$regex>. =head2 $mech->content_unlike( $regex [, $desc ] ) Tells if the content of the page does NOT match I<$regex>. =head2 $mech->page_links_ok( [ $desc ] ) Follow all links on the current page and test for HTTP status 200 $mech->page_links_ok('Check all links'); =head2 $mech->page_links_content_like( $regex,[ $desc ] ) Follow all links on the current page and test their contents for I<$regex>. $mech->page_links_content_like( qr/foo/, 'Check all links contain "foo"' ); =head2 $mech->page_links_content_unlike( $regex,[ $desc ] ) Follow all links on the current page and test their contents do not contain the specified regex. $mech->page_links_content_unlike(qr/Restricted/, 'Check all links do not contain Restricted'); =head2 $mech->links_ok( $links [, $desc ] ) Check the current page for specified links and test for HTTP status 200. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. my @links = $mech->find_all_links( url_regex => qr/cnn\.com$/ ); $mech->links_ok( \@links, 'Check all links for cnn.com' ); my @links = qw( index.html search.html about.html ); $mech->links_ok( \@links, 'Check main links' ); $mech->links_ok( 'index.html', 'Check link to index' ); =head2 $mech->link_status_is( $links, $status [, $desc ] ) Check the current page for specified links and test for HTTP status passed. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. my @links = $mech->links(); $mech->link_status_is( \@links, 403, 'Check all links are restricted' ); =head2 $mech->link_status_isnt( $links, $status [, $desc ] ) Check the current page for specified links and test for HTTP status passed. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. my @links = $mech->links(); $mech->link_status_isnt( \@links, 404, 'Check all links are not 404' ); =head2 $mech->link_content_like( $links, $regex [, $desc ] ) Check the current page for specified links and test the content of each against I<$regex>. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. my @links = $mech->links(); $mech->link_content_like( \@links, qr/Restricted/, 'Check all links are restricted' ); =head2 $mech->link_content_unlike( $links, $regex [, $desc ] ) Check the current page for specified links and test the content of each does not match I<$regex>. The links may be specified as a reference to an array containing L objects, an array of URLs, or a scalar URL name. my @links = $mech->links(); $mech->link_content_like( \@links, qr/Restricted/, 'Check all links are restricted' ); =head2 follow_link_ok( \%parms [, $comment] ) Makes a C call and executes tests on the results. The link must be found, and then followed successfully. Otherwise, this test fails. I<%parms> is a hashref containing the params to pass to C. Note that the params to C are a hash whereas the parms to this function are a hashref. You have to call this function like: $agent->follow_like_ok( {n=>3}, "looking for 3rd link" ); As with other test functions, C<$comment> is optional. If it is supplied then it will display when running the test harness in verbose mode. Returns true value if the specified link was found and followed successfully. The HTTP::Response object returned by follow_link() is not available. =head1 CAVEATS =head2 External Redirects and allow_external If you use non-fully qualified urls in your test scripts (i.e. anything without a host, such as C<< ->get_ok( "/foo") >> ) and your app redirects to an external URL, expect to be bitten once you come back to your application's urls (it will try to request them on the remote server.) This is due to a limitation in WWW::Mechanize. One workaround for this is that if you are expecting to redirect to an external site, clone the TWMC obeject and use the cloned object for the external redirect. =head1 SEE ALSO Related modules which may be of interest: L, L, L, L. =head1 AUTHOR =head2 Of Test::WWW::Mechanize::Catalyst Ash Berlin C<< >> Original Author: Leon Brocard, C<< >> =head2 Of Test::WWW::Mechanize::Mojo Shlomi Fish, L - while disclaiming all rights. =head1 COPYRIGHT Copyright (C) 2005-8, Leon Brocard =head1 LICENSE This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Test-WWW-Mechanize-Mojo-v0.0.14/t000755000764000764 012246042416 16727 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/t/redirect.t000444000764000764 253612246042416 21060 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 28; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; my $root = "http://localhost"; my $t = Test::Mojo->new(); my $m; # TEST:$n=3; foreach my $where (qw{hi greetings bonjour}) { $m = Test::WWW::Mechanize::Mojo->new(tester => $t); # TEST*$n $m->get_ok( "$root/$where", "got something when we $where" ); # TEST*$n is( $m->base, "http://localhost/hello", "check got to hello 1/4" ); # TEST*$n is( $m->ct, "text/html", "check got to hello 2/4" ); # TEST*$n $m->title_is( "Hello",, "check got to hello 3/4" ); # TEST*$n $m->content_contains( "Hi there",, "check got to hello 4/4" ); # check that the previous response is still there my $prev = $m->response->previous; # TEST*$n ok( $prev, "have a previous" ); # TEST*$n is( $prev->code, 302, "was a redirect" ); # TEST*$n like( $prev->header('Location'), '/hello$/', "to the right place" ); } # extra checks for bonjour (which is a double redirect) my $prev = $m->response->previous->previous; # TEST ok( $prev, "have a previous previous" ); # TEST is( $prev->code, 302, "was a redirect" ); # TEST like( $prev->header('Location'), '/hi$/', "to the right place" ); $m->get("$root/redirect_with_500"); # TEST is ($m->status, 500, "Redirect not followed on 500"); Test-WWW-Mechanize-Mojo-v0.0.14/t/form_submit.t000444000764000764 145112246042416 21600 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 5; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; use Encode qw(); use Test::WWW::Mechanize::Mojo; my $root = "http://localhost"; my $t = Test::Mojo->new(); my $m = Test::WWW::Mechanize::Mojo->new( autocheck => 0, tester => $t,); # TEST $m->get_ok("$root/form"); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Form test"); my $email = "sophie\@hello.tld"; # $t->post_ok("/form-submit", # { 'Content-Type' => 'application/x-www-form-urlencoded'} , # 'email=shlomif' # ); $m->submit_form_ok( { form_id => "register", fields => { email => $email, }, }, "Was able to submit form.", ); # TEST $m->content_like( qr{Your email is \Q$email\E} ); Test-WWW-Mechanize-Mojo-v0.0.14/t/style-trailing-space.t000444000764000764 73012246042416 23271 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::TrailingSpace"; if ($@) { plan skip_all => "Test::TrailingSpace required for trailing space test."; } else { plan tests => 1; } my $finder = Test::TrailingSpace->new( { root => '.', filename_regex => qr/(?:(?:\.(?:t|pm|pl|PL|yml|json|arc|vim))|README|Changes|LICENSE|MANIFEST)\z/, }, ); # TEST $finder->no_trailing_space( "No trailing space was found." ); Test-WWW-Mechanize-Mojo-v0.0.14/t/simple.t000444000764000764 364112246042416 20546 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 25; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; use Encode qw(); use Test::WWW::Mechanize::Mojo; my $root = "http://localhost"; my $t = Test::Mojo->new(); my $m = Test::WWW::Mechanize::Mojo->new( autocheck => 0, tester => $t,); # TEST $m->get_ok("$root/"); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Root"); # TEST $m->content_contains("This is the root page"); # TEST $m->follow_link_ok( { text => 'Hello' } ); # TEST is( $m->base, "http://localhost/hello/" ); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Hello"); my $bytes = "Hi there! ☺"; my $chars = Encode::decode( 'utf-8', $bytes ); # TEST $m->content_contains( $chars, qq{content contains "$bytes"}); #use Devel::Peek; Dump $m->content; #Dump(Encode::decode('utf-8', "Hi there! ☺")); #exit; # TEST $m->get_ok("/"); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Root"); # TEST $m->content_contains("This is the root page"); # TEST $m->get_ok("http://example.com/"); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Root"); # TEST $m->content_contains("This is the root page"); # TEST $m->get_ok("/hello/"); # TEST is( $m->ct, "text/html" ); # TEST $m->title_is("Hello"); # TEST $m->content_contains( $chars, qq{content contains "$bytes"}); # TEST $m->get_ok('/with-params?one=foo&two=bar'); # TEST $m->content_contains("[foo]{bar}", "Get params are OK."); # TEST $m->get_ok('/with-params?one=sophie&two=jack'); # TEST $m->content_contains("[sophie]{jack}", "Get params (#2) are OK."); =begin remmed_out SKIP: { eval { require Compress::Zlib; }; skip "Compress::Zlib needed to test gzip encoding", 4 if $@; #===TEST $m->get_ok("$root/gzipped/"); #===TEST is( $m->ct, "text/html" ); #===TEST $m->title_is("Hello"); #==TEST $m->content_contains( $chars, qq{content contains "$bytes"}); } =end remmed_out =cut Test-WWW-Mechanize-Mojo-v0.0.14/t/pod-coverage.t000444000764000764 25412246042416 21605 0ustar00shlomifshlomif000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Test-WWW-Mechanize-Mojo-v0.0.14/t/auth-test.t000444000764000764 100012246042416 21156 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 5; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; my $t = Test::Mojo->new(); my $root = "http://localhost"; my $m = Test::WWW::Mechanize::Mojo->new(tester => $t); $m->credentials( 'user', 'pass' ); $m->get_ok("$root/check_auth_basic/"); is( $m->ct, "text/html" ); is( $m->status, 200 ); $m->credentials( 'boofar', 'pass' ); $m->get("$root/check_auth_basic/"); is( $m->ct, "text/html" ); is( $m->status, 401 ); Test-WWW-Mechanize-Mojo-v0.0.14/t/pod.t000444000764000764 22012246042416 20005 0ustar00shlomifshlomif000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD: $@" if $@; all_pod_files_ok(); Test-WWW-Mechanize-Mojo-v0.0.14/t/useragent.t000444000764000764 66112246042416 21231 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 2; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; use Encode qw(); use Test::WWW::Mechanize::Mojo; my $root = "http://localhost"; my $agent = 'TestAgent/1.0'; my $t = Test::Mojo->new(); my $m = Test::WWW::Mechanize::Mojo->new(agent => $agent, tester => $t,); $m->get_ok("$root/user_agent"); $m->title_is($agent, "title is correct: $agent"); Test-WWW-Mechanize-Mojo-v0.0.14/t/white_label.t000444000764000764 100212246042416 21521 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More tests => 4; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; use Encode qw(); use Test::WWW::Mechanize::Mojo; my $root = "http://localhost"; my $t = Test::Mojo->new(); my $m = Test::WWW::Mechanize::Mojo->new( tester => $t,); $m->host('foo.com'); # TEST $m->get_ok('/host'); # TEST $m->content_contains('Host: foo.com'); $m->clear_host; # TEST $m->get_ok('/host'); # TEST $m->content_contains('Host: localhost') or diag $m->content; Test-WWW-Mechanize-Mojo-v0.0.14/t/cookies.t000444000764000764 61012246042416 20662 0ustar00shlomifshlomif000000000000#!perl use strict; use warnings; use Test::More; use Test::More tests => 3; use Test::Mojo; use Test::WWW::Mechanize::Mojo; require "t/lib/mojjy.pl"; my $t = Test::Mojo->new(); my $root = "http://localhost"; my $m = Test::WWW::Mechanize::Mojo->new(tester => $t); $m->credentials( 'user', 'pass' ); # TEST $m->get_ok("/"); # TEST $m->title_is("Root"); # TEST is( $m->status, 200 ); Test-WWW-Mechanize-Mojo-v0.0.14/t/lib000755000764000764 012246042416 17475 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/t/lib/ExternalCatty.pm000444000764000764 224012246042416 22755 0ustar00shlomifshlomif000000000000package ExternalCatty; use strict; use warnings; use Catalyst qw/-Engine=HTTP/; our $VERSION = '0.01'; __PACKAGE__->config( name => 'ExternalCatty' ); __PACKAGE__->setup; sub default : Private { my ( $self, $c ) = @_; $c->response->content_type('text/html; charset=utf-8'); $c->response->output( html( 'Root', 'Hello, test ☺!' ) ); } # redirect to a redirect sub hello: Global { my ( $self, $context ) = @_; my $where = $context->uri_for('/'); $context->response->redirect($where); return; } sub html { my ( $title, $body ) = @_; return qq[ $title $body ]; } # The Cat HTTP server background option is useless here :-( # Thus we have to provide our own background method. sub background { my $self = shift; my $port = shift; my $child = fork; die "Can't fork Cat HTTP server: $!" unless defined $child; return $child if $child; if ( $^O !~ /MSWin32/ ) { require POSIX; POSIX::setsid() or die "Can't start a new session: $!"; } $self->run($port); } 1; Test-WWW-Mechanize-Mojo-v0.0.14/t/lib/Catty.pm000444000764000764 674412246042416 21267 0ustar00shlomifshlomif000000000000package Catty; use strict; use warnings; #use Catalyst; use Catalyst; use Cwd; use MIME::Base64; use Encode qw//; our $VERSION = '0.01'; Catty->config( name => 'Catty', root => cwd . '/t/root', ); Catty->setup(); Catty->log->levels("fatal"); sub default : Private { my ( $self, $context ) = @_; my $html = html( "Root", "This is the root page" ); $context->response->content_type("text/html"); $context->response->output($html); } sub hello : Global { my ( $self, $context ) = @_; my $str = Encode::encode('utf-8', "\x{263A}"); # ☺ my $html = html( "Hello", "Hi there! $str" ); $context->response->content_type("text/html; charset=utf-8"); $context->response->output($html); } # absolute redirect sub hi : Global { my ( $self, $context ) = @_; my $where = $context->uri_for('hello'); $context->response->redirect($where); return; } # partial (relative) redirect sub greetings : Global { my ( $self, $context ) = @_; $context->response->redirect("hello"); return; } # redirect to a redirect sub bonjour : Global { my ( $self, $context ) = @_; my $where = $context->uri_for('hi'); $context->response->redirect($where); return; } sub check_auth_basic : Global { my ( $self, $context ) = @_; my $auth = $context->req->headers->authorization; ($auth) = $auth =~ /Basic\s(.*)/i; $auth = decode_base64($auth); if ( $auth eq "user:pass" ) { my $html = html( "Auth", "This is the auth page" ); $context->response->content_type("text/html"); $context->response->output($html); return $context; } else { my $html = html( "Auth", "Auth Failed!" ); $context->response->content_type("text/html"); $context->response->output($html); $context->response->status("401"); return $context; } } sub redirect_with_500 : Global { my ( $self, $c ) = @_; $DB::single = 1; $c->res->redirect( $c->uri_for("/bonjour")); die "erk!"; } sub die : Global { my ( $self, $context ) = @_; my $html = html( "Die", "This is the die page" ); $context->response->content_type("text/html"); $context->response->output($html); die "erk!"; } sub name : Global { my ($self, $c) = @_; my $html = html( $c->config->{name}, "This is the die page" ); $c->response->content_type("text/html"); $c->response->output($html); } sub host : Global { my ($self, $c) = @_; my $host = $c->req->header('Host') || ""; my $html = html( $c->config->{name}, "Host: $host" ); $c->response->content_type("text/html"); $c->response->output($html); } sub html { my ( $title, $body ) = @_; return qq{ $title $body Hello. }; } sub gzipped : Global { my ( $self, $c ) = @_; # If done properly this test should check the accept-encoding header, but we # control both ends, so just always gzip the response. require Compress::Zlib; my $html = html( "Hello", "Hi there! ☺" ); $c->response->content_type("text/html; charset=utf-8"); $c->response->output( Compress::Zlib::memGzip($html) ); $c->response->content_encoding('gzip'); $c->response->headers->push_header( 'Vary', 'Accept-Encoding' ); } sub user_agent : Global { my ( $self, $c ) = @_; my $html = html($c->req->user_agent, $c->req->user_agent); $c->response->content_type("text/html; charset=utf-8"); $c->response->output( $html ); } 1; Test-WWW-Mechanize-Mojo-v0.0.14/t/lib/mojjy.pl000555000764000764 751012246042416 21325 0ustar00shlomifshlomif000000000000#!/usr/bin/env perl use Mojolicious::Lite; use MIME::Base64; use Encode qw//; use Cwd; use utf8; sub html { my ( $title, $body ) = @_; return qq{ $title $body Hello. }; } get '/check_auth_basic/' => sub { my $self = shift; my $auth = $self->req->headers->header("Authorization"); ($auth) = $auth =~ /Basic\s(.*)/i; $auth = decode_base64($auth); if ( $auth eq "user:pass" ) { my $html = html( "Auth", "This is the auth page" ); $self->render(text => $html); return; } else { my $html = html( "Auth", "Auth Failed!" ); $self->render(text => $html, status => "401",); return; } }; get "/hi" => sub { my $self = shift; $self->redirect_to('/hello'); return; }; get "/greetings" => sub { my $self = shift; # This relative URL is something that Catalyst eats and appears # in Catty.pm , but Mojo won't accept. # -- Shlomi Fish # $self->redirect_to('hello'); $self->redirect_to('/hello'); return; }; get "/bonjour" => sub { my $self = shift; $self->redirect_to('/hi'); return; }; get '/hello' => sub { my $self = shift; my $html = html( "Hello", "Hi there! ☺" ); # ☺ $self->res->headers->content_type("text/html; charset=utf-8"); $self->render(text => $html); return; }; get '/redirect_with_500' => sub { my $self = shift; $self->redirect_to('/bonjour'); die "erk!"; }; get "/die/" => sub { my $self = shift; my $html = html( "Die", "This is the die page" ); $self->render(text => $html); die "erk!"; }; sub _gzipped { my $self = shift; # If done properly this test should check the accept-encoding header, but we # control both ends, so just always gzip the response. require Compress::Zlib; my $html = html( "Hello", "Hi there! ☺" ); $self->res->headers->content_type("text/html; charset=utf-8"); $self->render(text => Compress::Zlib::memGzip($html) ); $self->res->headers->content_transfer_encoding('gzip'); $self->res->headers->add( 'Vary', 'Accept-Encoding' ); return; } get "/gzipped/" => \&_gzipped; get "/user_agent" => sub { my $self = shift; my $agent = $self->req->headers->user_agent(); my $html = html($agent, $agent); $self->render(text => $html); $self->res->headers->content_type("text/html; charset=utf-8"); return; }; get "/host" => sub { my $self = shift; my $host = $self->req->headers->header('Host') || ""; my $html = html( "Foo", "Host: $host" ); $self->render(text => $html); return; }; post "/form-submit" => sub { my $self = shift; my $html = html( "Foo", "Your email is " . $self->param("email")); $self->render(text => $html); return; }; get "/form" => sub { my $self = shift; $self->render(text => <<'EOF'); Form test
Email:
EOF return; }; get '/with-params' => sub { my $self = shift; $self->render(text => sprintf("[%s]{%s}", $self->param('one'), $self->param('two'))); }; get '/:groovy' => sub { my $self = shift; $self->render(text => $self->param('groovy'), layout => 'funky'); }; get '/' => sub { my $self = shift; $self->render(text => html("Root", "This is the root page")); return; }; app->start; =head1 TODO * Add a status (Not logged-in / Logged in as something) ruler to the top. =cut __DATA__ @@ layouts/funky.html.ep Foo Bar <%== content %> Test-WWW-Mechanize-Mojo-v0.0.14/t/lib/CattySession.pm000444000764000764 172312246042416 22623 0ustar00shlomifshlomif000000000000package CattySession; use strict; #use Catalyst; use Catalyst qw/ Session Session::State::Cookie Session::Store::Dummy /; use Cwd; use MIME::Base64; our $VERSION = '0.01'; CattySession->config( name => 'CattySession', root => cwd . '/t/root', ); CattySession->setup(); sub auto : Private { my ( $self, $context ) = @_; if ( $context->session ) { return 1; } } sub default : Private { my ( $self, $context ) = @_; my $html = html( "Root", "This is the root page" ); $context->response->content_type("text/html"); $context->response->output($html); } sub name : Global { my ($self, $c) = @_; my $html = html( $c->config->{name}, "This is the die page" ); $c->response->content_type("text/html"); $c->response->output($html); } sub html { my ( $title, $body ) = @_; return qq{ $title $body Hello. }; } 1; Test-WWW-Mechanize-Mojo-v0.0.14/scripts000755000764000764 012246042416 20153 5ustar00shlomifshlomif000000000000Test-WWW-Mechanize-Mojo-v0.0.14/scripts/tag-release.pl000444000764000764 71312246042416 23017 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use IO::All; my ($version) = (map { m{\$VERSION *= *'([^']+)'} ? ($1) : () } io->file('lib/Test/WWW/Mechanize/Mojo.pm')->getlines() ) ; if (!defined ($version)) { die "Version is undefined!"; } my @cmd = ( "hg", "tag", "-m", "Tagging the Test-WWW-Mechanize-Mojo release as $version", "releases/$version", ); print join(" ", map { /\s/ ? qq{"$_"} : $_ } @cmd), "\n"; exec(@cmd);