perltidy
This commit is contained in:
Doug Bell
parent
a8247aa1c5
commit
9dd6295b84
2 changed files with 111 additions and 113 deletions
|
|
@ -6,7 +6,6 @@ use Class::C3;
|
|||
use WebGUI::Asset;
|
||||
use WebGUI::Form::DynamicField;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WebGUI::AssetAspect::Installable -- Make your asset installable
|
||||
|
|
@ -54,35 +53,33 @@ install the asset into.
|
|||
=cut
|
||||
|
||||
sub install {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
### Install the first member of the definition
|
||||
my $definition = $class->definition( $session );
|
||||
my $installDef = shift @{ $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, }
|
||||
;
|
||||
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 } }
|
||||
);
|
||||
my $control = WebGUI::Form::DynamicField->new( $session, %{ $installDef->{properties}->{$column} } );
|
||||
$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
|
||||
$session->config->addToHash( "assets", $installDef->{className}, { category => "basic" } );
|
||||
|
||||
return;
|
||||
}
|
||||
} ## end sub install
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -94,14 +91,11 @@ last database table.
|
|||
=cut
|
||||
|
||||
sub isInstalled {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
my $tableName = $class->definition( $session )->[0]->{ tableName };
|
||||
my $exists = $session->db->quickScalar(
|
||||
"SHOW TABLES LIKE ?",
|
||||
[ $tableName ],
|
||||
);
|
||||
my $tableName = $class->definition($session)->[0]->{tableName};
|
||||
my $exists = $session->db->quickScalar( "SHOW TABLES LIKE ?", [$tableName], );
|
||||
|
||||
return $exists ? 1 : 0;
|
||||
}
|
||||
|
|
@ -116,28 +110,28 @@ uninstall the asset from.
|
|||
=cut
|
||||
|
||||
sub uninstall {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
### Uninstall the first member of the definition
|
||||
my $definition = $class->definition( $session );
|
||||
my $installDef = shift @{ $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 );
|
||||
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{`};
|
||||
my $sql = q{DROP TABLE `} . $installDef->{tableName} . q{`};
|
||||
|
||||
$session->db->write( $sql );
|
||||
$session->db->write($sql);
|
||||
$session->config->deleteFromHash( "assets", $installDef->{className} );
|
||||
|
||||
return;
|
||||
}
|
||||
} ## end sub uninstall
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -149,67 +143,72 @@ 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 ( $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});
|
||||
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,
|
||||
};
|
||||
}
|
||||
# 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;
|
||||
# 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 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);
|
||||
# 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);
|
||||
# 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};
|
||||
}
|
||||
# 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;
|
||||
}
|
||||
# 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;
|
||||
|
|
|
|||
|
|
@ -11,16 +11,16 @@ $|++;
|
|||
# Get options
|
||||
my ( $configFile, $remove, $check, $upgrade, $help, $man );
|
||||
GetOptions(
|
||||
'configFile=s' => \$configFile,
|
||||
'remove' => \$remove,
|
||||
'check' => \$check,
|
||||
'upgrade' => \$upgrade,
|
||||
'help' => \$help,
|
||||
'man' => \$man,
|
||||
'configFile=s' => \$configFile,
|
||||
'remove' => \$remove,
|
||||
'check' => \$check,
|
||||
'upgrade' => \$upgrade,
|
||||
'help' => \$help,
|
||||
'man' => \$man,
|
||||
);
|
||||
|
||||
# Get arguments
|
||||
my $class = $ARGV[0];
|
||||
my $class = $ARGV[0];
|
||||
|
||||
pod2usage( -verbose => 1 )
|
||||
if $help;
|
||||
|
|
@ -28,49 +28,48 @@ pod2usage( -verbose => 1 )
|
|||
pod2usage( -verbose => 2 )
|
||||
if $man;
|
||||
|
||||
pod2usage( "$0: Must specify a configFile" )
|
||||
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 });
|
||||
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 ) ) {
|
||||
WebGUI::Pluggable::load($class);
|
||||
if ($check) {
|
||||
if ( $class->isInstalled($session) ) {
|
||||
print "$class is installed!\n";
|
||||
}
|
||||
else {
|
||||
print "$class is NOT installed!\n";
|
||||
}
|
||||
}
|
||||
elsif ( $remove ) {
|
||||
elsif ($remove) {
|
||||
print "Removing $class... ";
|
||||
if ( !$class->isInstalled( $session ) ) {
|
||||
if ( !$class->isInstalled($session) ) {
|
||||
die "Can't remove $class because: Not installed\n";
|
||||
}
|
||||
$class->uninstall( $session );
|
||||
$class->uninstall($session);
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
elsif ( $upgrade || $class->isInstalled( $session ) ) {
|
||||
elsif ( $upgrade || $class->isInstalled($session) ) {
|
||||
print "Upgrading $class... ";
|
||||
$class->upgrade( $session );
|
||||
$class->upgrade($session);
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
else {
|
||||
print "Installing $class... ";
|
||||
$class->install( $session );
|
||||
$class->install($session);
|
||||
print "DONE!\n";
|
||||
print "Please restart Apache.\n";
|
||||
}
|
||||
|
||||
|
||||
# End the session
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue