gistfile1.perl

diff --git a/t/Asset/Post.t b/t/Asset/Post.t
index 0d5535d..81fa892 100644
--- a/t/Asset/Post.t
+++ b/t/Asset/Post.t
@@ -59,23 +59,22 @@ my $collab = $node->addChild({className => 'WebGUI::Asset::Wobject::Collaboratio
 my $postingUser         = WebGUI::User->new($session, 'new');
 my $otherUser           = WebGUI::User->new($session, 'new');
 my $groupIdEditUser     = WebGUI::User->new($session, 'new');
-my $groupToEditPost     = WebGUI::Group->new($session, $collab->get('groupToEditPost'));
-my $groupIdEditGroup    = WebGUI::Group->new($session, $collab->get('groupIdEdit'));
+my $groupToEditPostId   = $collab->get('groupToEditPost');
+my $groupIdEdit         = $collab->get('groupIdEdit');
 WebGUI::Test->usersToDelete($postingUser, $otherUser, $groupIdEditUser);
 $postingUser->username('userForPosting');
 $otherUser->username('otherUser');
-WebGUI::Test->groupsToDelete($groupToEditPost, $groupIdEditGroup);
 
 # Add the posting user to the group allowd to post.
 $postingUser->addToGroups([$collab->get('postGroupId')]);
 
 # Add $otherUser to $groupToEditPost so that they can edit the posts after the
 # timeout has expired.
-$otherUser->addToGroups([$groupToEditPost->getId]);
+$otherUser->addToGroups([$groupToEditPostId]);
 
 # Similarly, add $groupIdEditUser to $groupIdEditGroup so that they, too, can
 # edit posts after the timeout has expired.
-$groupIdEditUser->addToGroups([$groupIdEditGroup->getId]);
+$groupIdEditUser->addToGroups([$groupIdEdit]);
 
 # We need to become $postingUser to ensure that the canEdit tests below use
 # $postingUser's credentials rather than the default user assigned to the
diff --git a/t/Asset/Post/Thread/permission.t b/t/Asset/Post/Thread/permission.t
index a3ec331..240c58b 100644
--- a/t/Asset/Post/Thread/permission.t
+++ b/t/Asset/Post/Thread/permission.t
@@ -34,6 +34,7 @@ WebGUI::Test->usersToDelete($user{'2'});
 $user{"2"}->addToGroups( ['2'] ); # Registered user
 
 my $versionTag      = WebGUI::VersionTag->getWorking( $session );
+WebGUI::Test->tagsToRollback($versionTag);
 $versionTag->set( { name => "Collaboration Test" } );
 
 my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1 } );
@@ -120,10 +121,5 @@ $maker->prepare( {
 } )->run;
 $thread->unlock;
 
-#----------------------------------------------------------------------------
-# Cleanup
-END {
-    my $subscriptionGroup = WebGUI::Group->new($session, $thread->get('subscriptionGroupId'));
-    WebGUI::Test->groupsToDelete($subscriptionGroup);
-    $versionTag->rollback;
-}
+WebGUI::Test->addToCleanup('WebGUI::Group' => $thread->get('subscriptionGroupId'));
+
diff --git a/t/Asset/Post/permission.t b/t/Asset/Post/permission.t
index 1f9611e..dcd0fd6 100644
--- a/t/Asset/Post/permission.t
+++ b/t/Asset/Post/permission.t
@@ -35,6 +35,7 @@ $user{"2"}->addToGroups( ['2'] ); # Registered user
 
 my $versionTag      = WebGUI::VersionTag->getWorking( $session );
 $versionTag->set( { name => "Collaboration Test" } );
+WebGUI::Test->tagsToRollback($versionTag);
 
 my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1 } );
 
