oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add new API for mocking assets in tests

Browse source
This commit is contained in:
Graham Knop 2009-09-09 11:46:18 -05:00
parent 237af9f527
commit e6f38dcf44
2 changed files with 100 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

15
t/Workflow/Activity/GetCsMail.t
View file

@ -102,9 +102,7 @@ $post2mock->set_always('getId', $post2_id);
{
# simulate asset not found
local *WebGUI::Asset::newByDynamicClass = sub {
return undef;
};
WebGUI::Test->mockAssetId($post2_id, undef);
$getmock->set_series('getNextMessage', {
from => 'admin@localhost',
parts => ['parts'],
@ -114,12 +112,11 @@ $post2mock->set_always('getId', $post2_id);
});
$activity->execute($csmock);
is $parentAsset->getId, $cs_id, 'add as new thread to current cs if reply to nonexistant post';
WebGUI::Test->unmockAssetId($post2_id);
}
{
local *WebGUI::Asset::newByDynamicClass = sub {
return $post2mock;
};
WebGUI::Test->mockAssetId($post2_id, $post2mock);
$getmock->set_series('getNextMessage', {
from => 'admin@localhost',
parts => ['parts'],
@ -129,12 +126,11 @@ $post2mock->set_always('getId', $post2_id);
});
$activity->execute($csmock);
is $parentAsset->getId, $cs_id, 'add as new thread to current cs if reply to post in another CS';
WebGUI::Test->unmockAssetId($post2_id);
}
{
local *WebGUI::Asset::newByDynamicClass = sub {
return $postmock;
};
WebGUI::Test->mockAssetId($post_id, $postmock);
$getmock->set_series('getNextMessage', {
from => 'admin@localhost',
parts => ['parts'],
@ -144,6 +140,7 @@ $post2mock->set_always('getId', $post2_id);
});
$activity->execute($csmock);
is $parentAsset->getId, $post_id, 'add as reply to post if reply to post in current CS';
WebGUI::Test->unmockAssetId($post_id);
}
#----------------------------------------------------------------------------

94
t/lib/WebGUI/Test.pm
View file

@ -264,6 +264,100 @@ END {
}
}
=head2 mockAssetId ( $assetId, $object )
Causes WebGUI::Asset->new* initializers to return the specified
object instead of retreiving it from the database for the given
asset ID.
=cut
my %mockedAssetIds;
sub mockAssetId {
my ($class, $assetId, $object) = @_;
_mockAssetInits();
$mockedAssetIds{$assetId} = $object;
}
=head2 unmockAssetId ( $assetId )
Removes a given asset ID from being mocked.
=cut
sub unmockAssetId {
my ($class, $assetId) = @_;
delete $mockedAssetIds{$assetId};
}
=head2 mockAssetUrl ( $url, $object )
Causes WebGUI::Asset->newByUrl to return the specified object instead
of retreiving it from the database for the given URL.
=cut
my %mockedAssetUrls;
sub mockAssetUrl {
my ($url, $object) = @_;
_mockAssetInits();
$mockedAssetUrls{$url} = $object;
}
=head2 unmockAssetUrl ( $url )
Removes a given asset URL from being mocked.
=cut
sub unmockAssetUrl {
my ($class, $url) = @_;
delete $mockedAssetUrls{$url};
}
my $mockedNew;
sub _mockAssetInits {
no warnings 'redefine';
return
if $mockedNew;
require WebGUI::Asset;
my $original_new = \&WebGUI::Asset::new;
*WebGUI::Asset::new = sub {
my ($class, $session, $assetId, $className, $revisionDate) = @_;
if ($mockedAssetIds{$assetId}) {
return $mockedAssetIds{$assetId};
}
goto $original_new;
};
my $original_newByDynamicClass = \&WebGUI::Asset::newByDynamicClass;
*WebGUI::Asset::newByDynamicClass = sub {
my ($class, $session, $assetId, $revisionDate) = @_;
if ($mockedAssetIds{$assetId}) {
return $mockedAssetIds{$assetId};
}
goto $original_newByDynamicClass;
};
my $original_newPending = \&WebGUI::Asset::newPending;
*WebGUI::Asset::newPending = sub {
my ($class, $session, $assetId, $revisionDate) = @_;
if ($mockedAssetIds{$assetId}) {
return $mockedAssetIds{$assetId};
}
goto $original_newPending;
};
my $original_newByUrl = \&WebGUI::Asset::newByUrl;
*WebGUI::Asset::newByUrl = sub {
my ($class, $session, $url, $revisionDate) = @_;
if ($mockedAssetUrls{$url}) {
return $mockedAssetUrls{$url};
}
goto $original_newByUrl;
};
$mockedNew = 1;
}
#----------------------------------------------------------------------------
=head2 interceptLogging