Added WebGUI::Test::Maker

t/lib/WebGUI/Test.pm

@@ -108,29 +108,123 @@ END {
     $SESSION->close if defined $SESSION;
 }
 
-sub file {
-    return $CONFIG_FILE;
-}
 
 sub config {
     return undef unless defined $SESSION;
     return $SESSION->config;
 }
 
-sub lib {
+sub file {
-    return $WEBGUI_LIB;
+    return $CONFIG_FILE;
 }
 
-sub session {
+#----------------------------------------------------------------------------
-    return $SESSION;
+
+=head2 getPage ( asset, pageName [, opts] )
+
+Get the entire response from a page request. asset is a WebGUI::Asset object.
+pageName is the name of the page subroutine to run. options is a hash reference
+of options with keys outlined below. 
+
+ args           => Array reference of arguments to the pageName sub
+ user           => A user object to set for this request
+ userId         => A userId to set for this request
+ formParams     => A hash reference of form parameters
+ uploads        => A hash reference of files to "upload"
+
+=cut
+
+sub getPage {
+    my $session     = shift;    # The session object
+    my $asset       = shift;    # The asset object
+    my $page        = shift;    # The page subroutine
+    my $optionsRef  = shift;    # A hashref of options
+                                # args      => Array ref of args to the page sub
+                                # user      => A user object to set
+                                # userId    => A user ID to set, "user" takes
+                                #              precedence
+
+    #!!! GETTING COOKIES WITH WebGUI::PseudoRequest DOESNT WORK, SO WE USE 
+    # THIS AS A WORKAROUND
+    $session->http->{_http}->{noHeader} = 1;
+    
+    # Open a buffer as a filehandle
+    my $buffer  = "";
+    open my $output, ">", \$buffer or die "Couldn't open memory buffer as filehandle: $@";
+    $session->output->setHandle($output);
+
+    # Set the appropriate user
+    my $oldUser     = $session->user;
+    if ($optionsRef->{user}) {
+        $session->user({ user => $optionsRef->{user} });
+    }
+    elsif ($optionsRef->{userId}) {
+        $session->user({ userId => $optionsRef->{userId} });
+    }
+    $session->user->uncache;
+
+    # Create a new request object
+    my $oldRequest  = $session->request;
+    my $request     = WebGUI::PseudoRequest->new;
+    $request->setup_param($optionsRef->{formParams});
+    $session->{_request} = $request;
+
+    # Fill the buffer
+    my $returnedContent = $asset->$page(@{$optionsRef->{args}});
+    if ($returnedContent && $returnedContent ne "chunked") {
+        print $output $returnedContent;
+    }
+
+    close $output;
+    
+    # Restore the former user and request
+    $session->user({ user => $oldUser });
+    $session->{_request} = $oldRequest;
+
+    #!!! RESTORE THE WORKAROUND
+    delete $session->http->{_http}->{noHeader};
+
+    # Return the page's output
+    return $buffer;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 getTestCollateralPath ( [filename] )
+
+Returns the full path to the directory containing the collateral files to be
+used for testing.
+
+Optionally adds a filename to the end.
+
+=cut
+
+sub getTestCollateralPath {
+    my $class           = shift;
+    my $filename        = shift;
+    return File::Spec->catfile($WEBGUI_TEST_COLLATERAL,$filename);
+}
+
+sub lib {
+    return $WEBGUI_LIB;
 }
 
 sub root {
     return $WEBGUI_ROOT;
 }
 
-sub getTestCollateralPath {
+sub session {
-    return $WEBGUI_TEST_COLLATERAL;
+    return $SESSION;
 }
 
+
+#----------------------------------------------------------------------------
+
+=head1 BUGS
+
+When trying to load the APR module, perl invariably throws an Out Of Memory
+error. For this reason, getPage disables header processing.
+
+=cut
+
 1;

t/lib/WebGUI/Test/Maker.pm

@@ -0,0 +1,192 @@
+package WebGUI::Test::Maker;
+
+use Test::More;
+
+
+=head1 NAME
+
+WebGUI::Test::Maker
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use WebGUI::Test::Maker;
+
+ my $maker   = WebGUI::Test::Maker->new();
+
+ $maker->set( test => sub { ... } );
+ $maker->set( plan_per_test => 2 );
+
+ $maker->prepare({
+            title       => "Test something",
+            args        => [ ... ],
+        });
+
+ plan tests => $maker->plan;
+
+ $maker->run;
+
+=head1 DESCRIPTION
+
+Test generator for generating repeatable tests. 
+
+Set a subroutine that runs some tests and run it over and over with
+different arguments.
+
+=head1 DEPENDS
+
+This module depends on
+
+=over 4
+
+=item * 
+
+Test::More
+
+=back
+
+=head1 METHODS
+
+=head2 new
+
+Create a new WebGUI::Test::Maker object.
+
+=cut
+
+sub new {
+    my $class   = shift;
+    my $self    = {};
+
+    return bless $self, $class;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 get
+
+Get a setting. Set L<set> for a list of settings.
+
+=cut
+
+sub get {
+    my $self    = shift;
+    my $key     = shift;
+
+    return $self->{_settings}->{$key};
+}
+
+#----------------------------------------------------------------------------
+
+=head2 plan
+
+Returns the number of tests currently prepared. This module is so generic
+that you must set the C<plan_per_test> value before calling this method.
+
+=cut
+
+sub plan {
+    my $self        = shift;
+    
+    return $self->plan_per_test * @{$self->{_tests}};
+}
+
+#----------------------------------------------------------------------------
+
+=head2 plan_per_test
+
+Returns the current value of the C<plan_per_test> setting.
+
+=cut
+
+sub plan_per_test {
+    return $self->get("plan_per_test");
+}
+
+#----------------------------------------------------------------------------
+
+=head2 prepare
+
+Prepare a test(s). Returns the object for convenience. The following keys 
+are optional:
+
+=over 4
+
+=item args
+
+An array reference of arguments to the subroutine.
+
+=back
+
+There are no required arguments.
+
+=cut
+
+sub prepare {
+    my $self        = shift;
+    my @tests       = @_;
+    my $test_num    = 0;
+    for my $test (@tests) {
+        $test_num++;
+
+        push @{$self->{_tests}}, $test;
+    }
+
+    return $self;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 run
+
+Run the tests we've prepared and delete them as we run them.
+
+=cut
+
+sub run {
+    my $self        = shift;
+     
+    while (my $test = shift @{ $self->{_tests} }) {
+        my $sub     = $self->get("test");
+        if ($test->{args}) {
+            $sub->(@{ $test->{args} });
+        }
+        else {
+            $sub->();
+        }
+    }
+}
+
+#----------------------------------------------------------------------------
+
+=head2 set
+
+Set a setting.
+
+Available settings:
+
+=over 4
+
+=item test
+
+A subref that runs some tests. The first argument to this subref will be the
+WebGUI::Test::Maker object. The second and subsequent arguments will be the
+C<args> key from the prepared test.
+
+=item plan_per_test
+
+Set the number of tests that each C<test> sub runs to be used to plan the 
+number of total tests that will be run.
+
+=back
+
+=cut
+
+sub set {
+    my $self    = shift;
+    my $key     = shift;
+    my $value   = shift;
+
+    $self->{_setting}->{$key} = $value;
+}
+
+1;

t/lib/WebGUI/Test/Maker/HTML.pm

@@ -0,0 +1,250 @@
+package WebGUI::Test::Maker::HTML;
+
+use base 'WebGUI::Test::Maker';
+use Scalar::Util qw( blessed );
+use Test::More;
+
+
+=head1 NAME
+
+WebGUI::Test::Maker::HTML -- Test::Maker subclass for WebGUI HTMLs
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use WebGUI::Test::Maker::HTML;
+
+ my $maker   = WebGUI::Test::Maker::HTML->new();
+
+ $maker->prepare({
+            object      => $object,
+            method      => "www_editSave",
+            user        => WebGUI::User->new,
+            userId      => "userId",
+            formParams  => { ... },
+            uploads     => { ... },
+            
+            # Test for a WebGUI::Session::Privilege page
+            test_privilege  => "permission",
+
+            # Test for some regular expressions
+            test_regex  => [ qr/../, qr/.../, ... ],
+        });
+
+ plan tests => $maker->plan;
+
+ $maker->run;
+
+=head1 DESCRIPTION
+
+This Test::Maker subclass tests the HTML output by WebGUI methods in a 
+variety of ways.
+
+Uses WebGUI::Test->getPage to get the HTML for a page, and so is limited
+to whatever C<getPage> can access.
+
+=head1 TODO
+
+Provide a method to give a proper HTML::Parser to test with.
+
+Provide a method to test that a certain page was created with a certain 
+template.
+
+=head1 DEPENDS
+
+This module depends on
+
+=over 4
+
+=item * 
+
+Test::More
+
+=back
+
+=head1 METHODS
+
+=head2 new
+
+Create a new WebGUI::Test::Maker::HTML object.
+
+=head2 get
+
+Get a setting. Set L<set> for a list of settings.
+
+#----------------------------------------------------------------------------
+
+=head2 plan
+
+This module plans as follows:
+
+    - 1 and only 1 test for any test_privilege test
+    - 1 test for each member of a test_regex test
+
+=cut
+
+sub plan {
+    my $self        = shift;
+    my $plan;
+    
+    for my $test ( @{ $self->{_tests} } ) {
+        if ($test->{test_privilege}) {
+            $plan++;
+            next;
+        }
+        if ($test->{test_regex}) {
+            $plan += @{$test->{test_regex}};
+        }
+    }
+
+    return $plan;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 plan_per_test
+
+Returns undef. There is no way to pre-calculate how many tests this will run
+
+=cut
+
+sub plan_per_test {
+    return undef;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 prepare
+
+Prepare a test(s). Returns the object for convenience. The following keys 
+are required:
+
+=over 4
+
+=item object
+
+An instanciated object to work on.
+
+=item method
+
+The permissions method to test
+
+=back
+
+At least one of the following keys are required:
+
+=over 4
+
+=item test_privilege
+
+Tests for a WebGUI::Session::Privilege response. Valid values for this key
+are: adminOnly, insufficient, noAccess, notMember, vitalComponent
+
+=item test_regex
+
+Tests for some regular expressions. This key must be an array reference of 
+qr().
+
+=back
+
+The following key are optional:
+
+=over 4
+
+=item user
+
+A WebGUI::User object to use for the test.
+
+=item userId
+
+A user ID to make a WebGUI::User object to use for the test
+
+=item formParams
+
+A hash reference of form parameters to use for the test
+
+=item uploads 
+
+A hash reference of file uploads to use for the test
+
+=back
+
+=cut
+
+sub prepare {
+    my $self        = shift;
+    my @tests       = @_;
+    my $test_num    = 0;
+    for my $test (@tests) {
+        $test_num++;
+
+        croak("Couldn't prepare: Test $test_num has no object")
+            unless $test->{object};
+        croak("Couldn't prepare: Test $test_num has no method")
+            unless $test->{method};
+        croak("Couldn't prepare: Test $test_num has test (test_privilege or test_regex)")
+            unless $test->{test_privilege} || $test->{test_regex};
+        croak("Couldn't prepare: Test $test_num, test_regex is not an array reference")
+            if $test->{test_regex} && ref $test->{test_regex} ne "ARRAY";
+        croak("Couldn't prepare: Test $test_num, $test->{test_privilege} is not a valid test_privilege value (adminOnly, insufficient, noAccess, notMember, vitalComponent)")
+            if $test->{test_privilege} && $test->{test_privilege} =~ m/adminOnly|insufficient|noAccess|notMember|vitalComponent/;
+
+        push @{$self->{_tests}}, $test;
+    }
+
+    return $self;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 run
+
+Run the tests we've prepared and delete them as we run them.
+
+=cut
+
+sub run {
+    my $self        = shift;
+     
+    while (my $test = shift @{ $self->{_tests} }) {
+        my $o       = $test->{object};
+        my $m       = $test->{method};
+    
+        # Get the HTML
+        my $opts    = {};
+        for my $key (qw{ }) {
+            $opts->{$key} = $test->{$key};
+        }
+
+        my $html
+            = WebGUI::Test->getPage( $o, $m, $opts );
+
+        # Run the tests
+        if ($test->{test_privilege}) {
+            my $priv_method = $test->{test_privilege};
+            my $test        = $o->session->privilege->$priv_method();
+
+            like( $html, $test, "$m contains privilege message $priv_method for object " . blessed $o );
+
+            next;
+        }
+        
+        if ($test->{test_regex}) {
+            for my $regex ( @{ $test->{test_regex} } ) {
+                like( $html, $regex, "$m contains $regex for object " . blessed $o );
+            }
+        }
+    }
+}
+
+#----------------------------------------------------------------------------
+
+=head2 set
+
+Set a setting.
+
+Currently this module has no settings
+
+=cut
+
+1;

t/lib/WebGUI/Test/Maker/Permission.pm

@@ -0,0 +1,207 @@
+package WebGUI::Test::Maker::Permission;
+
+use base 'WebGUI::Test::Maker';
+use Scalar::Util qw( blessed );
+use Test::More;
+
+
+=head1 NAME
+
+WebGUI::Test::Maker::Permission -- Test::Maker subclass for WebGUI Permissions
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use WebGUI::Test::Maker::Permission;
+
+ my $maker   = WebGUI::Test::Maker::Permission->new();
+
+ $maker->prepare({
+            object      => WebGUI::Asset->new,
+            method      => "canView",
+            pass        => [userId, userId],
+            fail        => [userId, userId],
+        });
+
+ plan tests => $maker->plan;
+
+ $maker->run;
+
+=head1 DESCRIPTION
+
+Test generator for testing WebGUI permissions. WebGUI permissions subroutines
+take a single argument (a userId), or they use the default user from the
+current session. They return true if the user has permission, or false 
+otherwise.
+
+This module tests permissions subroutines by running a list of userIds that
+should either pass or fail the permissions. 
+
+=head1 DEPENDS
+
+This module depends on
+
+=over 4
+
+=item * 
+
+Test::More
+
+=back
+
+=head1 METHODS
+
+=head2 new
+
+Create a new WebGUI::Test::Maker::Permission object.
+
+=head2 get
+
+Get a setting. Set L<set> for a list of settings.
+
+#----------------------------------------------------------------------------
+
+=head2 plan
+
+Returns the number of tests currently prepared. This module runs two tests 
+for each userId in either the C<pass> or C<fail> keys of the C<prepare()>
+hash reference.
+
+=cut
+
+sub plan {
+    my $self        = shift;
+    my $plan;
+    
+    for my $test ( @{$self->{_tests}} ) {
+        if ($test->{pass}) {
+            $plan += @{$test->{pass}} * 2;
+        }
+        if ($test->{fail}) {
+            $plan += @{$test->{fail}} * 2;
+        }
+    }
+
+    return $plan;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 plan_per_test
+
+Returns undef. There is no way to pre-calculate how many tests this will run
+
+=cut
+
+sub plan_per_test {
+    return undef;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 prepare
+
+Prepare a test(s). Returns the object for convenience. The following keys 
+are required:
+
+=over 4
+
+=item object
+
+An instanciated object to work on.
+
+=item method
+
+The permissions method to test
+
+=item pass
+
+An array reference of userIds that should pass the permissions test.
+
+=item fail
+
+An array reference of userIds that should fail the permissions test.
+
+=back
+
+There are no optional parameters.
+
+=cut
+
+sub prepare {
+    my $self        = shift;
+    my @tests       = @_;
+    my $test_num    = 0;
+    for my $test (@tests) {
+        $test_num++;
+
+        croak("Couldn't prepare: Test $test_num has no object")
+            unless $test->{object};
+        croak("Couldn't prepare: Test $test_num has no method")
+            unless $test->{method};
+        croak("Couldn't prepare: Test $test_num has no pass/fail")
+            unless $test->{pass} || $test->{fail};
+        croak("Couldn't prepare: Test $test_num, pass is not an array reference")
+            if $test->{pass} && ref $test->{pass} ne "ARRAY";
+        croak("Couldn't prepare: Test $test_num, fail is not an array reference")
+            if $test->{fail} && ref $test->{fail} ne "ARRAY";
+
+        push @{$self->{_tests}}, $test;
+    }
+
+    return $self;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 run
+
+Run the tests we've prepared and delete them as we run them.
+
+=cut
+
+sub run {
+    my $self        = shift;
+     
+    while (my $test = shift @{ $self->{_tests} }) {
+        my $o       = $test->{object};
+        my $m       = $test->{method};
+
+        if ($test->{pass}) {
+            for my $userId (@{$test->{pass}}) {
+                # Test the userId parameter
+                ok( $o->$m($userId), "$userId passes $m check for " . blessed $o );
+
+                # Test the default session user
+                my $oldUser = $o->session->user;
+                $o->session->user( WebGUI::User->new($o->session, $userId) );
+                ok( $o->$m(), "$userId passes $m check using default user for " . blessed $o );
+                $o->session->user($oldUser);
+            }
+        }
+        if ($test->{fail}) {
+            for my $userId (@{$test->{fail}}) {
+                # Test the userId parameter
+                ok( !($o->$m($userId)), "$userId fails $m check for " . blessed $o );
+
+                # Test the default session user
+                my $oldUser = $o->session->user;
+                $o->session->user( WebGUI::User->new($o->session, $userId) );
+                ok( !($o->$m()), "$userId fails $m check using default user for " . blessed $o );
+                $o->session->user($oldUser);
+            }
+        }
+    }
+}
+
+#----------------------------------------------------------------------------
+
+=head2 set
+
+Set a setting.
+
+Currently this module has no settings
+
+=cut
+
+1;