@@ -93,8 +94,5 @@ $maker->prepare( {
 
 #----------------------------------------------------------------------------
 # Cleanup
-END {
-    my $subscriptionGroup = WebGUI::Group->new($session, $thread->get('subscriptionGroupId'));
-    WebGUI::Test->groupsToDelete($subscriptionGroup);
-    $versionTag->rollback;
-}
+WebGUI::Test->addToCleanup('WebGUI::Group' => $thread->get('subscriptionGroupId'));
+
diff --git a/t/Session/DateTime.t b/t/Session/DateTime.t
index 4306aa6..84476bd 100644
--- a/t/Session/DateTime.t
+++ b/t/Session/DateTime.t
@@ -93,7 +93,7 @@ is ($dt->getTimeZone(), 'America/Chicago', 'getTimeZone: fetching cached version
 my $buster = WebGUI::User->new($session, "new");
 $buster->profileField('timeZone', 'Amerigo/Vespucci');
 $session->user({user => $buster});
-WebGUI::Test->usersToDelete($buster);
+my $user_guard = cleanupGuard $buster;
 is ($dt->getTimeZone(), 'America/Chicago', 'getTimeZone: time zones not in the approved list get reset to the default');
 
 my $dude = WebGUI::User->new($session, "new");
diff --git a/t/lib/WebGUI/PseudoRequest.pm b/t/lib/WebGUI/PseudoRequest.pm
index f489ebd..c1f293c 100644
--- a/t/lib/WebGUI/PseudoRequest.pm
+++ b/t/lib/WebGUI/PseudoRequest.pm
@@ -1,19 +1,5 @@
 package WebGUI::PseudoRequest;
 
-use strict;
-
-use Test::MockObject;
-
-Test::MockObject->fake_module(
-    'Apache2::Cookie',
-    new => sub {
-        my $class = shift;
-        my $self = Test::MockObject->new;
-        $self->set_isa($class);
-        $self->set_true(qw(expires domain bake));
-    }
-);
-
 =head1 LEGAL
 
  -------------------------------------------------------------------
@@ -26,6 +12,33 @@ Test::MockObject->fake_module(
   http://www.plainblack.com                     info@plainblack.com
  -------------------------------------------------------------------
 
+=cut
+
+use strict;
+
+use Test::MockObject;
+
+BEGIN {
+    Test::MockObject->fake_module(
+        'Apache2::Cookie',
+        new => sub {
+            my $class = shift;
+            my $self = Test::MockObject->new;
+            $self->set_isa($class);
+            $self->set_true(qw(expires domain bake));
+        },
+    );
+
+    Test::MockObject->fake_module('APR::Request::Apache2',
+        handle => sub {
+            return $_[1];
+        },
+    );
+}
+
+use WebGUI::PseudoRequest::Headers;
+use WebGUI::PseudoRequest::Upload;
+
 =head1 NAME
 
 Package WebGUI::PseudoRequest
@@ -40,169 +53,6 @@ Why in the world would you want to do this?  Well, when doing API testing someti
 you run across things that require a request object, but you don't really want to
 fire up Apache in order to do it.  This will let you bypass that.
 
-=cut
-
-package WebGUI::PseudoRequest::Headers;
-
-#----------------------------------------------------------------------------
-
-=head1 NAME
-
-Package WebGUI::PseudoRequest::Headers
-
-=head2 new
-
-Construct a new PseudoRequest::Headers object.  This is just for holding headers.
-It doesn't do any magic.
-
-=cut
-
-sub new {
-	my $this = shift;
-	my $class = ref($this) || $this;
-	my $self = { headers => {} };
-	bless $self, $class;
-	return $self;
-}
-
-#----------------------------------------------------------------------------
-
-=head2 set( $key, $value )
-
-Set a key, value pair in the header object.
-
-=cut
-
-sub set {
-	my $self = shift;
-	my $key = shift;
-	my $value = shift;
-	$self->{headers}->{$key} = $value;
-}
-
-#----------------------------------------------------------------------------
-
-=head2 fetch
-
-Returns the entire internal hashref of headers.
-
-=cut
-
-sub fetch {
-	my $self = shift;
-	return $self->{headers};
-}
-
-package WebGUI::PseudoRequest::Upload;
-
-#----------------------------------------------------------------------------
-
-=head1 NAME
-
-Package WebGUI::PseudoRequest::Upload
-
-=head2 new ( [$file] )
-
-Construct a new PseudoRequest::Upload object.  This is just for holding headers.
-It doesn't do any magic.
-
-=head3 $file
-
-The complete path to a file.  If this is sent to new, it will go ahead and open
-a filehandle to that file for you, saving you the need to call the fh, filename
-and filesize methods.
-
-=cut
-
-sub new {
-	my $this = shift;
-	my $class = ref($this) || $this;
-	my $self = {
-        fh       => undef,
-        size     => 0,
-        filename => '',
-        output   => '',
-    };
-    my $file = shift;
-    if ($file and -e $file) {
-        $self->{filename} = $file;
-        $self->{size} = (stat $file)[7];
-        open my $fh, '<' . $file or
-            die "Unable to open $file for reading and creating a filehandle: $!\n";
-        $self->{fh} = $fh;
-    }
-	bless $self, $class;
-	return $self;
-}
-
-#----------------------------------------------------------------------------
-
-=head2 fh ( [$value] )
-
-Getter and setter for fh.  If $value is passed in, it will set the internal filehandle in
-the object to that.  Returns the filehandle stored in the object.
-
-=cut
-
-sub fh {
-	my $self = shift;
-	my $value = shift;
-	if (defined $value) {
-		$self->{fh} = $value;
-	}
-	return $self->{fh};
-}
-
-#----------------------------------------------------------------------------
-
-=head2 filaname ( [$value] )
-
-Getter and setter for filename.  If $value is passed in, it will set the filename in
-the object to that.  Returns the filename in the object.
-
-=cut
-
-sub filename {
-	my $self = shift;
-	my $value = shift;
-	if (defined $value) {
-		$self->{filename} = $value;
-	}
-	return $self->{filename};
-}
-
-#----------------------------------------------------------------------------
-
-=head2 size ( [$value] )
-
-Getter and setter for size.  If $value is passed in, it will set the internal size in
-the object to that.  Returns the size stored in the object.
-
-=cut
-
-sub size {
-	my $self = shift;
-	my $value = shift;
-	if (defined $value) {
-		$self->{size} = $value;
-	}
-	return $self->{size};
-}
-
-sub link {
-    my $self = shift;
-    my $dest = shift;
-    return File::Copy::copy($self->filename, $dest);
-}
-
-package WebGUI::PseudoRequest;
-
-#----------------------------------------------------------------------------
-
-=head1 NAME
-
-Package WebGUI::PseudoRequest
-
 =head2 new
 
 Construct a new PseudoRequest object.  Creates a new Headers object as well and places
@@ -568,4 +418,24 @@ sub user {
 	return $self->{user};
 }
 
+#----------------------------------------------------------------------------
+
+=head2 jar ( $value )
+
+Getter and setter for cookie jar.  If $value is passed in, it will
+set the cookie jar of the object to that.  Returns the cookie jar
+hash.
+
+=cut
+
+sub jar {
+    my $self = shift;
+    my $value = shift;
+    if (defined $value) {
+        $self->{jar} = $value;
+    }
+    return $self->{jar};
+}
+
 1;
+
diff --git a/t/lib/WebGUI/PseudoRequest/Headers.pm b/t/lib/WebGUI/PseudoRequest/Headers.pm
new file mode 100644
index 0000000..f6a68db
--- /dev/null
+++ b/t/lib/WebGUI/PseudoRequest/Headers.pm
@@ -0,0 +1,67 @@
+package WebGUI::PseudoRequest::Headers;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::PseudoRequest::Headers
+
+=head2 new
+
+Construct a new PseudoRequest::Headers object.  This is just for holding headers.
+It doesn't do any magic.
+
+=cut
+
+sub new {
+	my $this = shift;
+	my $class = ref($this) || $this;
+	my $self = { headers => {} };
+	bless $self, $class;
+	return $self;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 set( $key, $value )
+
+Set a key, value pair in the header object.
+
+=cut
+
+sub set {
+	my $self = shift;
+	my $key = shift;
+	my $value = shift;
+	$self->{headers}->{$key} = $value;
+}
+
+#----------------------------------------------------------------------------
+
+=head2 fetch
+
+Returns the entire internal hashref of headers.
+
+=cut
+
+sub fetch {
+	my $self = shift;
+	return $self->{headers};
+}
+
+1;
+
diff --git a/t/lib/WebGUI/PseudoRequest/Upload.pm b/t/lib/WebGUI/PseudoRequest/Upload.pm
new file mode 100644
index 0000000..7a01d7f
--- /dev/null
+++ b/t/lib/WebGUI/PseudoRequest/Upload.pm
@@ -0,0 +1,119 @@
+package WebGUI::PseudoRequest::Upload;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com