diff options
Diffstat (limited to 'config-db')
-rw-r--r-- | config-db/OpenSLX/MetaDB/CSV.pm | 82 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/DBI.pm | 515 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/SQLite.pm | 64 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/mysql.pm | 100 |
4 files changed, 375 insertions, 386 deletions
diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm index bee5ca80..104a4d98 100644 --- a/config-db/OpenSLX/MetaDB/CSV.pm +++ b/config-db/OpenSLX/MetaDB/CSV.pm @@ -15,7 +15,7 @@ package OpenSLX::MetaDB::CSV; use strict; use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version +$VERSION = 1.01; # API-version . implementation-version use base qw(OpenSLX::MetaDB::DBI); ################################################################################ @@ -37,7 +37,7 @@ use OpenSLX::MetaDB::DBI 1; sub new { my $class = shift; - my $self = {}; + my $self = {}; return bless $self, $class; } @@ -49,43 +49,42 @@ sub connect if (!defined $dbSpec) { # build $dbSpec from individual parameters: my $dbBasepath = "$openslxConfig{'private-path'}/db"; - my $dbDatadir = "$openslxConfig{'db-name'}-csv"; - my $dbPath = "$dbBasepath/$dbDatadir"; - system("mkdir -p $dbPath") unless -e $dbPath; + my $dbDatadir = "$openslxConfig{'db-name'}-csv"; + my $dbPath = "$dbBasepath/$dbDatadir"; + system("mkdir -p $dbPath") unless -e $dbPath; $dbSpec = "f_dir=$dbPath;csv_eol=\n;"; } vlog(1, "trying to connect to CSV-database <$dbSpec>"); - $self->{'dbh'} = DBI->connect("dbi:CSV:$dbSpec", undef, undef, - {PrintError => 0}) - or die _tr("Cannot connect to database '%s' (%s)", - $dbSpec, $DBI::errstr); + $self->{'dbh'} = + DBI->connect("dbi:CSV:$dbSpec", undef, undef, {PrintError => 0}) + or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); } sub quote -{ # DBD::CSV has a buggy quoting mechanism which can't cope with backslashes - # so we reimplement the quoting ourselves... +{ # DBD::CSV has a buggy quoting mechanism which can't cope with backslashes + # so we reimplement the quoting ourselves... my $self = shift; - my $val = shift; + my $val = shift; $val =~ s[(['])][\\$1]go; return "'$val'"; } sub start_transaction -{ # simulate a global transaction by flocking a file: +{ # simulate a global transaction by flocking a file: my $self = shift; - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $lockFile = "$dbh->{'f_dir'}/transaction-lock"; - sysopen(TRANSFILE, $lockFile, O_RDWR|O_CREAT) - or confess _tr(q[Can't open transaction-file '%s' (%s)], $lockFile, $!); + sysopen(TRANSFILE, $lockFile, O_RDWR | O_CREAT) + or confess _tr(q[Can't open transaction-file '%s' (%s)], $lockFile, $!); $self->{"transaction-lock"} = *TRANSFILE; flock(TRANSFILE, LOCK_EX) - or confess _tr(q[Can't lock transaction-file '%s' (%s)], $lockFile, $!); + or confess _tr(q[Can't lock transaction-file '%s' (%s)], $lockFile, $!); } sub commit_transaction -{ # free transaction-lock +{ # free transaction-lock my $self = shift; if (!defined $self->{"transaction-lock"}) { @@ -97,7 +96,7 @@ sub commit_transaction } sub rollback_transaction -{ # free transaction-lock +{ # free transaction-lock my $self = shift; if (!defined $self->{"transaction-lock"}) { @@ -109,19 +108,19 @@ sub rollback_transaction } sub generateNextIdForTable -{ # CSV doesn't provide any mechanism to generate IDs, we provide one - my $self = shift; +{ # CSV doesn't provide any mechanism to generate IDs, we provide one + my $self = shift; my $table = shift; return 1 unless defined $table; # fetch the next ID from a table-specific file: - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $idFile = "$dbh->{'f_dir'}/id-$table"; - sysopen(IDFILE, $idFile, O_RDWR|O_CREAT) - or confess _tr(q[Can't open ID-file '%s' (%s)], $idFile, $!); + sysopen(IDFILE, $idFile, O_RDWR | O_CREAT) + or confess _tr(q[Can't open ID-file '%s' (%s)], $idFile, $!); flock(IDFILE, LOCK_EX) - or confess _tr(q[Can't lock ID-file '%s' (%s)], $idFile, $!); + or confess _tr(q[Can't lock ID-file '%s' (%s)], $idFile, $!); my $nextID = <IDFILE>; if (!$nextID) { # no ID information available, we protect against users having @@ -130,36 +129,35 @@ sub generateNextIdForTable # N.B.: older versions of DBD::CSV (notably the one that comes with # SUSE-9.3) do not understand the max() function, so we determine # the maximum ID manually: - my @IDs - = sort { $b <=> $a } - $self->_doSelect("SELECT id FROM $table", 'id'); + my @IDs = + sort { $b <=> $a } $self->_doSelect("SELECT id FROM $table", 'id'); my $maxID = $IDs[0]; - $nextID = 1+$maxID; + $nextID = 1 + $maxID; } seek(IDFILE, 0, 0) - or confess _tr(q[Can't to seek ID-file '%s' (%s)], $idFile, $!); + or confess _tr(q[Can't to seek ID-file '%s' (%s)], $idFile, $!); truncate(IDFILE, 0) - or confess _tr(q[Can't truncate ID-file '%s' (%s)], $idFile, $!); - print IDFILE $nextID+1 - or confess _tr(q[Can't update ID-file '%s' (%s)], $idFile, $!); + or confess _tr(q[Can't truncate ID-file '%s' (%s)], $idFile, $!); + print IDFILE $nextID + 1 + or confess _tr(q[Can't update ID-file '%s' (%s)], $idFile, $!); close(IDFILE); return $nextID; } sub schemaDeclareTable -{ # explicitly set file name for each table such that it makes - # use of '.csv'-extension - my $self = shift; +{ # explicitly set file name for each table such that it makes + # use of '.csv'-extension + my $self = shift; my $table = shift; my $dbh = $self->{'dbh'}; - $dbh->{'csv_tables'}->{"$table"} = { 'file' => "${table}.csv"}; + $dbh->{'csv_tables'}->{"$table"} = {'file' => "${table}.csv"}; } sub schemaRenameTable -{ # renames corresponding id-file after renaming the table - my $self = shift; +{ # renames corresponding id-file after renaming the table + my $self = shift; my $oldTable = shift; my $newTable = shift; @@ -170,8 +168,8 @@ sub schemaRenameTable } sub schemaDropTable -{ # removes corresponding id-file after dropping the table - my $self = shift; +{ # removes corresponding id-file after dropping the table + my $self = shift; my $table = shift; $self->SUPER::schemaDropTable($table, @_); @@ -179,4 +177,4 @@ sub schemaDropTable unlink "$dbh->{'f_dir'}/id-$table"; } -1;
\ No newline at end of file +1; diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm index 54d567cf..ea0b66f1 100644 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -15,7 +15,7 @@ package OpenSLX::MetaDB::DBI; use strict; use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version +$VERSION = 1.01; # API-version . implementation-version use base qw(OpenSLX::MetaDB::Base); use Carp; @@ -40,28 +40,28 @@ sub disconnect } sub quote -{ # default implementation quotes any given values through the DBI +{ # default implementation quotes any given values through the DBI my $self = shift; return $self->{'dbh'}->quote(@_); } sub start_transaction -{ # default implementation passes on the request to the DBI +{ # default implementation passes on the request to the DBI my $self = shift; return $self->{'dbh'}->begin_work(); } sub commit_transaction -{ # default implementation passes on the request to the DBI +{ # default implementation passes on the request to the DBI my $self = shift; return $self->{'dbh'}->commit(); } sub rollback_transaction -{ # default implementation passes on the request to the DBI +{ # default implementation passes on the request to the DBI my $self = shift; return $self->{'dbh'}->rollback(); @@ -79,21 +79,22 @@ sub _trim sub _doSelect { - my $self = shift; - my $sql = shift; + my $self = shift; + my $sql = shift; my $resultCol = shift; my $dbh = $self->{'dbh'}; vlog(3, _trim($sql)); my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't prepare SQL-statement <%s> (%s)], $sql, - $dbh->errstr); + or + confess _tr(q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr); $sth->execute() - or confess _tr(q[Can't execute SQL-statement <%s> (%s)], $sql, - $dbh->errstr); + or + confess _tr(q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr); my (@vals, $row); - while($row = $sth->fetchrow_hashref()) { + while ($row = $sth->fetchrow_hashref()) { + if (defined $resultCol) { return $row->{$resultCol} unless wantarray(); push @vals, $row->{$resultCol}; @@ -107,11 +108,11 @@ sub _doSelect sub fetchVendorOSByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $sql = "SELECT $resultCols FROM vendor_os"; my $connector; foreach my $col (keys %$filter) { @@ -123,11 +124,11 @@ sub fetchVendorOSByFilter sub fetchVendorOSByID { - my $self = shift; - my $ids = shift; + my $self = shift; + my $ids = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $idStr = join ',', @$ids; return if !length($idStr); my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)"; @@ -136,11 +137,11 @@ sub fetchVendorOSByID sub fetchExportByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $sql = "SELECT $resultCols FROM export"; my $connector; foreach my $col (keys %$filter) { @@ -152,11 +153,11 @@ sub fetchExportByFilter sub fetchExportByID { - my $self = shift; - my $ids = shift; + my $self = shift; + my $ids = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $idStr = join ',', @$ids; return if !length($idStr); my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)"; @@ -165,7 +166,7 @@ sub fetchExportByID sub fetchExportIDsOfVendorOS { - my $self = shift; + my $self = shift; my $vendorOSID = shift; my $sql = qq[ @@ -177,17 +178,17 @@ sub fetchExportIDsOfVendorOS sub fetchGlobalInfo { my $self = shift; - my $id = shift; + my $id = shift; return if !length($id); - my $sql = "SELECT * FROM global_info WHERE id = ".$self->quote($id); + my $sql = "SELECT * FROM global_info WHERE id = " . $self->quote($id); return $self->_doSelect($sql, 'value'); } sub fetchSystemByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; $resultCols = '*' unless (defined $resultCols); @@ -202,11 +203,11 @@ sub fetchSystemByFilter sub fetchSystemByID { - my $self = shift; - my $ids = shift; + my $self = shift; + my $ids = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $idStr = join ',', @$ids; return if !length($idStr); my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)"; @@ -215,7 +216,7 @@ sub fetchSystemByID sub fetchSystemIDsOfExport { - my $self = shift; + my $self = shift; my $exportID = shift; my $sql = qq[ @@ -226,7 +227,7 @@ sub fetchSystemIDsOfExport sub fetchSystemIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; my $sql = qq[ @@ -237,7 +238,7 @@ sub fetchSystemIDsOfClient sub fetchSystemIDsOfGroup { - my $self = shift; + my $self = shift; my $groupID = shift; my $sql = qq[ @@ -248,11 +249,11 @@ sub fetchSystemIDsOfGroup sub fetchClientByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $sql = "SELECT $resultCols FROM client"; my $connector; foreach my $col (keys %$filter) { @@ -264,11 +265,11 @@ sub fetchClientByFilter sub fetchClientByID { - my $self = shift; - my $ids = shift; + my $self = shift; + my $ids = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $idStr = join ',', @$ids; return if !length($idStr); my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)"; @@ -277,7 +278,7 @@ sub fetchClientByID sub fetchClientIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; my $sql = qq[ @@ -288,7 +289,7 @@ sub fetchClientIDsOfSystem sub fetchClientIDsOfGroup { - my $self = shift; + my $self = shift; my $groupID = shift; my $sql = qq[ @@ -299,11 +300,11 @@ sub fetchClientIDsOfGroup sub fetchGroupByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $sql = "SELECT $resultCols FROM groups"; my $connector; foreach my $col (keys %$filter) { @@ -315,11 +316,11 @@ sub fetchGroupByFilter sub fetchGroupByID { - my $self = shift; - my $ids = shift; + my $self = shift; + my $ids = shift; my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); + $resultCols = '*' unless (defined $resultCols); my $idStr = join ',', @$ids; return if !length($idStr); my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)"; @@ -328,7 +329,7 @@ sub fetchGroupByID sub fetchGroupIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; my $sql = qq[ @@ -339,7 +340,7 @@ sub fetchGroupIDsOfSystem sub fetchGroupIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; my $sql = qq[ @@ -353,12 +354,12 @@ sub fetchGroupIDsOfClient ################################################################################ sub _doInsert { - my $self = shift; - my $table = shift; - my $valRows = shift; + my $self = shift; + my $table = shift; + my $valRows = shift; my $ignoreIDs = shift; - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $valRow = (@$valRows)[0]; return if !defined $valRow || !scalar keys %$valRow; @@ -380,15 +381,16 @@ sub _doInsert vlog(3, "generated id for <$table> is <$valRow->{id}>"); } my $cols = join ', ', keys %$valRow; - my $values = join ', ', map { $self->quote($valRow->{$_}) } keys %$valRow; + my $values = join ', ', + map { $self->quote($valRow->{$_}) } keys %$valRow; my $sql = "INSERT INTO $table ( $cols ) VALUES ( $values )"; vlog(3, $sql); my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); $sth->execute() - or confess _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); if (!$ignoreIDs && !defined $valRow->{id}) { # id has not been pre-specified, we need to fetch it from DB: $valRow->{'id'} = $dbh->last_insert_id(undef, undef, $table, 'id'); @@ -401,80 +403,78 @@ sub _doInsert sub _doDelete { - my $self = shift; - my $table = shift; - my $IDs = shift; - my $idCol = shift; + my $self = shift; + my $table = shift; + my $IDs = shift; + my $idCol = shift; my $additionalWhereClause = shift; my $dbh = $self->{'dbh'}; - $IDs = [undef] unless defined $IDs; - $idCol = 'id' unless defined $idCol; + $IDs = [undef] unless defined $IDs; + $idCol = 'id' unless defined $idCol; foreach my $id (@$IDs) { my $sql = "DELETE FROM $table"; if (defined $id) { - $sql .= " WHERE $idCol = ".$self->quote($id); + $sql .= " WHERE $idCol = " . $self->quote($id); if (defined $additionalWhereClause) { $sql .= $additionalWhereClause; } } vlog(3, $sql); my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); $sth->execute() - or confess _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); } return 1; } sub _doUpdate { - my $self = shift; - my $table = shift; - my $IDs = shift; + my $self = shift; + my $table = shift; + my $IDs = shift; my $valRows = shift; - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $valRow = (@$valRows)[0]; return if !defined $valRow || !scalar keys %$valRow; my $idx = 0; foreach my $valRow (@$valRows) { - my $id = $IDs->[$idx++]; + my $id = $IDs->[$idx++]; my %valData = %$valRow; delete $valData{'id'}; - # filter column 'id' if present, as we don't want to update it - my $cols = join ', ', - map { "$_ = ".$self->quote($valRow->{$_}) } - grep { $_ ne 'id' } - # filter column 'id' if present, as we don't want - # to update it! - keys %$valRow; + # filter column 'id' if present, as we don't want to update it + my $cols = join ', ', map { "$_ = " . $self->quote($valRow->{$_}) } + grep { $_ ne 'id' } + # filter column 'id' if present, as we don't want + # to update it! + keys %$valRow; my $sql = "UPDATE $table SET $cols"; if (defined $id) { - $sql .= " WHERE id = ".$self->quote($id); + $sql .= " WHERE id = " . $self->quote($id); } vlog(3, $sql); my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); $sth->execute() - or confess _tr(q[Can't update table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); } return 1; } sub _updateRefTable { - my $self = shift; - my $table = shift; - my $keyID = shift; + my $self = shift; + my $table = shift; + my $keyID = shift; my $newValueIDs = shift; - my $keyCol = shift; - my $valueCol = shift; + my $keyCol = shift; + my $valueCol = shift; my $oldValueIDs = shift; my %lastValueIDs; @@ -484,7 +484,7 @@ sub _updateRefTable if (!exists $lastValueIDs{$valueID}) { # value-ID is new, create it my $valRow = { - $keyCol => $keyID, + $keyCol => $keyID, $valueCol => $valueID, }; $self->_doInsert($table, [$valRow]); @@ -496,19 +496,19 @@ sub _updateRefTable # all the remaining value-IDs need to be removed: if (scalar keys %lastValueIDs) { - $self->_doDelete($table, [ keys %lastValueIDs ], $valueCol, - " AND $keyCol='$keyID'"); + $self->_doDelete($table, [keys %lastValueIDs], + $valueCol, " AND $keyCol='$keyID'"); } return 1; } sub _updateOneToManyRefAttr { - my $self = shift; - my $table = shift; - my $oneID = shift; + my $self = shift; + my $table = shift; + my $oneID = shift; my $newManyIDs = shift; - my $fkCol = shift; + my $fkCol = shift; my $oldManyIDs = shift; my %lastManyIDs; @@ -517,7 +517,7 @@ sub _updateOneToManyRefAttr foreach my $id (@$newManyIDs) { if (!exists $lastManyIDs{$id}) { # ID has changed, update it - $self->_doUpdate($table, $id, [{ $fkCol => $oneID }]); + $self->_doUpdate($table, $id, [{$fkCol => $oneID}]); } else { # ID hasn't changed, leave as is, but remove from hash: delete $lastManyIDs{$id}; @@ -526,14 +526,14 @@ sub _updateOneToManyRefAttr # all the remaining many-IDs need to be set to 0: foreach my $id (scalar keys %lastManyIDs) { - $self->_doUpdate($table, $id, [{ $fkCol => '0' }]); + $self->_doUpdate($table, $id, [{$fkCol => '0'}]); } return 1; } sub addVendorOS { - my $self = shift; + my $self = shift; my $valRows = shift; return $self->_doInsert('vendor_os', $valRows); @@ -541,7 +541,7 @@ sub addVendorOS sub removeVendorOS { - my $self = shift; + my $self = shift; my $vendorOSIDs = shift; return $self->_doDelete('vendor_os', $vendorOSIDs); @@ -549,16 +549,16 @@ sub removeVendorOS sub changeVendorOS { - my $self = shift; + my $self = shift; my $vendorOSIDs = shift; - my $valRows = shift; + my $valRows = shift; return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); } sub addExport { - my $self = shift; + my $self = shift; my $valRows = shift; return $self->_doInsert('export', $valRows); @@ -566,7 +566,7 @@ sub addExport sub removeExport { - my $self = shift; + my $self = shift; my $exportIDs = shift; return $self->_doDelete('export', $exportIDs); @@ -574,25 +574,25 @@ sub removeExport sub changeExport { - my $self = shift; + my $self = shift; my $exportIDs = shift; - my $valRows = shift; + my $valRows = shift; return $self->_doUpdate('export', $exportIDs, $valRows); } sub changeGlobalInfo { - my $self = shift; - my $id = shift; + my $self = shift; + my $id = shift; my $value = shift; - return $self->_doUpdate('global_info', [$id], [{ 'value' => $value }] ); + return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); } sub addSystem { - my $self = shift; + my $self = shift; my $valRows = shift; return $self->_doInsert('system', $valRows); @@ -600,7 +600,7 @@ sub addSystem sub removeSystem { - my $self = shift; + my $self = shift; my $systemIDs = shift; return $self->_doDelete('system', $systemIDs); @@ -608,38 +608,38 @@ sub removeSystem sub changeSystem { - my $self = shift; + my $self = shift; my $systemIDs = shift; - my $valRows = shift; + my $valRows = shift; return $self->_doUpdate('system', $systemIDs, $valRows); } sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; my $clientIDs = shift; my @currClients = $self->fetchClientIDsOfSystem($systemID); return $self->_updateRefTable('client_system_ref', $systemID, $clientIDs, - 'system_id', 'client_id', \@currClients); + 'system_id', 'client_id', \@currClients); } sub setGroupIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; my $groupIDs = shift; my @currGroups = $self->fetchGroupIDsOfSystem($systemID); return $self->_updateRefTable('group_system_ref', $systemID, $groupIDs, - 'system_id', 'group_id', \@currGroups); + 'system_id', 'group_id', \@currGroups); } sub addClient { - my $self = shift; + my $self = shift; my $valRows = shift; return $self->_doInsert('client', $valRows); @@ -647,7 +647,7 @@ sub addClient sub removeClient { - my $self = shift; + my $self = shift; my $clientIDs = shift; return $self->_doDelete('client', $clientIDs); @@ -655,38 +655,38 @@ sub removeClient sub changeClient { - my $self = shift; + my $self = shift; my $clientIDs = shift; - my $valRows = shift; + my $valRows = shift; return $self->_doUpdate('client', $clientIDs, $valRows); } sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; my $systemIDs = shift; my @currSystems = $self->fetchSystemIDsOfClient($clientID); $self->_updateRefTable('client_system_ref', $clientID, $systemIDs, - 'client_id', 'system_id', \@currSystems); + 'client_id', 'system_id', \@currSystems); } sub setGroupIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; my $groupIDs = shift; my @currGroups = $self->fetchGroupIDsOfClient($clientID); $self->_updateRefTable('group_client_ref', $clientID, $groupIDs, - 'client_id', 'group_id', \@currGroups); + 'client_id', 'group_id', \@currGroups); } sub addGroup { - my $self = shift; + my $self = shift; my $valRows = shift; return $self->_doInsert('groups', $valRows); @@ -694,7 +694,7 @@ sub addGroup sub removeGroup { - my $self = shift; + my $self = shift; my $groupIDs = shift; return $self->_doDelete('groups', $groupIDs); @@ -702,33 +702,33 @@ sub removeGroup sub changeGroup { - my $self = shift; + my $self = shift; my $groupIDs = shift; - my $valRows = shift; + my $valRows = shift; return $self->_doUpdate('groups', $groupIDs, $valRows); } sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $clientIDs = shift; my @currClients = $self->fetchClientIDsOfGroup($groupID); - $self->_updateRefTable('group_client_ref', $groupID, $clientIDs, - 'group_id', 'client_id', \@currClients); + $self->_updateRefTable('group_client_ref', $groupID, $clientIDs, 'group_id', + 'client_id', \@currClients); } sub setSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $systemIDs = shift; my @currSystems = $self->fetchSystemIDsOfGroup($groupID); - $self->_updateRefTable('group_system_ref', $groupID, $systemIDs, - 'group_id', 'system_id', \@currSystems); + $self->_updateRefTable('group_system_ref', $groupID, $systemIDs, 'group_id', + 'system_id', \@currSystems); } ################################################################################ @@ -736,43 +736,38 @@ sub setSystemIDsOfGroup ################################################################################ sub _convertColDescrsToDBNativeString { - my $self = shift; + my $self = shift; my $colDescrs = shift; - my $colDescrString - = join ', ', - map { - # convert each column description into database native format - # (e.g. convert 'name:s.45' to 'name char(45)'): - if (!m[^\s*(\S+?)\s*:\s*(\S+?)\s*$]) { - confess _tr('UnknownDbSchemaColumnDescr', $_); - } - "$1 ".$self->schemaConvertTypeDescrToNative($2); - } - @$colDescrs; + my $colDescrString = join ', ', map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:\s*(\S+?)\s*$]) { + confess _tr('UnknownDbSchemaColumnDescr', $_); + } + "$1 " . $self->schemaConvertTypeDescrToNative($2); + } @$colDescrs; return $colDescrString; } sub _convertColDescrsToColNames { - my $self = shift; + my $self = shift; my $colDescrs = shift; - return - map { - # convert each column description into database native format - # (e.g. convert 'name:s.45' to 'name char(45)'): - if (!m[^\s*(\S+?)\s*:.+$]) { - confess _tr('UnknownDbSchemaColumnDescr', $_); - } - $1; + return map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:.+$]) { + confess _tr('UnknownDbSchemaColumnDescr', $_); } - @$colDescrs; + $1; + } @$colDescrs; } sub _convertColDescrsToColNamesString { - my $self = shift; + my $self = shift; my $colDescrs = shift; return join ', ', $self->_convertColDescrsToColNames($colDescrs); @@ -784,19 +779,18 @@ sub schemaFetchDBVersion my $dbh = $self->{'dbh'}; local $dbh->{RaiseError} = 1; - my $row = eval { - $dbh->selectrow_hashref('SELECT schema_version FROM meta'); - }; + my $row = + eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); }; return 0 if $@; - # no database access possible + # no database access possible return undef unless defined $row; - # no entry in meta-table + # no entry in meta-table return $row->{schema_version}; } sub schemaConvertTypeDescrToNative -{ # a default implementation, many DBs need to override... - my $self = shift; +{ # a default implementation, many DBs need to override... + my $self = shift; my $typeDescr = lc(shift); if ($typeDescr eq 'b') { @@ -816,101 +810,102 @@ sub schemaConvertTypeDescrToNative sub schemaAddTable { - my $self = shift; - my $table = shift; - my $colDescrs = shift; + my $self = shift; + my $table = shift; + my $colDescrs = shift; my $initialVals = shift; - my $isSubCmd = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog(1, "adding table <$table> to schema..." unless $isSubCmd); + vlog(1, "adding table <$table> to schema...") unless $isSubCmd; my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $table ($colDescrString)"; + my $sql = "CREATE TABLE $table ($colDescrString)"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); + or confess _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); if (defined $initialVals) { my $ignoreIDs = ($colDescrString !~ m[\bid\b]); - # don't care about IDs if there's no 'id' column in this table + # don't care about IDs if there's no 'id' column in this table $self->_doInsert($table, $initialVals, $ignoreIDs); } } sub schemaDropTable { - my $self = shift; - my $table = shift; + my $self = shift; + my $table = shift; my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog(1, "dropping table <$table> from schema..." unless $isSubCmd); + vlog(1, "dropping table <$table> from schema...") unless $isSubCmd; my $sql = "DROP TABLE $table"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); + or confess _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); } sub schemaRenameTable -{ # a rather simple-minded implementation that renames a table in several - # steps: - # - create the new table - # - copy the data over from the old one - # - drop the old table - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which - # is much more efficient). - my $self = shift; - my $oldTable = shift; - my $newTable = shift; +{ # a rather simple-minded implementation that renames a table in several + # steps: + # - create the new table + # - copy the data over from the old one + # - drop the old table + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which + # is much more efficient). + my $self = shift; + my $oldTable = shift; + my $newTable = shift; my $colDescrs = shift; - my $isSubCmd = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $newTable ($colDescrString)"; + my $sql = "CREATE TABLE $newTable ($colDescrString)"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); + or confess _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); $self->_doInsert($newTable, \@dataRows); $sql = "DROP TABLE $oldTable"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); + or confess _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); } sub schemaAddColumns -{ # a rather simple-minded implementation that adds columns to a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $newColDescrs = shift; +{ # a rather simple-minded implementation that adds columns to a table + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $newColDescrs = shift; my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); - my $newColStr = join ', ', @newColNames; - vlog(1, "adding columns <$newColStr> to table <$table>..." unless $isSubCmd); + my $newColStr = join ', ', @newColNames; + vlog(1, "adding columns <$newColStr> to table <$table>...") + unless $isSubCmd; $self->schemaAddTable($tempTable, $colDescrs, undef, 1); # copy the data from the old table to the new: my @dataRows = $self->_doSelect("SELECT * FROM $table"); $self->_doInsert($tempTable, \@dataRows); - # N.B.: for the insert, we rely on the caller having added the new - # columns to the end of the table (if that isn't the case, things - # break here!) + # N.B.: for the insert, we rely on the caller having added the new + # columns to the end of the table (if that isn't the case, things + # break here!) if (defined $newColDefaultVals) { # default values have been provided, we apply them now: @@ -922,31 +917,31 @@ sub schemaAddColumns } sub schemaDropColumns -{ # a rather simple-minded implementation that drops columns from a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <old> DROP COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; +{ # a rather simple-minded implementation that drops columns from a table + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE <old> DROP COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; my $dropColStr = join ', ', @$dropColNames; - vlog(1, "dropping columns <$dropColStr> from table <$table>..." - unless $isSubCmd); + vlog(1, "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; $self->schemaAddTable($tempTable, $colDescrs, undef, 1); # copy the data from the old table to the new: my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); $self->_doInsert($tempTable, \@dataRows); $self->schemaDropTable($table, 1); @@ -954,34 +949,34 @@ sub schemaDropColumns } sub schemaChangeColumns -{ # a rather simple-minded implementation that changes columns - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <old> CHANGE COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; +{ # a rather simple-minded implementation that changes columns + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE <old> CHANGE COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> of table <$table>..." - unless $isSubCmd); + vlog(1, "changing columns <$changeColStr> of table <$table>...") + unless $isSubCmd; $self->schemaAddTable($tempTable, $colDescrs, undef, 1); # copy the data from the old table to the new: my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT * FROM $table"); + my @dataRows = $self->_doSelect("SELECT * FROM $table"); foreach my $oldCol (keys %$colChanges) { - my $newCol - = $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); + my $newCol = + $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); # rename current column in all data-rows: foreach my $row (@dataRows) { $row->{$newCol} = $row->{$oldCol}; @@ -996,8 +991,6 @@ sub schemaChangeColumns 1; -__END__ - =head1 NAME DBI.pm - provides DBI-based implementation of the OpenSLX MetaDB API. diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index d073f305..65e1668c 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -15,7 +15,7 @@ package OpenSLX::MetaDB::SQLite; use strict; use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version +$VERSION = 1.01; # API-version . implementation-version use base qw(OpenSLX::MetaDB::DBI); ################################################################################ @@ -34,7 +34,7 @@ use OpenSLX::MetaDB::DBI 1; sub new { my $class = shift; - my $self = {}; + my $self = {}; return bless $self, $class; } @@ -46,57 +46,61 @@ sub connect if (!defined $dbSpec) { # build $dbSpec from individual parameters: my $dbBasepath = "$openslxConfig{'private-path'}/db"; - my $dbDatadir = 'sqlite'; - my $dbPath = "$dbBasepath/$dbDatadir"; - system("mkdir -p $dbPath") unless -e $dbPath; + my $dbDatadir = 'sqlite'; + my $dbPath = "$dbBasepath/$dbDatadir"; + system("mkdir -p $dbPath") unless -e $dbPath; $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; } vlog(1, "trying to connect to SQLite-database <$dbSpec>"); - eval ('require DBD::SQLite; 1;') - or die _tr(qq[%s doesn't seem to be installed, -so there is no support for %s available, sorry!\n%s], 'DBD::SQLite', 'SQLite', $@); - $self->{'dbh'} = DBI->connect("dbi:SQLite:$dbSpec", undef, undef, - {PrintError => 0, AutoCommit => 1}) - or die _tr("Cannot connect to database <%s> (%s)", - $dbSpec, $DBI::errstr); + eval('require DBD::SQLite; 1;') + or die _tr( + qq[%s doesn't seem to be installed, +so there is no support for %s available, sorry!\n%s], 'DBD::SQLite', 'SQLite', + $@ + ); + $self->{'dbh'} = + DBI->connect("dbi:SQLite:$dbSpec", undef, undef, + {PrintError => 0, AutoCommit => 1}) + or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); } sub schemaRenameTable { - my $self = shift; - my $oldTable = shift; - my $newTable = shift; + my $self = shift; + my $oldTable = shift; + my $newTable = shift; my $colDescrs = shift; - my $isSubCmd = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); + or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); } sub schemaAddColumns { - my $self = shift; - my $table = shift; - my $newColDescrs = shift; + my $self = shift; + my $table = shift; + my $newColDescrs = shift; my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog(1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd); + vlog(1, "adding columns <$newColNames> to table <$table>") + unless $isSubCmd; foreach my $colDescr (@$newColDescrs) { - my $colDescrString - = $self->_convertColDescrsToDBNativeString([$colDescr]); + my $colDescrString = + $self->_convertColDescrsToDBNativeString([$colDescr]); my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't add column to table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't add column to table <%s> (%s)], $table, + $dbh->errstr); } # if default values have been provided, we apply them now: if (defined $newColDefaultVals) { @@ -104,4 +108,4 @@ sub schemaAddColumns } } -1;
\ No newline at end of file +1; diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm index eb6f9551..195f9870 100644 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -15,7 +15,7 @@ package OpenSLX::MetaDB::mysql; use strict; use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version +$VERSION = 1.01; # API-version . implementation-version use base qw(OpenSLX::MetaDB::DBI); ################################################################################ @@ -34,7 +34,7 @@ use OpenSLX::MetaDB::DBI 1; sub new { my $class = shift; - my $self = {}; + my $self = {}; return bless $self, $class; } @@ -49,15 +49,14 @@ sub connect } my $user = (getpwuid($>))[0]; vlog(1, "trying to connect user <$user> to mysql-database <$dbSpec>"); - $self->{'dbh'} = DBI->connect("dbi:mysql:$dbSpec", $user, '', - {PrintError => 0}) - or die _tr("Cannot connect to database <%s> (%s)", - $dbSpec, $DBI::errstr); + $self->{'dbh'} = + DBI->connect("dbi:mysql:$dbSpec", $user, '', {PrintError => 0}) + or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); } sub schemaConvertTypeDescrToNative { - my $self = shift; + my $self = shift; my $typeDescr = lc(shift); if ($typeDescr eq 'b') { @@ -77,44 +76,40 @@ sub schemaConvertTypeDescrToNative sub schemaRenameTable { - my $self = shift; - my $oldTable = shift; - my $newTable = shift; + my $self = shift; + my $oldTable = shift; + my $newTable = shift; my $colDescrs = shift; - my $isSubCmd = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); + or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); } sub schemaAddColumns { - my $self = shift; - my $table = shift; - my $newColDescrs = shift; + my $self = shift; + my $table = shift; + my $newColDescrs = shift; my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; + my $dbh = $self->{'dbh'}; my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog(1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd); - my $addClause - = join ', ', - map { - "ADD COLUMN " - .$self->_convertColDescrsToDBNativeString([$_]); - } - @$newColDescrs; + vlog(1, "adding columns <$newColNames> to table <$table>") unless $isSubCmd; + my $addClause = join ', ', + map { "ADD COLUMN " . $self->_convertColDescrsToDBNativeString([$_]); } + @$newColDescrs; my $sql = "ALTER TABLE $table $addClause"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't add columns to table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't add columns to table <%s> (%s)], $table, + $dbh->errstr); # if default values have been provided, we apply them now: if (defined $newColDefaultVals) { $self->_doUpdate($table, undef, $newColDefaultVals); @@ -123,47 +118,46 @@ sub schemaAddColumns sub schemaDropColumns { - my $self = shift; - my $table = shift; + my $self = shift; + my $table = shift; my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; my $dropColStr = join ', ', @$dropColNames; - vlog(1, "dropping columns <$dropColStr> from table <$table>..." - unless $isSubCmd); + vlog(1, + "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; my $dropClause = join ', ', map { "DROP COLUMN $_" } @$dropColNames; my $sql = "ALTER TABLE $table $dropClause"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't drop columns from table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't drop columns from table <%s> (%s)], $table, + $dbh->errstr); } sub schemaChangeColumns { - my $self = shift; - my $table = shift; + my $self = shift; + my $table = shift; my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $colDescrs = shift; + my $isSubCmd = shift; my $dbh = $self->{'dbh'}; my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> in table <$table>..." - unless $isSubCmd); - my $changeClause - = join ', ', - map { - "CHANGE COLUMN $_ " - .$self->_convertColDescrsToDBNativeString([$colChanges->{$_}]); - } - keys %$colChanges; + vlog(1, "changing columns <$changeColStr> in table <$table>...") + unless $isSubCmd; + my $changeClause = join ', ', map { + "CHANGE COLUMN $_ " + . $self->_convertColDescrsToDBNativeString([$colChanges->{$_}]); + } + keys %$colChanges; my $sql = "ALTER TABLE $table $changeClause"; vlog(3, $sql); $dbh->do($sql) - or confess _tr(q[Can't change columns in table <%s> (%s)], $table, - $dbh->errstr); + or confess _tr(q[Can't change columns in table <%s> (%s)], $table, + $dbh->errstr); } -1;
\ No newline at end of file +1; |