[Jifty-commit] r3783 - in Test-WWW-Declare: lib/Test/WWW t

[jifty-commit at lists.jifty.org]

Author: sartak
Date: Fri Aug  3 17:55:12 2007
New Revision: 3783

Added:
   Test-WWW-Declare/t/06-title.t
Modified:
   Test-WWW-Declare/   (props changed)
   Test-WWW-Declare/lib/Test/WWW/Declare.pm

Log:
 r29886 at caladan:  sartak | 2007-08-03 17:55:05 -0400
 Add some more magic! `title should caselessly equal 'InDeX'` now works


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 17:55:12 2007
@@ -8,7 +8,8 @@
 our $VERSION  = '0.00';
 
 our @EXPORT = qw(flow run get session check mech match follow link content
-                 should shouldnt click href button fill form SKIP _twd_dummy);
+                 should shouldnt click href button fill form SKIP _twd_dummy
+                 title equal caselessly);
 our $BUILDER = Test::Builder->new();
 our $WWW_MECHANIZE;
 
@@ -30,15 +31,23 @@
 
 # DSLey functions
 sub should ($) {
-    return [shift, 1];
+    return {positive => 1, %{shift @_}};
 }
 
 sub shouldnt ($) {
-    return [shift, 0];
+    return {positive => 0, %{shift @_}};
 }
 
 sub match ($) {
-    return shift;
+    return {match => 'regex', expected => shift};
+}
+
+sub equal ($) {
+    return {match => 'equality', expected => shift};
+}
+
+sub caselessly ($) {
+    return {case_insensitive => 1, %{shift @_}};
 }
 
 sub check (&) {
@@ -99,15 +108,58 @@
 }
 
 sub content ($) {
-    my $regex_wrapped = shift;
-    my ($regex, $positive) = @$regex_wrapped;
+    _magic_match({got => mech()->content, name => "Content", %{shift @_}});
+}
+
+sub title ($) {
+    my $title = mech()->title;
+    _magic_match({got => $title, name => "Title '$title'", %{shift @_}});
+}
+
+# yes, there's a little too much logic in here. that's why it's magic
+sub _magic_match {
+    my $orig = shift @_;
+    my %args = %$orig;
+    my $match;
+    my @output;
+
+    push @output, $args{name};
+    push @output, $args{positive} ? "does not"
+                                  : "";
+
+    if ($args{match} eq 'equality') {
+        if ($args{case_insensitive}) {
+            push @output, "caselessly";
+            $args{got} = lc $args{got};
+            $args{expected} = lc $args{expected};
+        }
 
-    my $failure = 1;
+        push @output, $args{positive} ? "equal"
+                                      : "equals";
+        push @output, $orig->{expected};
 
-    $failure = 0 if  $positive && mech()->content =~ $regex;
-    $failure = 0 if !$positive && mech()->content !~ $regex;
 
-    Carp::croak "Content did not match $regex" if $failure;
+        $match = $args{got} eq $args{expected};
+    }
+    elsif ($args{match} eq 'regex') {
+        if ($args{case_insensitive}) {
+            push @output, "caselessly";
+            push @output, $args{expected};
+            $args{expected} = "(?i:$args{expected})";
+        }
+
+        push @output, $args{positive} ? "match"
+                                      : "matches";
+        push @output, $orig->{expected};
+
+        $match = $args{got} =~ $args{expected};
+    }
+    else {
+        Carp::croak "No \$args{match} (yes this error needs to be fixed)";
+    }
+
+    return 1 if ($match ? 0 : 1) ^ $args{positive};
+    Carp::croak join(' ', @output);
 }
 
 sub form ($$) {

Added: Test-WWW-Declare/t/06-title.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/06-title.t	Fri Aug  3 17:55:12 2007
@@ -0,0 +1,29 @@
+#!perl
+use Test::WWW::Declare::Tester tests => 5;
+use warnings;
+use strict;
+
+my @results = run_tests(
+    sub {
+        session "check logins" => run {
+            flow "basic connectivity" => check {
+                get "http://localhost:$PORT/";
+                title should match qr{in.ex}i;
+                click href qr{good};
+                title should equal 'GOOD';
+                click href qr{index};
+                title should caselessly equal 'InDeX';
+            };
+        };
+    }
+);
+
+shift @results; # Test::Tester gives 1-based arrays
+is(@results, 2, "had two tests");
+ok($results[0]{ok}, "1st test passed");
+ok($results[1]{ok}, "2nd test passed");
+
+is($results[0]{name}, "basic connectivity", "1st test was flow");
+is($results[1]{name}, "check logins", "2nd test was session");
+
+