[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