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

[jifty-commit at lists.jifty.org]

Author: jesse
Date: Wed Jan 17 21:00:31 2007
New Revision: 2519

Added:
   Test-WWW-Declare/README
   Test-WWW-Declare/lib/
   Test-WWW-Declare/lib/Test/
   Test-WWW-Declare/lib/Test/WWW/
   Test-WWW-Declare/lib/Test/WWW/Declare.pm
Modified:
   Test-WWW-Declare/   (props changed)

Log:
 r21021 at hualien:  jesse | 2007-01-17 01:12:04 -0500
  * cleaner more katamari-ish implementation


Added: Test-WWW-Declare/README
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/README	Wed Jan 17 21:00:31 2007
@@ -0,0 +1 @@
+This is only a prototype. If this were an actual distribution, there would be tests and docs. To say nothing of full functionality.

Added: Test-WWW-Declare/lib/Test/WWW/Declare.pm
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/lib/Test/WWW/Declare.pm	Wed Jan 17 21:00:31 2007
@@ -0,0 +1,109 @@
+package Test::WWW::Declare;
+use warnings;
+use strict;
+
+
+our $VERSION  = '0.00';
+
+use Exporter;
+use WWW::Mechanize;
+use Test::Builder;
+
+our @EXPORT = qw(flow run get session);
+our $BUILDER = Test::Builder->new();
+$BUILDER->no_plan();
+our $WWW_MECHANIZE;
+
+sub flow ($$) {
+    my $definition = shift;
+    my $coderef = shift;
+    eval {  $coderef->(); };
+    if ($@) {
+        $BUILDER->ok(0, $definition. ": ". $@);
+        die $@;
+    } else {
+        $BUILDER->ok(1,$definition);
+    }
+}
+
+sub check (&) {
+    my $coderef = shift;
+    return $coderef;
+}
+sub  run (&) {
+    my $coderef = shift;
+    return $coderef;
+}
+
+sub get {
+    my $url = shift;
+    mech()->get($url);
+}
+
+sub mech {
+    return $WWW_MECHANIZE;
+}
+
+sub session ($$) {
+   my $title = shift;
+   my $coderef = shift;
+    local $WWW_MECHANIZE = WWW::Mechanize->new();
+    eval { $coderef->() };
+    if ($@) {
+        $BUILDER->ok(0, $title );
+    } else {
+        $BUILDER->ok(1,$title);
+    }
+
+}
+
+
+sub match ($) {
+    return shift;
+}
+
+sub follow_link {
+    my $ret = mech->follow_link(@_);
+    unless ($ret) {
+        die "click couldn't find a link matching ".join(',', at _) . mech->content;
+    }
+
+}
+
+
+sub href ($) { return shift }
+
+sub click ($) {
+    my $link = shift;
+    my $ret;
+    unless (ref $link eq 'Regexp') {
+        die "click doesn't know what to do with a link type of ".ref($link);
+    } 
+        return follow_link(text_regex => $link);
+}
+
+sub content ($) {
+    my $regex = shift;
+    unless ( mech()->content =~ /$regex/ ) {
+        die "Content did not match $regex";
+    }
+
+}
+
+sub should ($) {
+    my $item = shift;
+    return $item;
+}
+
+session "check logins" => run {
+    flow "basic connectivity" => check {
+        get 'http://fsck.com';
+        content should match qr{fsck.com};
+        click href qr{book};
+        content should match qr{RT Essentials}i;
+    };
+
+};
+
+1;
+