From a8247aa1c503eb52198f0007a402984ca346c334 Mon Sep 17 00:00:00 2001 From: Doug Bell Date: Mon, 3 Nov 2008 18:07:54 +0000 Subject: [PATCH] added Installable aspect and a script to install classes --- lib/WebGUI/AssetAspect/Installable.pm | 215 ++++++++++++++++++++++++++ sbin/installClass.pl | 128 +++++++++++++++ 2 files changed, 343 insertions(+) create mode 100644 lib/WebGUI/AssetAspect/Installable.pm create mode 100644 sbin/installClass.pl diff --git a/lib/WebGUI/AssetAspect/Installable.pm b/lib/WebGUI/AssetAspect/Installable.pm new file mode 100644 index 000000000..cf25e27fa --- /dev/null +++ b/lib/WebGUI/AssetAspect/Installable.pm @@ -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 method, but make sure to call the superclass before you try +anything else. + +=head1 METHODS + +=cut + +#---------------------------------------------------------------------------- + +=head2 install ( session ) + +Install the asset. C 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 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; diff --git a/sbin/installClass.pl b/sbin/installClass.pl new file mode 100644 index 000000000..a8e1aaa11 --- /dev/null +++ b/sbin/installClass.pl @@ -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] --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