[Jifty-commit] r2519 - in Test-WWW-Declare: lib lib/Test
lib/Test/WWW
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Wed Jan 17 21:00:33 EST 2007
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;
+
More information about the Jifty-commit
mailing list