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

perltidy

Browse source
This commit is contained in:
Doug Bell 2008-11-03 18:38:39 +00:00
parent a8247aa1c5
commit 9dd6295b84
2 changed files with 111 additions and 113 deletions
Download patch file Download diff file Expand all files Collapse all files

173
lib/WebGUI/AssetAspect/Installable.pm
View file

@ -6,7 +6,6 @@ use Class::C3;
use WebGUI::Asset; use WebGUI::Asset;
use WebGUI::Form::DynamicField; use WebGUI::Form::DynamicField;
=head1 NAME =head1 NAME
WebGUI::AssetAspect::Installable -- Make your asset installable WebGUI::AssetAspect::Installable -- Make your asset installable
@ -54,35 +53,33 @@ install the asset into.
=cut =cut
sub install { sub install {
my $class = shift; my $class = shift;
my $session = shift; my $session = shift;
### Install the first member of the definition ### Install the first member of the definition
my $definition = $class->definition( $session ); my $definition = $class->definition($session);
my $installDef = shift @{ $definition }; my $installDef = shift @{$definition};
# Make the table according to WebGUI::Form::Control's databaseFieldType # Make the table according to WebGUI::Form::Control's databaseFieldType
my $sql = q{CREATE TABLE `} . $installDef->{tableName} . q{` ( } my $sql
. q{`assetId` VARCHAR(22) BINARY NOT NULL, } = q{CREATE TABLE `}
. q{`revisionDate` BIGINT NOT NULL, } . $installDef->{tableName} . q{` ( }
; . q{`assetId` VARCHAR(22) BINARY NOT NULL, }
. q{`revisionDate` BIGINT NOT NULL, };
for my $column ( keys %{ $installDef->{properties} } ) { for my $column ( keys %{ $installDef->{properties} } ) {
my $control my $control = WebGUI::Form::DynamicField->new( $session, %{ $installDef->{properties}->{$column} } );
= WebGUI::Form::DynamicField->new( $session,
%{ $installDef->{properties}->{ $column } }
);
$sql .= q{`} . $column . q{` } . $control->getDatabaseFieldType . q{, }; $sql .= q{`} . $column . q{` } . $control->getDatabaseFieldType . q{, };
} }
$sql .= q{ PRIMARY KEY ( assetId, revisionDate ) ) }; $sql .= q{ PRIMARY KEY ( assetId, revisionDate ) ) };
$session->db->write( $sql ); $session->db->write($sql);
# Write to the configuration # Write to the configuration
$session->config->addToHash( "assets", $installDef->{className}, { category => "basic" } ); $session->config->addToHash( "assets", $installDef->{className}, { category => "basic" } );
return; return;
} } ## end sub install
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -94,14 +91,11 @@ last database table.
=cut =cut
sub isInstalled { sub isInstalled {
my $class = shift; my $class = shift;
my $session = shift; my $session = shift;
my $tableName = $class->definition( $session )->[0]->{ tableName }; my $tableName = $class->definition($session)->[0]->{tableName};
my $exists = $session->db->quickScalar( my $exists = $session->db->quickScalar( "SHOW TABLES LIKE ?", [$tableName], );
"SHOW TABLES LIKE ?",
[ $tableName ],
);
return $exists ? 1 : 0; return $exists ? 1 : 0;
} }
@ -116,28 +110,28 @@ uninstall the asset from.
=cut =cut
sub uninstall { sub uninstall {
my $class = shift; my $class = shift;
my $session = shift; my $session = shift;
### Uninstall the first member of the definition ### Uninstall the first member of the definition
my $definition = $class->definition( $session ); my $definition = $class->definition($session);
my $installDef = shift @{ $definition }; my $installDef = shift @{$definition};
### Remove all assets contained in the table ### Remove all assets contained in the table
my $sth = $session->db->read( "SELECT assetId FROM `$installDef->{tableName}`" ); my $sth = $session->db->read("SELECT assetId FROM `$installDef->{tableName}`");
while ( my ( $assetId ) = $sth->array ) { while ( my ($assetId) = $sth->array ) {
my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId );
$asset->purge; $asset->purge;
} }
# Drop the table # Drop the table
my $sql = q{DROP TABLE `} . $installDef->{tableName} . q{`}; my $sql = q{DROP TABLE `} . $installDef->{tableName} . q{`};
$session->db->write( $sql ); $session->db->write($sql);
$session->config->deleteFromHash( "assets", $installDef->{className} ); $session->config->deleteFromHash( "assets", $installDef->{className} );
return; return;
} } ## end sub uninstall
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -149,67 +143,72 @@ table with the current definition and modify the table if necessary.
=cut =cut
sub upgrade { sub upgrade {
my ($class, $session) = @_; my ( $class, $session ) = @_;
unless (defined $session && $session->isa('WebGUI::Session')) { unless ( defined $session && $session->isa('WebGUI::Session') ) {
WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); WebGUI::Error::InvalidObject->throw(
expected => 'WebGUI::Session',
got => ( ref $session ),
error => 'Need a session.'
);
} }
my $db = $session->db; my $db = $session->db;
my $dbh = $db->dbh; my $dbh = $db->dbh;
my $definition = $class->definition( $session ); my $definition = $class->definition($session);
my $properties = $definition->[0]->{properties}; my $properties = $definition->[0]->{properties};
my $tableName = $dbh->quote_identifier($definition->[0]->{tableName}); my $tableName = $dbh->quote_identifier( $definition->[0]->{tableName} );
# find out what fields already exist # find out what fields already exist
my %tableFields = (); my %tableFields = ();
my $sth = $db->read("DESCRIBE ".$tableName); my $sth = $db->read( "DESCRIBE " . $tableName );
while (my ($col, $type, $null, $key, $default) = $sth->array) { while ( my ( $col, $type, $null, $key, $default ) = $sth->array ) {
next if ( grep { $_ eq $col } 'assetId', 'revisionDate' ); next if ( grep { $_ eq $col } 'assetId', 'revisionDate' );
$tableFields{$col} = { $tableFields{$col} = { type => $type, };
type => $type, }
};
}
# update existing and create new fields # update existing and create new fields
foreach my $property (keys %{$properties}) { foreach my $property ( keys %{$properties} ) {
my $control my $control = WebGUI::Form::DynamicField->new( $session, %{ $properties->{$property} }, );
= WebGUI::Form::DynamicField->new( $session, my $fieldType = $control->getDatabaseFieldType;
%{ $properties->{ $property } }, if ( exists $tableFields{$property} ) {
); my $changed = 0;
my $fieldType = $control->getDatabaseFieldType;
if (exists $tableFields{$property}) {
my $changed = 0;
# parse database table field type # parse database table field type
$tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; $tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/;
my ($tableFieldType, $tableFieldLength) = ($1, $2); my ( $tableFieldType, $tableFieldLength ) = ( $1, $2 );
# parse form field type # parse form field type
$fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/; $fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/;
my ($formFieldType, $formFieldLength) = ($1, $2); my ( $formFieldType, $formFieldLength ) = ( $1, $2 );
# compare table parts to definition # compare table parts to definition
$changed = 1 if ($tableFieldType ne $formFieldType); $changed = 1 if ( $tableFieldType ne $formFieldType );
$changed = 1 if ($tableFieldLength ne $formFieldLength); $changed = 1 if ( $tableFieldLength ne $formFieldLength );
# modify if necessary # modify if necessary
if ($changed) { if ($changed) {
$db->write("alter table $tableName change column ".$dbh->quote_identifier($property)." ".$dbh->quote_identifier($property)." $fieldType "); $db->write( "alter table $tableName change column "
} . $dbh->quote_identifier($property) . " "
} . $dbh->quote_identifier($property)
else { . " $fieldType " );
$db->write("alter table $tableName add column ".$dbh->quote_identifier($property)." $fieldType "); }
} } ## end if ( exists $tableFields...
delete $tableFields{$property}; 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 # delete fields that are no longer in the definition
foreach my $property (keys %tableFields) { foreach my $property ( keys %tableFields ) {
if ($tableFields{$property}{key}) { if ( $tableFields{$property}{key} ) {
$db->write("alter table $tableName drop index ".$dbh->quote_identifier($property)); $db->write( "alter table $tableName drop index " . $dbh->quote_identifier($property) );
} }
$db->write("alter table $tableName drop column ".$dbh->quote_identifier($property)); $db->write( "alter table $tableName drop column " . $dbh->quote_identifier($property) );
} }
return 1; return 1;
} } ## end sub upgrade
# TODO: Add updateTemplates and getTemplatePackage
# or some other manner of installing and maintaining default template package
1; 1;

39
sbin/installClass.pl
View file

@ -11,16 +11,16 @@ $|++;
# Get options # Get options
my ( $configFile, $remove, $check, $upgrade, $help, $man ); my ( $configFile, $remove, $check, $upgrade, $help, $man );
GetOptions( GetOptions(
'configFile=s' => \$configFile, 'configFile=s' => \$configFile,
'remove' => \$remove, 'remove' => \$remove,
'check' => \$check, 'check' => \$check,
'upgrade' => \$upgrade, 'upgrade' => \$upgrade,
'help' => \$help, 'help' => \$help,
'man' => \$man, 'man' => \$man,
); );
# Get arguments # Get arguments
my $class = $ARGV[0]; my $class = $ARGV[0];
pod2usage( -verbose => 1 ) pod2usage( -verbose => 1 )
if $help; if $help;
@ -28,49 +28,48 @@ pod2usage( -verbose => 1 )
pod2usage( -verbose => 2 ) pod2usage( -verbose => 2 )
if $man; if $man;
pod2usage( "$0: Must specify a configFile" ) pod2usage("$0: Must specify a configFile")
if !$configFile; if !$configFile;
die "Config file '$configFile' does not exist!\n" die "Config file '$configFile' does not exist!\n"
if !-f '../etc/' . $configFile; if !-f '../etc/' . $configFile;
# Open the session # Open the session
my $session = WebGUI::Session->open("..",$configFile); my $session = WebGUI::Session->open( "..", $configFile );
$session->user({ userId => 3 }); $session->user( { userId => 3 } );
# Install or uninstall the asset # Install or uninstall the asset
WebGUI::Pluggable::load( $class ); WebGUI::Pluggable::load($class);
if ( $check ) { if ($check) {
if ( $class->isInstalled( $session ) ) { if ( $class->isInstalled($session) ) {
print "$class is installed!\n"; print "$class is installed!\n";
} }
else { else {
print "$class is NOT installed!\n"; print "$class is NOT installed!\n";
} }
} }
elsif ( $remove ) { elsif ($remove) {
print "Removing $class... "; print "Removing $class... ";
if ( !$class->isInstalled( $session ) ) { if ( !$class->isInstalled($session) ) {
die "Can't remove $class because: Not installed\n"; die "Can't remove $class because: Not installed\n";
} }
$class->uninstall( $session ); $class->uninstall($session);
print "DONE!\n"; print "DONE!\n";
print "Please restart Apache.\n"; print "Please restart Apache.\n";
} }
elsif ( $upgrade || $class->isInstalled( $session ) ) { elsif ( $upgrade || $class->isInstalled($session) ) {
print "Upgrading $class... "; print "Upgrading $class... ";
$class->upgrade( $session ); $class->upgrade($session);
print "DONE!\n"; print "DONE!\n";
print "Please restart Apache.\n"; print "Please restart Apache.\n";
} }
else { else {
print "Installing $class... "; print "Installing $class... ";
$class->install( $session ); $class->install($session);
print "DONE!\n"; print "DONE!\n";
print "Please restart Apache.\n"; print "Please restart Apache.\n";
} }
# End the session # End the session
$session->var->end; $session->var->end;
$session->close; $session->close;