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

Added more tests. Cleaned up the OO of File and Image a bit (removed a healthy bit of unnecessary code from Image). Done with File and Image for the time being...

Browse source
This commit is contained in:
Doug Bell 2007-10-09 07:36:54 +00:00
parent fad056cfa5
commit 5746ded766
12 changed files with 523 additions and 119 deletions
Download patch file Download diff file Expand all files Collapse all files

99
lib/WebGUI/Asset/File.pm
View file

@ -16,6 +16,7 @@ package WebGUI::Asset::File;
use strict;
use base 'WebGUI::Asset';
use Carp;
use WebGUI::Cache;
use WebGUI::Storage;
use WebGUI::SQL;
@ -58,7 +59,7 @@ sub addRevision {
my $properties = shift;
if ($self->get("storageId") ne "") {
my $newStorage = WebGUI::Storage->get($self->session,$self->get("storageId"))->copy;
my $newStorage = $self->getStorageClass->get($self->session,$self->get("storageId"))->copy;
$properties->{storageId} = $newStorage->getId;
}
@ -221,20 +222,31 @@ sub getIcon {
}
#----------------------------------------------------------------------------
=head2 getStorageClass
Get the full classname of the WebGUI::Storage we should use for this asset.
=cut
sub getStorageClass {
return 'WebGUI::Storage';
}
#-------------------------------------------------------------------
=head2 getStorageFromPost
We have to wrap this operation because WebGUI::Asset::File::Image calls SUPER processPropertiesFormFormPost,
which gives it the wrong type of Storage object.
Get the storage location created by the form post.
=cut
sub getStorageFromPost {
my $self = shift;
my $self = shift;
my $storageId = shift;
my $fileStorageId = WebGUI::Form::File->new($self->session, {name => 'newFile', value=>$storageId })->getValueFromPost;
return WebGUI::Storage->get($self->session, $fileStorageId);
return $self->getStorageClass->get($self->session, $fileStorageId);
}
@ -300,23 +312,23 @@ sub processPropertiesFromFormPost {
$storageLocation->clear();
}
#Pass in the storage Id to prevent another one from being created.
# Pass in the storage Id to prevent another one from being created.
my $storage = $self->getStorageFromPost($storageId);
if (defined $storage) {
my $filename = $storage->getFiles()->[0];
if (defined $storage) {
my $filename = $storage->getFiles()->[0];
if (defined $filename) {
my %data;
$data{filename} = $filename;
$data{storageId} = $storage->getId;
$data{title} = $filename unless ($session->form->process("title"));
$data{menuTitle} = $filename unless ($session->form->process("menuTitle"));
$data{url} = $self->getParent->get('url').'/'.$filename unless ($session->form->process("url"));
if (defined $filename) {
my %data;
$data{filename} = $filename;
$data{storageId} = $storage->getId;
$data{title} = $filename unless ($session->form->process("title"));
$data{menuTitle} = $filename unless ($session->form->process("menuTitle"));
$data{url} = $self->getParent->get('url').'/'.$filename unless ($session->form->process("url"));
$self->setStorageLocation($storage);
$self->update(\%data);
}
}
$self->update(\%data);
}
}
$self->applyConstraints;
}
@ -327,7 +339,7 @@ sub purge {
my $self = shift;
my $sth = $self->session->db->read("select storageId from FileAsset where assetId=".$self->session->db->quote($self->getId));
while (my ($storageId) = $sth->array) {
WebGUI::Storage->get($self->session,$storageId)->delete;
$self->getStorageClass->get($self->session,$storageId)->delete;
}
$sth->finish;
return $self->SUPER::purge;
@ -355,6 +367,30 @@ sub purgeRevision {
return $self->SUPER::purgeRevision;
}
#----------------------------------------------------------------------------
=head2 setFile ( filename )
Set the file being handled by this storage location with a file from the
system.
=cut
sub setFile {
my $self = shift;
my $filename = shift;
my $storage = $self->getStorageLocation;
# Clear the old file if any
$storage->clear;
$storage->addFileFromFilesystem($filename)
|| croak "Couldn't setFile: " . join(", ",@{ $storage->getErrors });
# NOTE: We should not croak here, the WebGUI::Storage should croak for us.
$self->updatePropertiesFromStorage;
}
#-------------------------------------------------------------------
sub setSize {
my $self = shift;
@ -377,11 +413,11 @@ sub setStorageLocation {
$self->{_storageLocation} = $storage;
}
elsif ($self->get("storageId") eq "") {
$self->{_storageLocation} = WebGUI::Storage->create($self->session);
$self->{_storageLocation} = $self->getStorageClass->create($self->session);
$self->update({storageId=>$self->{_storageLocation}->getId});
}
else {
$self->{_storageLocation} = WebGUI::Storage->get($self->session,$self->get("storageId"));
$self->{_storageLocation} = $self->getStorageClass->get($self->session,$self->get("storageId"));
}
}
@ -411,6 +447,25 @@ sub update {
}
}
#----------------------------------------------------------------------------
=head2 updatePropertiesFromStorage ( )
Updates the asset properties from the file tracked by this asset. Should be
called every time the file is changed to ensure the correct filename is
in the asset properties.
=cut
sub updatePropertiesFromStorage {
my $self = shift;
my $storage = $self->getStorageLocation;
my $filename = $storage->getFiles->[0];
$self->update({
filename => $filename,
});
}
#-------------------------------------------------------------------
sub view {
my $self = shift;

117
lib/WebGUI/Asset/File/Image.pm
View file

@ -15,16 +15,13 @@ package WebGUI::Asset::File::Image;
=cut
use strict;
use WebGUI::Asset::File;
use base 'WebGUI::Asset::File';
use WebGUI::Storage::Image;
use WebGUI::HTMLForm;
use WebGUI::Utility;
our @ISA = qw(WebGUI::Asset::File);
=head1 NAME
Package WebGUI::Asset::File::Image
@ -106,27 +103,27 @@ A hash reference passed in from a subclass definition.
=cut
sub definition {
my $class = shift;
my $session = shift;
my $definition = shift;
my $i18n = WebGUI::International->new($session,"Asset_Image");
push(@{$definition}, {
assetName=>$i18n->get('assetName'),
tableName=>'ImageAsset',
className=>'WebGUI::Asset::File::Image',
icon=>'image.gif',
properties=>{
thumbnailSize=>{
fieldType=>'integer',
defaultValue=>$session->setting->get("thumbnailSize")
},
parameters=>{
fieldType=>'textarea',
defaultValue=>'style="border-style:none;"'
}
}
});
return $class->SUPER::definition($session,$definition);
my $class = shift;
my $session = shift;
my $definition = shift;
my $i18n = WebGUI::International->new($session,"Asset_Image");
push @{$definition}, {
assetName => $i18n->get('assetName'),
tableName => 'ImageAsset',
className => 'WebGUI::Asset::File::Image',
icon => 'image.gif',
properties => {
thumbnailSize => {
fieldType => 'integer',
defaultValue => $session->setting->get("thumbnailSize"),
},
parameters => {
fieldType => 'textarea',
defaultValue => 'style="border-style:none;"',
},
},
};
return $class->SUPER::definition($session,$definition);
}
@ -192,37 +189,16 @@ sub getEditForm {
return $tabform;
}
#----------------------------------------------------------------------------
=head2 getStorageClass
#-------------------------------------------------------------------
=head2 getStorageFromPost
Sub class this method from WebGUI::Asset::File so the storage object is the correct type.
Returns the class name of the WebGUI::Storage we should use for this asset.
=cut
sub getStorageFromPost {
my $self = shift;
my $storageId = shift;
my $fileStorageId = WebGUI::Form::Image->new($self->session, {name => 'newFile', value=>$storageId })->getValueFromPost;
return WebGUI::Storage::Image->get($self->session, $fileStorageId);
}
#-------------------------------------------------------------------
sub getStorageLocation {
my $self = shift;
unless (exists $self->{_storageLocation}) {
if ($self->get("storageId") eq "") {
$self->{_storageLocation} = WebGUI::Storage::Image->create($self->session);
$self->update({storageId=>$self->{_storageLocation}->getId});
} else {
$self->{_storageLocation} = WebGUI::Storage::Image->get($self->session,$self->get("storageId"));
}
}
return $self->{_storageLocation};
sub getStorageClass {
return 'WebGUI::Storage::Image';
}
#-------------------------------------------------------------------
@ -261,31 +237,6 @@ sub prepareView {
$self->{_viewTemplate} = $template;
}
#-------------------------------------------------------------------
sub processPropertiesFromFormPost {
my $self = shift;
$self->SUPER::processPropertiesFromFormPost;
$self->applyConstraints;
}
#-------------------------------------------------------------------
sub setStorageLocation {
my $self = shift;
my $storage = shift;
if (defined $storage) {
$self->{_storageLocation} = $storage;
}
elsif ($self->get("storageId") eq "") {
$self->{_storageLocation} = WebGUI::Storage::Image->create($self->session);
$self->update({storageId=>$self->{_storageLocation}->getId});
}
else {
$self->{_storageLocation} = WebGUI::Storage::Image->get($self->session,$self->get("storageId"));
}
}
#-------------------------------------------------------------------
sub view {
my $self = shift;
@ -305,6 +256,20 @@ sub view {
return $out;
}
#----------------------------------------------------------------------------
=head2 setFile ( filename )
Extend the superclass setFile to automatically generate thumbnails.
=cut
sub setFile {
my $self = shift;
$self->SUPER::setFile(@_);
$self->generateThumbnail;
}
#-------------------------------------------------------------------
sub www_edit {
my $self = shift;

1
lib/WebGUI/AssetTrash.pm
View file

@ -15,6 +15,7 @@ package WebGUI::Asset;
=cut
use strict;
use WebGUI::Asset::Shortcut;
=head1 NAME

2
t/Asset/File.t
View file

@ -26,6 +26,8 @@ use Test::More; # increment this value for each test you create
use Test::Deep;
plan tests => 9;
#TODO: This script tests certain aspects of WebGUI::Storage and it should not
my $session = WebGUI::Test->session;
##Create a storage location

22
t/Asset/File/010-setfile.t
View file

@ -10,7 +10,7 @@
use FindBin;
use strict;
use lib "$FindBin::Bin/../../../../lib";
use lib "$FindBin::Bin/../../lib";
## The goal of this test is to test the creation and deletion of photo assets
@ -39,15 +39,25 @@ END {
#----------------------------------------------------------------------------
# Tests
plan tests => 0;
plan tests => 2;
#----------------------------------------------------------------------------
# setFile allows file path argument and fails if can't find file
# plan tests => 1
ok(
!eval { $file->setFile( WebGUI::Test->getTestCollateralPath("DOES_NOT_EXIST.NO") ); 1},
"setFile allows file path argument and croaks if can't find file"
);
#----------------------------------------------------------------------------
# setFile allows filehandle argument, requires name argument and removes old
# file
# setFile allows file path argument and adds the file
# plan tests => 1
$file->setFile( WebGUI::Test->getTestCollateralPath("WebGUI.pm") );
my $storage = $file->getStorageLocation;
is_deeply(
$storage->getFiles, ['WebGUI.pm'],
"Storage location contains only the file we added",
);

0
t/Asset/File/020-editSave.t → t/Asset/File/020-www_editSave.t
View file

16
t/Asset/File/Image/010-setfile.t
View file

@ -40,9 +40,23 @@ END {
#----------------------------------------------------------------------------
# Tests
plan tests => 0;
plan tests => 2;
#----------------------------------------------------------------------------
# setFile allows file path argument and adds the file
# setFile also generates thumbnail
# plan tests => 2
$image->setFile( WebGUI::Test->getTestCollateralPath("page_title.jpg") );
my $storage = $image->getStorageLocation;
is_deeply(
$storage->getFiles, ['page_title.jpg'],
"Storage location contains only the file we added",
);
# We must do a filesystem test because getFiles doesn't include 'thumb-'
ok(
-e $storage->getPath('thumb-page_title.jpg'),
"Thumbnail file exists on the filesystem",
);

194
t/Asset/File/Image/Photo/000-makeResolutions.t Normal file
View file

@ -0,0 +1,194 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2007 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
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../../../../lib";
## The goal of this test is to test the creation of photo download
# resolutions
use Scalar::Util qw( blessed );
use WebGUI::Test;
use WebGUI::Session;
use Test::More;
use WebGUI::Asset::File::Image::Photo;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Photo Test"});
my ($gallery, $album, $photo);
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#----------------------------------------------------------------------------
# Photo not added under a Photo Gallery asset does NOT generate any
# default resolutions
$photo
= $node->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
$photo->getStorageLocation->addFileFromFilesystem( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
ok(
eval{ $photo->makeResolutions(); 1 },
"makeResolutions succeeds when photo not under photo gallery and no resolutions to make",
);
is_deeply(
$photo->getStorageLocation->getFiles, ['page_title.jpg'],
"makeResolutions does not make any extra resolutions when photo not under photo gallery",
);
#----------------------------------------------------------------------------
# makeResolutions allows API to specify resolutions to make as array reference
# argument
$photo
= $node->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
$photo->getStorageLocation->addFileFromFilesystem( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
ok(
!eval{ $photo->makeResolutions('100x100','200x200'); 1 },
"makeResolutions fails when first argument is not array reference",
);
ok(
eval{ $photo->makeResolutions(['100x100','200x200']); 1 },
"makeResolutions succeeds when first argument is array reference of resolutions to make",
);
is_deeply(
[ sort({ $a cmp $b} @{ $photo->getStorageLocation->getFiles }) ],
['100x100.jpg', '200x200.jpg', 'page_title.jpg'],
"makeResolutions makes all the required resolutions with the appropriate names.",
);
TODO: {
local $TODO = 'Test to ensure the files are created with correct resolution and density';
}
#----------------------------------------------------------------------------
# makeResolutions throws a warning on an invalid resolution but keeps going
$photo
= $node->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
$photo->getStorageLocation->addFileFromFilesystem( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
{ # localize our signal handler
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
ok(
eval{ $photo->makeResolutions(['abc','200','3d400']); 1 },
"makeResolutions succeeds when invalid resolutions are given",
);
is(
scalar @warnings, 2,
"makeResolutions throws a warning for each invalid resolution given",
);
like(
$warnings[0], qr/abc/,
"makeResolutions throws a warning for the correct invalid resolution 'abc'",
);
like(
$warnings[1], qr/3d400/,
"makeResolutions throws a warning for the correct invalid resolution '3d400'",
);
is_deeply(
[ sort({ $a cmp $b} @{ $photo->getStorageLocation->getFiles }) ],
['200.jpg', 'page_title.jpg'],
"makeResolutions still makes valid resolutions when invalid resolutions given",
);
}
#----------------------------------------------------------------------------
# makeResolutions gets default resolutions from a parent Photo Gallery asset
$gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::PhotoGallery",
imageResolutions => "1600x1200\n1024x768\n800x600\n640x480",
});
$album
= $gallery->addChild({
className => "WebGUI::Asset::Wobject::PhotoAlbum",
});
$photo
= $album->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
$photo->getStorageLocation->addFileFromFilesystem( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
ok(
eval{ $photo->makeResolutions; 1 },
"makeResolutions succeeds when photo under photo gallery and no resolution given",
);
is_deeply(
[ sort({ $a cmp $b} @{ $photo->getStorageLocation->getFiles }) ],
[ '1024x768.jpg', '1600x1200.jpg', '640x480.jpg', '800x600.jpg', 'page_title.jpg' ],
"makeResolutions makes all the required resolutions with the appropriate names.",
);
TODO: {
local $TODO = 'Test to ensure the files are created with correct resolution and density';
}
#----------------------------------------------------------------------------
# Array of resolutions passed to makeResolutions overrides defaults from
# parent asset
$gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::PhotoGallery",
imageResolutions => "1600x1200\n1024x768\n800x600\n640x480",
});
$album
= $gallery->addChild({
className => "WebGUI::Asset::Wobject::PhotoAlbum",
});
$photo
= $album->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
$photo->getStorageLocation->addFileFromFilesystem( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
ok(
!eval{ $photo->makeResolutions('100x100','200x200'); 1 },
"makeResolutions fails when first argument is not array reference",
);
ok(
eval{ $photo->makeResolutions(['100x100','200x200']); 1 },
"makeResolutions succeeds when first argument is array reference of resolutions to make",
);
is_deeply(
[ sort({ $a cmp $b} @{ $photo->getStorageLocation->getFiles }) ],
['100x100.jpg', '200x200.jpg', 'page_title.jpg'],
"makeResolutions makes all the required resolutions with the appropriate names.",
);
TODO: {
local $TODO = 'Test to ensure the files are created with correct resolution and density';
}

25
t/Asset/File/Image/Photo/010-setfile.t
View file

@ -26,8 +26,17 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Photo Test"});
my $photo
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::PhotoGallery",
imageResolutions => "1024x768",
});
my $album
= $gallery->addChild({
className => "WebGUI::Asset::Wobject::PhotoAlbum",
});
my $photo
= $album->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
@ -39,9 +48,21 @@ END {
#----------------------------------------------------------------------------
# Tests
plan tests => 0;
plan tests => 2;
#----------------------------------------------------------------------------
# setFile also makes download versions
$photo->setFile( WebGUI::Test->getTestCollateralPath('page_title.jpg') );
my $storage = $photo->getStorageLocation;
is_deeply(
$storage->getFiles, ['page_title.jpg'],
"Storage location contains only the file we added",
);
ok(
-e $storage->getPath($gallery->get('imageResolutions') . '.jpg'),
"Generated resolution file exists on the filesystem",
);

48
t/Asset/File/Image/Photo/100-comment.t Normal file
View file

@ -0,0 +1,48 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2007 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
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../../../../lib";
## The goal of this test is to test the adding, deleting, editing, and
# getting comments for photos
use Scalar::Util qw( blessed );
use WebGUI::Test;
use WebGUI::Session;
use Test::More;
use WebGUI::Asset::File::Image::Photo;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Photo Test"});
my $photo
= $node->addChild({
className => "WebGUI::Asset::File::Image::Photo",
});
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#----------------------------------------------------------------------------
# Tests
plan tests => 0;
#----------------------------------------------------------------------------
#

6
t/Asset/Shortcut/000-create-delete.t
View file

@ -40,12 +40,12 @@ END {
#----------------------------------------------------------------------------
# Tests
plan tests => 2;
plan tests => 3;
#----------------------------------------------------------------------------
# Test module compiles okay
# plan tests => 0
BEGIN { use_ok("WebGUI::Asset::Shortcut"); }
# plan tests => 1
use_ok("WebGUI::Asset::Shortcut");
#----------------------------------------------------------------------------
# Test creating a shortcut to snippet

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

@ -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 {
return $WEBGUI_LIB;
sub file {
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 {
return $WEBGUI_TEST_COLLATERAL;
sub session {
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;