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` CHAR(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; } ## end sub install #---------------------------------------------------------------------------- =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; } ## end sub uninstall #---------------------------------------------------------------------------- =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 " ); } } ## end if ( exists $tableFields... else { $db->write( "alter table $tableName add column " . $dbh->quote_identifier($property) . " $fieldType " ); } delete $tableFields{$property}; } ## end foreach my $property ( keys... # 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; } ## end sub upgrade # TODO: Add updateTemplates and getTemplatePackage # or some other manner of installing and maintaining default template package 1;