added Installable aspect and a script to install classes
This commit is contained in:
Doug Bell
parent
c70acedd1b
commit
a8247aa1c5
2 changed files with 343 additions and 0 deletions
215
lib/WebGUI/AssetAspect/Installable.pm
Normal file
215
lib/WebGUI/AssetAspect/Installable.pm
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
package WebGUI::AssetAspect::Installable;
|
||||
|
||||
use strict;
|
||||
use Class::C3;
|
||||
|
||||
use WebGUI::Asset;
|
||||
use WebGUI::Form::DynamicField;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WebGUI::AssetAspect::Installable -- Make your asset installable
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package WebGUI::Asset::MyAsset;
|
||||
use base ( 'WebGUI::AssetAspect::Installable', 'WebGUI::Asset' );
|
||||
|
||||
# Override the install method to install collateral tables
|
||||
sub install {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
$self->next::method( $session );
|
||||
}
|
||||
|
||||
# Override the uninstall method to remove collateral tables
|
||||
sub uninstall {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
$self->next::method( $session );
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This aspect adds installing and uninstalling to your asset class.
|
||||
|
||||
For most purposes, just inheriting from this aspect will suffice.
|
||||
|
||||
If you need to install collateral information or otherwise, override the
|
||||
C<install> method, but make sure to call the superclass before you try
|
||||
anything else.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 install ( session )
|
||||
|
||||
Install the asset. C<session> is a WebGUI::Session object from the site to
|
||||
install the asset into.
|
||||
|
||||
=cut
|
||||
|
||||
sub install {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
### Install the first member of the definition
|
||||
my $definition = $class->definition( $session );
|
||||
my $installDef = shift @{ $definition };
|
||||
|
||||
# Make the table according to WebGUI::Form::Control's databaseFieldType
|
||||
my $sql = q{CREATE TABLE `} . $installDef->{tableName} . q{` ( }
|
||||
. q{`assetId` VARCHAR(22) BINARY NOT NULL, }
|
||||
. q{`revisionDate` BIGINT NOT NULL, }
|
||||
;
|
||||
for my $column ( keys %{ $installDef->{properties} } ) {
|
||||
my $control
|
||||
= WebGUI::Form::DynamicField->new( $session,
|
||||
%{ $installDef->{properties}->{ $column } }
|
||||
);
|
||||
$sql .= q{`} . $column . q{` } . $control->getDatabaseFieldType . q{, };
|
||||
|
||||
}
|
||||
$sql .= q{ PRIMARY KEY ( assetId, revisionDate ) ) };
|
||||
|
||||
$session->db->write( $sql );
|
||||
|
||||
# Write to the configuration
|
||||
$session->config->addToHash( "assets", $installDef->{className}, { category => "basic" } );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 isInstalled ( session )
|
||||
|
||||
Returns true if the asset is installed. By default, only checks for the
|
||||
last database table.
|
||||
|
||||
=cut
|
||||
|
||||
sub isInstalled {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
my $tableName = $class->definition( $session )->[0]->{ tableName };
|
||||
my $exists = $session->db->quickScalar(
|
||||
"SHOW TABLES LIKE ?",
|
||||
[ $tableName ],
|
||||
);
|
||||
|
||||
return $exists ? 1 : 0;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 uninstall ( session )
|
||||
|
||||
Unnstall the asset. C<session> is a WebGUI::Session object from the site to
|
||||
uninstall the asset from.
|
||||
|
||||
=cut
|
||||
|
||||
sub uninstall {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
### Uninstall the first member of the definition
|
||||
my $definition = $class->definition( $session );
|
||||
my $installDef = shift @{ $definition };
|
||||
|
||||
### Remove all assets contained in the table
|
||||
my $sth = $session->db->read( "SELECT assetId FROM `$installDef->{tableName}`" );
|
||||
while ( my ( $assetId ) = $sth->array ) {
|
||||
my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
|
||||
$asset->purge;
|
||||
}
|
||||
|
||||
# Drop the table
|
||||
my $sql = q{DROP TABLE `} . $installDef->{tableName} . q{`};
|
||||
|
||||
$session->db->write( $sql );
|
||||
$session->config->deleteFromHash( "assets", $installDef->{className} );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
=head2 upgrade ( session )
|
||||
|
||||
Upgrade an existing installation of this asset. Try to reconcile the current
|
||||
table with the current definition and modify the table if necessary.
|
||||
|
||||
=cut
|
||||
|
||||
sub upgrade {
|
||||
my ($class, $session) = @_;
|
||||
unless (defined $session && $session->isa('WebGUI::Session')) {
|
||||
WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.');
|
||||
}
|
||||
my $db = $session->db;
|
||||
my $dbh = $db->dbh;
|
||||
my $definition = $class->definition( $session );
|
||||
my $properties = $definition->[0]->{properties};
|
||||
my $tableName = $dbh->quote_identifier($definition->[0]->{tableName});
|
||||
|
||||
# find out what fields already exist
|
||||
my %tableFields = ();
|
||||
my $sth = $db->read("DESCRIBE ".$tableName);
|
||||
while (my ($col, $type, $null, $key, $default) = $sth->array) {
|
||||
next if ( grep { $_ eq $col } 'assetId', 'revisionDate' );
|
||||
$tableFields{$col} = {
|
||||
type => $type,
|
||||
};
|
||||
}
|
||||
|
||||
# update existing and create new fields
|
||||
foreach my $property (keys %{$properties}) {
|
||||
my $control
|
||||
= WebGUI::Form::DynamicField->new( $session,
|
||||
%{ $properties->{ $property } },
|
||||
);
|
||||
my $fieldType = $control->getDatabaseFieldType;
|
||||
if (exists $tableFields{$property}) {
|
||||
my $changed = 0;
|
||||
|
||||
# parse database table field type
|
||||
$tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/;
|
||||
my ($tableFieldType, $tableFieldLength) = ($1, $2);
|
||||
|
||||
# parse form field type
|
||||
$fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/;
|
||||
my ($formFieldType, $formFieldLength) = ($1, $2);
|
||||
|
||||
# compare table parts to definition
|
||||
$changed = 1 if ($tableFieldType ne $formFieldType);
|
||||
$changed = 1 if ($tableFieldLength ne $formFieldLength);
|
||||
|
||||
# modify if necessary
|
||||
if ($changed) {
|
||||
$db->write("alter table $tableName change column ".$dbh->quote_identifier($property)." ".$dbh->quote_identifier($property)." $fieldType ");
|
||||
}
|
||||
}
|
||||
else {
|
||||
$db->write("alter table $tableName add column ".$dbh->quote_identifier($property)." $fieldType ");
|
||||
}
|
||||
delete $tableFields{$property};
|
||||
}
|
||||
|
||||
# delete fields that are no longer in the definition
|
||||
foreach my $property (keys %tableFields) {
|
||||
if ($tableFields{$property}{key}) {
|
||||
$db->write("alter table $tableName drop index ".$dbh->quote_identifier($property));
|
||||
}
|
||||
$db->write("alter table $tableName drop column ".$dbh->quote_identifier($property));
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
128
sbin/installClass.pl
Normal file
128
sbin/installClass.pl
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
|
||||
use lib "../lib";
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use WebGUI::Pluggable;
|
||||
use WebGUI::Session;
|
||||
|
||||
$|++;
|
||||
|
||||
# Get options
|
||||
my ( $configFile, $remove, $check, $upgrade, $help, $man );
|
||||
GetOptions(
|
||||
'configFile=s' => \$configFile,
|
||||
'remove' => \$remove,
|
||||
'check' => \$check,
|
||||
'upgrade' => \$upgrade,
|
||||
'help' => \$help,
|
||||
'man' => \$man,
|
||||
);
|
||||
|
||||
# Get arguments
|
||||
my $class = $ARGV[0];
|
||||
|
||||
pod2usage( -verbose => 1 )
|
||||
if $help;
|
||||
|
||||
pod2usage( -verbose => 2 )
|
||||
if $man;
|
||||
|
||||
pod2usage( "$0: Must specify a configFile" )
|
||||
if !$configFile;
|
||||
|
||||
die "Config file '$configFile' does not exist!\n"
|
||||
if !-f '../etc/' . $configFile;
|
||||
|
||||
# Open the session
|
||||
my $session = WebGUI::Session->open("..",$configFile);
|
||||
$session->user({ userId => 3 });
|
||||
|
||||
# Install or uninstall the asset
|
||||
WebGUI::Pluggable::load( $class );
|
||||
if ( $check ) {
|
||||
if ( $class->isInstalled( $session ) ) {
|
||||
print "$class is installed!\n";
|
||||
}
|
||||
else {
|
||||
print "$class is NOT installed!\n";
|
||||
}
|
||||
}
|
||||
elsif ( $remove ) {
|
||||
print "Removing $class... ";
|
||||
if ( !$class->isInstalled( $session ) ) {
|
||||
die "Can't remove $class because: Not installed\n";
|
||||
}
|
||||
$class->uninstall( $session );
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
elsif ( $upgrade || $class->isInstalled( $session ) ) {
|
||||
print "Upgrading $class... ";
|
||||
$class->upgrade( $session );
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
else {
|
||||
print "Installing $class... ";
|
||||
$class->install( $session );
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
|
||||
|
||||
# End the session
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
installClass.pl -- Run class install methods
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
installAsset.pl [--remove|--check|--upgrade] <class> --configFile=<configFile>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This helper script installs a class that is using the correct interface.
|
||||
|
||||
If your class has not told you to use this script, then it probably won't work!
|
||||
|
||||
=head1 ARGUMENTS
|
||||
|
||||
=over 4
|
||||
|
||||
=item class
|
||||
|
||||
The class name of the class to install. Something like WebGUI::Asset::Yourasset
|
||||
|
||||
=back
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 4
|
||||
|
||||
=item check
|
||||
|
||||
If specified, will check if the class is installed or not.
|
||||
|
||||
=item upgrade
|
||||
|
||||
If specified, will upgrade the class.
|
||||
|
||||
=item remove
|
||||
|
||||
If specified, will uninstall the class.
|
||||
|
||||
=item configFile
|
||||
|
||||
The configuration file for the site to install the class into
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
WebGUI::AssetAspect::Installable
|
||||
Loading…
Add table
Add a link
Reference in a new issue