[Jifty-commit] r3771 - in Test-WWW-Declare: lib/Test/WWW
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Fri Aug 3 13:14:06 EDT 2007
Author: sartak
Date: Fri Aug 3 13:14:06 2007
New Revision: 3771
Modified:
Test-WWW-Declare/ (props changed)
Test-WWW-Declare/lib/Test/WWW/Declare.pm
Log:
r29865 at caladan: sartak | 2007-08-03 13:13:56 -0400
many little fixes
Modified: Test-WWW-Declare/lib/Test/WWW/Declare.pm
==============================================================================
--- Test-WWW-Declare/lib/Test/WWW/Declare.pm (original)
+++ Test-WWW-Declare/lib/Test/WWW/Declare.pm Fri Aug 3 13:14:06 2007
@@ -1,16 +1,14 @@
package Test::WWW::Declare;
use warnings;
use strict;
-use base qw/Test::More/;
-
-
-our $VERSION = '0.00';
-
-use base 'Exporter';
+use base 'Test::More', 'Exporter';
use WWW::Mechanize;
use Test::Builder;
-our @EXPORT = qw(flow run get session check mech match follow link content should click href button fill form SKIP);
+our $VERSION = '0.00';
+
+our @EXPORT = qw(flow run get session check mech match follow link content
+ should click href button fill form SKIP);
our $BUILDER = Test::Builder->new();
our $WWW_MECHANIZE;
@@ -18,136 +16,152 @@
=head2 import_extra
-Called by L<Test::More>'s C<import> code when L<Jifty::Test> is first
-C<use>'d, it calls L</setup>, and asks Test::More to export its
-symbols to the namespace that C<use>'d this one.
+Called by L<Test::More>'s C<import> code when L<Test::WWW::Declare> is first
+C<use>'d, it asks Test::More to export its symbols to the namespace that
+C<use>'d this one.
=end private
=cut
sub import_extra {
- my $class = shift;
- my $args = shift;
- $class->setup($args);
Test::More->export_to_level(2);
}
-sub setup { }
-
-sub SKIP ($) {
- my $reason = shift;
- die "SKIP: $reason";
+# DSLey functions
+sub should ($) {
+ return shift;
}
-
-sub flow ($$) {
- my $definition = shift;
- my $coderef = shift;
- eval { $coderef->(); };
- if ($@ =~/^SKIP: (.*)$/) {
- my $reason = $1;
- $BUILDER->skip($reason);
- } elsif ($@) {
- $BUILDER->ok(0, $definition. ": ". $@);
- die $@;
- } else {
- $BUILDER->ok(1,$definition);
- }
+sub match ($) {
+ return shift;
}
sub check (&) {
my $coderef = shift;
+
return $coderef;
}
-sub run (&) {
+
+sub run (&) {
my $coderef = shift;
- return $coderef;
-}
-sub get {
- my $url = shift;
- mech()->get($url);
+ return $coderef;
}
+# Mech interactions
sub mech {
return $WWW_MECHANIZE;
}
-sub session ($$) {
- my $title = shift;
- my $coderef = shift;
- local $WWW_MECHANIZE = WWW::Mechanize->new();
- eval { $coderef->() };
- if ($@ =~/^SKIP: (.*)$/) {
- my $reason = $1;
- $BUILDER->skip($reason);
- } elsif ($@) {
- $BUILDER->ok(0, $title );
- } else {
- $BUILDER->ok(1,$title);
- }
+sub get {
+ my $url = shift;
+ mech()->get($url);
}
-
-sub match ($) {
- return shift;
+sub href ($) {
+ return (shift, 'href');
}
-sub follow_link {
- my $ret = mech->follow_link(@_);
- unless ($ret) {
- die "click couldn't find a link matching ".join(',', at _) . mech->content;
- }
-
+sub button ($) {
+ return (shift, 'button');
}
-
-sub href ($) { return (shift , 'href') }
-sub button ($) { return( shift , 'button') }
-
-sub click {
+sub click {
my $link = shift;
- my $type;
- $type = shift if ($_[0]);
- my $ret;
+ my $type = shift;
+
if ($type eq 'button') {
return mech()->click_button(value => $link);
}
else {
- unless (ref $link eq 'Regexp') {
- die "click doesn't know what to do with a link type of ".ref($link);
- }
+ if (ref $link ne 'Regexp') {
+ die "click doesn't know what to do with a link type of "
+ . ref($link);
+ }
return follow_link(text_regex => $link);
}
}
+sub follow_link {
+ my $ret = mech()->follow_link(@_);
+
+ if (!$ret) {
+ die "follow_link couldn't find a link matching "
+ . "(" . join(', ', @_) . ")"
+ . " in: " . mech()->content;
+ }
+}
+
sub content ($) {
my $regex = shift;
- unless ( mech()->content =~ /$regex/ ) {
+
+ if (mech()->content !~ /$regex/) {
die "Content did not match $regex";
}
-
-}
-
-sub should ($) {
- my $item = shift;
- return $item;
}
sub form ($$) {
my $form_name = shift;
my $data = shift;
- mech()->form_name($form_name);
- return ($data);
+
+ mech()->form_name($form_name);
+ return $data;
}
sub fill {
- my $data = shift; # as a hashref
+ my $data = shift;
+
+ die "fill expects a hashref" if ref($data) ne 'HASH';
+
mech()->set_fields(%{$data});
}
+# the meat of the module
+sub SKIP ($) {
+ my $reason = shift;
+
+ die "SKIP: $reason";
+}
+
+sub flow ($$) {
+ my $definition = shift;
+ my $coderef = shift;
+
+ eval { $coderef->() };
+
+ if ($@ =~ /^SKIP: (.*)$/) {
+ my $reason = $1;
+ $BUILDER->skip($reason);
+ }
+ elsif ($@) {
+ $BUILDER->ok(0, $definition. ": ". $@);
+ die $@;
+ }
+ else {
+ $BUILDER->ok(1, $definition);
+ }
+}
+
+sub session ($$) {
+ my $title = shift;
+ my $coderef = shift;
+
+ local $WWW_MECHANIZE = WWW::Mechanize->new();
+ eval { $coderef->() };
+
+ if ($@ =~/^SKIP: (.*)$/) {
+ my $reason = $1;
+ $BUILDER->skip($reason);
+ }
+ elsif ($@) {
+ $BUILDER->ok(0, $title);
+ }
+ else {
+ $BUILDER->ok(1, $title);
+ }
+}
1;
More information about the Jifty-commit
mailing list