summaryrefslogtreecommitdiffstats
path: root/config-db/OpenSLX/MetaDB/DBI.pm
diff options
context:
space:
mode:
Diffstat (limited to 'config-db/OpenSLX/MetaDB/DBI.pm')
-rw-r--r--config-db/OpenSLX/MetaDB/DBI.pm1978
1 files changed, 989 insertions, 989 deletions
diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm
index 1d706d8c..819d8350 100644
--- a/config-db/OpenSLX/MetaDB/DBI.pm
+++ b/config-db/OpenSLX/MetaDB/DBI.pm
@@ -9,7 +9,7 @@
# General information about OpenSLX can be found at http://openslx.org/
# -----------------------------------------------------------------------------
# DBI.pm
-# - provides DBI-based implementation of the OpenSLX MetaDB API.
+# - provides DBI-based implementation of the OpenSLX MetaDB API.
# -----------------------------------------------------------------------------
package OpenSLX::MetaDB::DBI;
@@ -27,44 +27,44 @@ use OpenSLX::Utils;
################################################################################
sub new
{
- confess "Don't call OpenSLX::MetaDB::DBI::new directly!";
+ confess "Don't call OpenSLX::MetaDB::DBI::new directly!";
}
sub disconnect
{
- my $self = shift;
+ my $self = shift;
- $self->{'dbh'}->disconnect;
- $self->{'dbh'} = undef;
- return;
+ $self->{'dbh'}->disconnect;
+ $self->{'dbh'} = undef;
+ return;
}
sub quote
-{ # default implementation quotes any given values through the DBI
- my $self = shift;
+{ # default implementation quotes any given values through the DBI
+ my $self = shift;
- return $self->{'dbh'}->quote(@_);
+ return $self->{'dbh'}->quote(@_);
}
sub startTransaction
-{ # default implementation passes on the request to the DBI
- my $self = shift;
+{ # default implementation passes on the request to the DBI
+ my $self = shift;
- return $self->{'dbh'}->begin_work();
+ return $self->{'dbh'}->begin_work();
}
sub commitTransaction
-{ # default implementation passes on the request to the DBI
- my $self = shift;
+{ # default implementation passes on the request to the DBI
+ my $self = shift;
- return $self->{'dbh'}->commit();
+ return $self->{'dbh'}->commit();
}
sub rollbackTransaction
-{ # default implementation passes on the request to the DBI
- my $self = shift;
+{ # default implementation passes on the request to the DBI
+ my $self = shift;
- return $self->{'dbh'}->rollback();
+ return $self->{'dbh'}->rollback();
}
################################################################################
@@ -72,442 +72,442 @@ sub rollbackTransaction
################################################################################
sub _trim
{
- my $s = shift;
- $s =~ s[^\s*(.*?)\s*$][$1];
- return $s;
+ my $s = shift;
+ $s =~ s[^\s*(.*?)\s*$][$1];
+ return $s;
}
sub _buildFilterClause
{
- my $self = shift;
- my $filter = shift || {};
- my $filterClause = shift || '';
-
- my ($connector, $quotedVal);
- foreach my $col (keys %$filter) {
- $connector = !length($filterClause) ? 'WHERE' : 'AND';
- if (defined $filter->{$col}) {
- $quotedVal = $self->{dbh}->quote($filter->{$col});
- $filterClause .= unshiftHereDoc(<<" End-of-Here");
- $connector $col = $quotedVal
- End-of-Here
- } else {
- $filterClause .= unshiftHereDoc(<<" End-of-Here");
- $connector $col IS NULL
- End-of-Here
- }
- }
-
- return $filterClause || '';
+ my $self = shift;
+ my $filter = shift || {};
+ my $filterClause = shift || '';
+
+ my ($connector, $quotedVal);
+ foreach my $col (keys %$filter) {
+ $connector = !length($filterClause) ? 'WHERE' : 'AND';
+ if (defined $filter->{$col}) {
+ $quotedVal = $self->{dbh}->quote($filter->{$col});
+ $filterClause .= unshiftHereDoc(<<" End-of-Here");
+ $connector $col = $quotedVal
+ End-of-Here
+ } else {
+ $filterClause .= unshiftHereDoc(<<" End-of-Here");
+ $connector $col IS NULL
+ End-of-Here
+ }
+ }
+
+ return $filterClause || '';
}
sub _buildAttrFilterClause
{
- my $self = shift;
- my $attrFilter = shift || {};
- my $table = shift;
- my $filterClause = shift || '';
-
- my %tableMap = (
- 'client' => 'client',
- 'group' => 'groups',
- 'system' => 'system',
- );
-
- my ($connector, $quotedName, $quotedValue);
- foreach my $name (keys %$attrFilter) {
- $connector = !length($filterClause) ? 'WHERE' : 'AND';
- $quotedName = $self->{dbh}->quote($name);
- if (defined $attrFilter->{$name}) {
- $quotedValue = $self->{dbh}->quote($attrFilter->{$name});
- $filterClause .= unshiftHereDoc(<<" End-of-Here");
- $connector EXISTS (
- SELECT name FROM ${table}_attr
- WHERE name = $quotedName
- AND value = $quotedValue
- AND ${table}_id = $tableMap{$table}.id
- )
- End-of-Here
- } else {
- $filterClause .= unshiftHereDoc(<<" End-of-Here");
- $connector NOT EXISTS (
- SELECT name FROM ${table}_attr
- WHERE name = $quotedName
- AND ${table}_id = $tableMap{$table}.id
- )
- End-of-Here
- }
- }
-
- return $filterClause;
+ my $self = shift;
+ my $attrFilter = shift || {};
+ my $table = shift;
+ my $filterClause = shift || '';
+
+ my %tableMap = (
+ 'client' => 'client',
+ 'group' => 'groups',
+ 'system' => 'system',
+ );
+
+ my ($connector, $quotedName, $quotedValue);
+ foreach my $name (keys %$attrFilter) {
+ $connector = !length($filterClause) ? 'WHERE' : 'AND';
+ $quotedName = $self->{dbh}->quote($name);
+ if (defined $attrFilter->{$name}) {
+ $quotedValue = $self->{dbh}->quote($attrFilter->{$name});
+ $filterClause .= unshiftHereDoc(<<" End-of-Here");
+ $connector EXISTS (
+ SELECT name FROM ${table}_attr
+ WHERE name = $quotedName
+ AND value = $quotedValue
+ AND ${table}_id = $tableMap{$table}.id
+ )
+ End-of-Here
+ } else {
+ $filterClause .= unshiftHereDoc(<<" End-of-Here");
+ $connector NOT EXISTS (
+ SELECT name FROM ${table}_attr
+ WHERE name = $quotedName
+ AND ${table}_id = $tableMap{$table}.id
+ )
+ End-of-Here
+ }
+ }
+
+ return $filterClause;
}
sub _doSelect
{
- my $self = shift;
- my $sql = shift;
- my $resultCol = shift;
-
- my $dbh = $self->{'dbh'};
-
- vlog(3, _trim($sql));
- my $sth = $dbh->prepare($sql)
- or croak _tr(
- q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr
- );
- $sth->execute()
- or croak _tr(
- q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr
- );
- my @vals;
- while (my $row = $sth->fetchrow_hashref()) {
- if (defined $resultCol) {
- return $row->{$resultCol} unless wantarray();
- push @vals, $row->{$resultCol};
- } else {
- return $row unless wantarray();
- push @vals, $row;
- }
- }
-
- # return undef if there's no result in scalar context
- return if !wantarray();
-
- return @vals;
+ my $self = shift;
+ my $sql = shift;
+ my $resultCol = shift;
+
+ my $dbh = $self->{'dbh'};
+
+ vlog(3, _trim($sql));
+ my $sth = $dbh->prepare($sql)
+ or croak _tr(
+ q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr
+ );
+ $sth->execute()
+ or croak _tr(
+ q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr
+ );
+ my @vals;
+ while (my $row = $sth->fetchrow_hashref()) {
+ if (defined $resultCol) {
+ return $row->{$resultCol} unless wantarray();
+ push @vals, $row->{$resultCol};
+ } else {
+ return $row unless wantarray();
+ push @vals, $row;
+ }
+ }
+
+ # return undef if there's no result in scalar context
+ return if !wantarray();
+
+ return @vals;
}
sub fetchVendorOSByFilter
{
- my $self = shift;
- my $filter = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $filter = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $filterClause = $self->_buildFilterClause($filter);
- my $sql = "SELECT $resultCols FROM vendor_os $filterClause";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $filterClause = $self->_buildFilterClause($filter);
+ my $sql = "SELECT $resultCols FROM vendor_os $filterClause";
+ return $self->_doSelect($sql);
}
sub fetchVendorOSByID
{
- my $self = shift;
- my $ids = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $ids = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $idStr = join ',', @$ids;
- return if !length($idStr);
- my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $idStr = join ',', @$ids;
+ return if !length($idStr);
+ my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)";
+ return $self->_doSelect($sql);
}
sub fetchInstalledPlugins
{
- my $self = shift;
- my $vendorOSID = shift;
- my $pluginName = shift;
- my $fullInfo = shift || 0;
-
- return if !defined $vendorOSID;
- my $nameClause
- = defined $pluginName
- ? "AND plugin_name = '$pluginName'"
- : '';
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT * FROM installed_plugin
- WHERE vendor_os_id = '$vendorOSID'
- $nameClause
- End-of-Here
- my @pluginInfos = $self->_doSelect($sql);
- return if !@pluginInfos;
-
- @pluginInfos = map {
- my $pluginInfo = $_;
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT * FROM installed_plugin_attr
- WHERE installed_plugin_id = '$pluginInfo->{id}'
- End-of-Here
- my @attrs = $self->_doSelect($sql);
- $pluginInfo->{attrs} = {
- map {
- ( $_->{name}, $fullInfo ? $_ : $_->{value} )
- } @attrs
- };
- $pluginInfo;
- }
- @pluginInfos;
-
- return wantarray() ? @pluginInfos : $pluginInfos[0];
+ my $self = shift;
+ my $vendorOSID = shift;
+ my $pluginName = shift;
+ my $fullInfo = shift || 0;
+
+ return if !defined $vendorOSID;
+ my $nameClause
+ = defined $pluginName
+ ? "AND plugin_name = '$pluginName'"
+ : '';
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT * FROM installed_plugin
+ WHERE vendor_os_id = '$vendorOSID'
+ $nameClause
+ End-of-Here
+ my @pluginInfos = $self->_doSelect($sql);
+ return if !@pluginInfos;
+
+ @pluginInfos = map {
+ my $pluginInfo = $_;
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT * FROM installed_plugin_attr
+ WHERE installed_plugin_id = '$pluginInfo->{id}'
+ End-of-Here
+ my @attrs = $self->_doSelect($sql);
+ $pluginInfo->{attrs} = {
+ map {
+ ( $_->{name}, $fullInfo ? $_ : $_->{value} )
+ } @attrs
+ };
+ $pluginInfo;
+ }
+ @pluginInfos;
+
+ return wantarray() ? @pluginInfos : $pluginInfos[0];
}
sub fetchExportByFilter
{
- my $self = shift;
- my $filter = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $filter = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $filterClause = $self->_buildFilterClause($filter);
- my $sql = "SELECT $resultCols FROM export $filterClause";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $filterClause = $self->_buildFilterClause($filter);
+ my $sql = "SELECT $resultCols FROM export $filterClause";
+ return $self->_doSelect($sql);
}
sub fetchExportByID
{
- my $self = shift;
- my $ids = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $ids = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $idStr = join ',', @$ids;
- return if !length($idStr);
- my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $idStr = join ',', @$ids;
+ return if !length($idStr);
+ my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)";
+ return $self->_doSelect($sql);
}
sub fetchExportIDsOfVendorOS
{
- my $self = shift;
- my $vendorOSID = shift;
+ my $self = shift;
+ my $vendorOSID = shift;
- my $sql = qq[
- SELECT id FROM export WHERE vendor_os_id = '$vendorOSID'
- ];
- return $self->_doSelect($sql, 'id');
+ my $sql = qq[
+ SELECT id FROM export WHERE vendor_os_id = '$vendorOSID'
+ ];
+ return $self->_doSelect($sql, 'id');
}
sub fetchGlobalInfo
{
- my $self = shift;
- my $id = shift;
+ my $self = shift;
+ my $id = shift;
- return if !length($id);
- my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id);
- return $self->_doSelect($sql, 'value');
+ return if !length($id);
+ my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id);
+ return $self->_doSelect($sql, 'value');
}
sub fetchSystemByFilter
{
- my $self = shift;
- my $filter = shift;
- my $resultCols = shift;
- my $attrFilter = shift;
+ my $self = shift;
+ my $filter = shift;
+ my $resultCols = shift;
+ my $attrFilter = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $filterClause = $self->_buildFilterClause($filter);
- $filterClause = $self->_buildAttrFilterClause(
- $attrFilter, 'system', $filterClause
- );
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT $resultCols FROM system
- $filterClause
- End-of-Here
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $filterClause = $self->_buildFilterClause($filter);
+ $filterClause = $self->_buildAttrFilterClause(
+ $attrFilter, 'system', $filterClause
+ );
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT $resultCols FROM system
+ $filterClause
+ End-of-Here
+ return $self->_doSelect($sql);
}
sub fetchSystemByID
{
- my $self = shift;
- my $ids = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $ids = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $idStr = join ',', @$ids;
- return if !length($idStr);
- my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $idStr = join ',', @$ids;
+ return if !length($idStr);
+ my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)";
+ return $self->_doSelect($sql);
}
sub fetchSystemAttrs
{
- my $self = shift;
- my $systemID = $self->{dbh}->quote(shift);
+ my $self = shift;
+ my $systemID = $self->{dbh}->quote(shift);
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT name, value FROM system_attr
- WHERE system_id = $systemID
- End-of-Here
- my @attrs = $self->_doSelect($sql);
- my $Result = {};
- foreach my $attr (@attrs) {
- $Result->{$attr->{name}} = $attr->{value};
- }
- return $Result;
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT name, value FROM system_attr
+ WHERE system_id = $systemID
+ End-of-Here
+ my @attrs = $self->_doSelect($sql);
+ my $Result = {};
+ foreach my $attr (@attrs) {
+ $Result->{$attr->{name}} = $attr->{value};
+ }
+ return $Result;
}
sub fetchSystemIDsOfExport
{
- my $self = shift;
- my $exportID = shift;
+ my $self = shift;
+ my $exportID = shift;
- my $sql = qq[
- SELECT id FROM system WHERE export_id = '$exportID'
- ];
- return $self->_doSelect($sql, 'id');
+ my $sql = qq[
+ SELECT id FROM system WHERE export_id = '$exportID'
+ ];
+ return $self->_doSelect($sql, 'id');
}
sub fetchSystemIDsOfClient
{
- my $self = shift;
- my $clientID = shift;
+ my $self = shift;
+ my $clientID = shift;
- my $sql = qq[
- SELECT system_id FROM client_system_ref WHERE client_id = '$clientID'
- ];
- return $self->_doSelect($sql, 'system_id');
+ my $sql = qq[
+ SELECT system_id FROM client_system_ref WHERE client_id = '$clientID'
+ ];
+ return $self->_doSelect($sql, 'system_id');
}
sub fetchSystemIDsOfGroup
{
- my $self = shift;
- my $groupID = shift;
+ my $self = shift;
+ my $groupID = shift;
- my $sql = qq[
- SELECT system_id FROM group_system_ref WHERE group_id = '$groupID'
- ];
- return $self->_doSelect($sql, 'system_id');
+ my $sql = qq[
+ SELECT system_id FROM group_system_ref WHERE group_id = '$groupID'
+ ];
+ return $self->_doSelect($sql, 'system_id');
}
sub fetchClientByFilter
{
- my $self = shift;
- my $filter = shift;
- my $resultCols = shift;
- my $attrFilter = shift;
+ my $self = shift;
+ my $filter = shift;
+ my $resultCols = shift;
+ my $attrFilter = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $filterClause = $self->_buildFilterClause($filter);
- $filterClause = $self->_buildAttrFilterClause(
- $attrFilter, 'client', $filterClause
- );
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT $resultCols FROM client
- $filterClause
- End-of-Here
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $filterClause = $self->_buildFilterClause($filter);
+ $filterClause = $self->_buildAttrFilterClause(
+ $attrFilter, 'client', $filterClause
+ );
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT $resultCols FROM client
+ $filterClause
+ End-of-Here
+ return $self->_doSelect($sql);
}
sub fetchClientByID
{
- my $self = shift;
- my $ids = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $ids = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $idStr = join ',', @$ids;
- return if !length($idStr);
- my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $idStr = join ',', @$ids;
+ return if !length($idStr);
+ my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)";
+ return $self->_doSelect($sql);
}
sub fetchClientAttrs
{
- my $self = shift;
- my $clientID = $self->{dbh}->quote(shift);
+ my $self = shift;
+ my $clientID = $self->{dbh}->quote(shift);
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT name, value FROM client_attr
- WHERE client_id = $clientID
- End-of-Here
- my @attrs = $self->_doSelect($sql);
- my $Result = {};
- foreach my $attr (@attrs) {
- $Result->{$attr->{name}} = $attr->{value};
- }
- return $Result;
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT name, value FROM client_attr
+ WHERE client_id = $clientID
+ End-of-Here
+ my @attrs = $self->_doSelect($sql);
+ my $Result = {};
+ foreach my $attr (@attrs) {
+ $Result->{$attr->{name}} = $attr->{value};
+ }
+ return $Result;
}
sub fetchClientIDsOfSystem
{
- my $self = shift;
- my $systemID = shift;
+ my $self = shift;
+ my $systemID = shift;
- my $sql = qq[
- SELECT client_id FROM client_system_ref WHERE system_id = '$systemID'
- ];
- return $self->_doSelect($sql, 'client_id');
+ my $sql = qq[
+ SELECT client_id FROM client_system_ref WHERE system_id = '$systemID'
+ ];
+ return $self->_doSelect($sql, 'client_id');
}
sub fetchClientIDsOfGroup
{
- my $self = shift;
- my $groupID = shift;
+ my $self = shift;
+ my $groupID = shift;
- my $sql = qq[
- SELECT client_id FROM group_client_ref WHERE group_id = '$groupID'
- ];
- return $self->_doSelect($sql, 'client_id');
+ my $sql = qq[
+ SELECT client_id FROM group_client_ref WHERE group_id = '$groupID'
+ ];
+ return $self->_doSelect($sql, 'client_id');
}
sub fetchGroupByFilter
{
- my $self = shift;
- my $filter = shift;
- my $resultCols = shift;
- my $attrFilter = shift;
+ my $self = shift;
+ my $filter = shift;
+ my $resultCols = shift;
+ my $attrFilter = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $filterClause = $self->_buildFilterClause($filter);
- $filterClause = $self->_buildAttrFilterClause(
- $attrFilter, 'group', $filterClause
- );
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT $resultCols FROM groups
- $filterClause
- End-of-Here
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $filterClause = $self->_buildFilterClause($filter);
+ $filterClause = $self->_buildAttrFilterClause(
+ $attrFilter, 'group', $filterClause
+ );
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT $resultCols FROM groups
+ $filterClause
+ End-of-Here
+ return $self->_doSelect($sql);
}
sub fetchGroupByID
{
- my $self = shift;
- my $ids = shift;
- my $resultCols = shift;
+ my $self = shift;
+ my $ids = shift;
+ my $resultCols = shift;
- $resultCols = '*' unless (defined $resultCols);
- my $idStr = join ',', @$ids;
- return if !length($idStr);
- my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)";
- return $self->_doSelect($sql);
+ $resultCols = '*' unless (defined $resultCols);
+ my $idStr = join ',', @$ids;
+ return if !length($idStr);
+ my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)";
+ return $self->_doSelect($sql);
}
sub fetchGroupAttrs
{
- my $self = shift;
- my $groupID = $self->{dbh}->quote(shift);
+ my $self = shift;
+ my $groupID = $self->{dbh}->quote(shift);
- my $sql = unshiftHereDoc(<<" End-of-Here");
- SELECT name, value FROM group_attr
- WHERE group_id = $groupID
- End-of-Here
- my @attrs = $self->_doSelect($sql);
- my $Result = {};
- foreach my $attr (@attrs) {
- $Result->{$attr->{name}} = $attr->{value};
- }
- return $Result;
+ my $sql = unshiftHereDoc(<<" End-of-Here");
+ SELECT name, value FROM group_attr
+ WHERE group_id = $groupID
+ End-of-Here
+ my @attrs = $self->_doSelect($sql);
+ my $Result = {};
+ foreach my $attr (@attrs) {
+ $Result->{$attr->{name}} = $attr->{value};
+ }
+ return $Result;
}
sub fetchGroupIDsOfSystem
{
- my $self = shift;
- my $systemID = shift;
+ my $self = shift;
+ my $systemID = shift;
- my $sql = qq[
- SELECT group_id FROM group_system_ref WHERE system_id = '$systemID'
- ];
- return $self->_doSelect($sql, 'group_id');
+ my $sql = qq[
+ SELECT group_id FROM group_system_ref WHERE system_id = '$systemID'
+ ];
+ return $self->_doSelect($sql, 'group_id');
}
sub fetchGroupIDsOfClient
{
- my $self = shift;
- my $clientID = shift;
+ my $self = shift;
+ my $clientID = shift;
- my $sql = qq[
- SELECT group_id FROM group_client_ref WHERE client_id = '$clientID'
- ];
- return $self->_doSelect($sql, 'group_id');
+ my $sql = qq[
+ SELECT group_id FROM group_client_ref WHERE client_id = '$clientID'
+ ];
+ return $self->_doSelect($sql, 'group_id');
}
################################################################################
@@ -515,611 +515,611 @@ sub fetchGroupIDsOfClient
################################################################################
sub _doInsert
{
- my $self = shift;
- my $table = shift;
- my $valRows = shift;
- my $ignoreIDs = shift;
-
- my $dbh = $self->{'dbh'};
- my $valRow = (@$valRows)[0];
- return if !defined $valRow || !scalar keys %$valRow;
-
- if ($table =~ m[_ref$]) {
- # reference tables do not have IDs:
- $ignoreIDs = 1;
- }
-
- my $needToGenerateIDs = $self->generateNextIdForTable(undef);
- if (!$ignoreIDs && $needToGenerateIDs) {
- # DB requires pre-specified IDs, so we add the 'id' column:
- $valRow->{id} = undef unless exists $valRow->{id};
- }
- my @ids;
- foreach my $valRow (@$valRows) {
- if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) {
- # let DB-backend pre-specify ID, as current DB can't generate IDs:
- $valRow->{id} = $self->generateNextIdForTable($table);
- vlog(3, "generated id for <$table> is <$valRow->{id}>");
- }
- my $cols = join ', ', 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 croak _tr(q[Can't insert into table <%s> (%s)], $table,
- $dbh->errstr);
- $sth->execute()
- or croak _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');
- vlog(3, "DB-generated id for <$table> is <$valRow->{id}>");
- }
- push @ids, $valRow->{'id'};
- }
- return wantarray() ? @ids : shift @ids;
+ my $self = shift;
+ my $table = shift;
+ my $valRows = shift;
+ my $ignoreIDs = shift;
+
+ my $dbh = $self->{'dbh'};
+ my $valRow = (@$valRows)[0];
+ return if !defined $valRow || !scalar keys %$valRow;
+
+ if ($table =~ m[_ref$]) {
+ # reference tables do not have IDs:
+ $ignoreIDs = 1;
+ }
+
+ my $needToGenerateIDs = $self->generateNextIdForTable(undef);
+ if (!$ignoreIDs && $needToGenerateIDs) {
+ # DB requires pre-specified IDs, so we add the 'id' column:
+ $valRow->{id} = undef unless exists $valRow->{id};
+ }
+ my @ids;
+ foreach my $valRow (@$valRows) {
+ if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) {
+ # let DB-backend pre-specify ID, as current DB can't generate IDs:
+ $valRow->{id} = $self->generateNextIdForTable($table);
+ vlog(3, "generated id for <$table> is <$valRow->{id}>");
+ }
+ my $cols = join ', ', 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 croak _tr(q[Can't insert into table <%s> (%s)], $table,
+ $dbh->errstr);
+ $sth->execute()
+ or croak _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');
+ vlog(3, "DB-generated id for <$table> is <$valRow->{id}>");
+ }
+ push @ids, $valRow->{'id'};
+ }
+ return wantarray() ? @ids : shift @ids;
}
sub _doDelete
{
- 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;
- foreach my $id (@$IDs) {
- my $sql = "DELETE FROM $table";
- if (defined $id) {
- $sql .= " WHERE $idCol = " . $self->quote($id);
- if (defined $additionalWhereClause) {
- $sql .= $additionalWhereClause;
- }
- }
- vlog(3, $sql);
- my $sth = $dbh->prepare($sql)
- or croak _tr(q[Can't delete from table <%s> (%s)], $table,
- $dbh->errstr);
- $sth->execute()
- or croak _tr(q[Can't delete from table <%s> (%s)], $table,
- $dbh->errstr);
- }
- return 1;
+ 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;
+ foreach my $id (@$IDs) {
+ my $sql = "DELETE FROM $table";
+ if (defined $id) {
+ $sql .= " WHERE $idCol = " . $self->quote($id);
+ if (defined $additionalWhereClause) {
+ $sql .= $additionalWhereClause;
+ }
+ }
+ vlog(3, $sql);
+ my $sth = $dbh->prepare($sql)
+ or croak _tr(q[Can't delete from table <%s> (%s)], $table,
+ $dbh->errstr);
+ $sth->execute()
+ or croak _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 $valRows = shift;
-
- my $dbh = $self->{'dbh'};
- my $valRow = (@$valRows)[0];
- return 1 if !defined $valRow || !scalar keys %$valRow;
-
- my $idx = 0;
- foreach my $valRow (@$valRows) {
- my $id = $IDs->[$idx++];
- my %valData = %$valRow;
- # fail if asked to change the column 'id', as that is bogus
- return if exists $valData{id} && $valData{id} ne $id;
- # filter column 'id' if present, as we don't want to write it
- delete $valData{id};
- my @cols = map { "$_ = " . $self->quote($valRow->{$_}) }
- grep { $_ ne 'id' }
- # filter column 'id' if present, as we don't want
- # to update it!
- keys %$valRow;
- next if !@cols;
- my $cols = join ', ', @cols;
- my $sql = "UPDATE $table SET $cols";
- if (defined $id) {
- $sql .= " WHERE id = " . $self->quote($id);
- }
- vlog(3, $sql);
- my $sth = $dbh->prepare($sql)
- or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr);
- $sth->execute()
- or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr);
- }
- return 1;
+ my $self = shift;
+ my $table = shift;
+ my $IDs = shift;
+ my $valRows = shift;
+
+ my $dbh = $self->{'dbh'};
+ my $valRow = (@$valRows)[0];
+ return 1 if !defined $valRow || !scalar keys %$valRow;
+
+ my $idx = 0;
+ foreach my $valRow (@$valRows) {
+ my $id = $IDs->[$idx++];
+ my %valData = %$valRow;
+ # fail if asked to change the column 'id', as that is bogus
+ return if exists $valData{id} && $valData{id} ne $id;
+ # filter column 'id' if present, as we don't want to write it
+ delete $valData{id};
+ my @cols = map { "$_ = " . $self->quote($valRow->{$_}) }
+ grep { $_ ne 'id' }
+ # filter column 'id' if present, as we don't want
+ # to update it!
+ keys %$valRow;
+ next if !@cols;
+ my $cols = join ', ', @cols;
+ my $sql = "UPDATE $table SET $cols";
+ if (defined $id) {
+ $sql .= " WHERE id = " . $self->quote($id);
+ }
+ vlog(3, $sql);
+ my $sth = $dbh->prepare($sql)
+ or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr);
+ $sth->execute()
+ or croak _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 $newValueIDs = shift;
- my $keyCol = shift;
- my $valueCol = shift;
- my $oldValueIDs = shift;
-
- my %lastValueIDs;
- @lastValueIDs{@$oldValueIDs} = ();
-
- foreach my $valueID (@$newValueIDs) {
- if (!exists $lastValueIDs{$valueID}) {
- # value-ID is new, create it
- my $valRow = {
- $keyCol => $keyID,
- $valueCol => $valueID,
- };
- $self->_doInsert($table, [$valRow]);
- } else {
- # value-ID already exists, leave as is, but remove from hash:
- delete $lastValueIDs{$valueID};
- }
- }
-
- # all the remaining value-IDs need to be removed:
- if (scalar keys %lastValueIDs) {
- $self->_doDelete($table, [keys %lastValueIDs],
- $valueCol, " AND $keyCol='$keyID'");
- }
- return 1;
+ my $self = shift;
+ my $table = shift;
+ my $keyID = shift;
+ my $newValueIDs = shift;
+ my $keyCol = shift;
+ my $valueCol = shift;
+ my $oldValueIDs = shift;
+
+ my %lastValueIDs;
+ @lastValueIDs{@$oldValueIDs} = ();
+
+ foreach my $valueID (@$newValueIDs) {
+ if (!exists $lastValueIDs{$valueID}) {
+ # value-ID is new, create it
+ my $valRow = {
+ $keyCol => $keyID,
+ $valueCol => $valueID,
+ };
+ $self->_doInsert($table, [$valRow]);
+ } else {
+ # value-ID already exists, leave as is, but remove from hash:
+ delete $lastValueIDs{$valueID};
+ }
+ }
+
+ # all the remaining value-IDs need to be removed:
+ if (scalar keys %lastValueIDs) {
+ $self->_doDelete($table, [keys %lastValueIDs],
+ $valueCol, " AND $keyCol='$keyID'");
+ }
+ return 1;
}
sub _updateOneToManyRefAttr
{
- my $self = shift;
- my $table = shift;
- my $oneID = shift;
- my $newManyIDs = shift;
- my $fkCol = shift;
- my $oldManyIDs = shift;
-
- my %lastManyIDs;
- @lastManyIDs{@$oldManyIDs} = ();
-
- foreach my $id (@$newManyIDs) {
- if (!exists $lastManyIDs{$id}) {
- # ID has changed, update it
- $self->_doUpdate($table, $id, [{$fkCol => $oneID}]);
- } else {
- # ID hasn't changed, leave as is, but remove from hash:
- delete $lastManyIDs{$id};
- }
- }
-
- # all the remaining many-IDs need to be set to 0:
- foreach my $id (scalar keys %lastManyIDs) {
- $self->_doUpdate($table, $id, [{$fkCol => '0'}]);
- }
- return 1;
+ my $self = shift;
+ my $table = shift;
+ my $oneID = shift;
+ my $newManyIDs = shift;
+ my $fkCol = shift;
+ my $oldManyIDs = shift;
+
+ my %lastManyIDs;
+ @lastManyIDs{@$oldManyIDs} = ();
+
+ foreach my $id (@$newManyIDs) {
+ if (!exists $lastManyIDs{$id}) {
+ # ID has changed, update it
+ $self->_doUpdate($table, $id, [{$fkCol => $oneID}]);
+ } else {
+ # ID hasn't changed, leave as is, but remove from hash:
+ delete $lastManyIDs{$id};
+ }
+ }
+
+ # all the remaining many-IDs need to be set to 0:
+ foreach my $id (scalar keys %lastManyIDs) {
+ $self->_doUpdate($table, $id, [{$fkCol => '0'}]);
+ }
+ return 1;
}
sub addVendorOS
{
- my $self = shift;
- my $valRows = shift;
+ my $self = shift;
+ my $valRows = shift;
- return $self->_doInsert('vendor_os', $valRows);
+ return $self->_doInsert('vendor_os', $valRows);
}
sub removeVendorOS
{
- my $self = shift;
- my $vendorOSIDs = shift;
+ my $self = shift;
+ my $vendorOSIDs = shift;
- return $self->_doDelete('vendor_os', $vendorOSIDs);
+ return $self->_doDelete('vendor_os', $vendorOSIDs);
}
sub changeVendorOS
{
- my $self = shift;
- my $vendorOSIDs = shift;
- my $valRows = shift;
+ my $self = shift;
+ my $vendorOSIDs = shift;
+ my $valRows = shift;
- return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows);
+ return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows);
}
sub addInstalledPlugin
{
- my $self = shift;
- my $vendorOSID = shift;
- my $pluginName = shift;
- my $pluginAttrs = shift;
-
- return if !defined $vendorOSID || !$pluginName;
-
- my $installedPlugin
- = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1);
- if (!$installedPlugin) {
- return if !$self->_doInsert('installed_plugin', [ {
- vendor_os_id => $vendorOSID,
- plugin_name => $pluginName,
- } ] );
- $installedPlugin
- = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1);
- }
- return if !$installedPlugin;
- for my $pluginAttrName (keys %$pluginAttrs) {
- if (exists $installedPlugin->{attrs}->{$pluginAttrName}) {
- my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName};
- my $currVal
- = defined $attrInfo->{value} ? $attrInfo->{value} : '-';
- my $givenVal
- = defined $pluginAttrs->{$pluginAttrName}
- ? $pluginAttrs->{$pluginAttrName}
- : '-';
- next if $currVal eq $givenVal;
- return if ! $self->_doUpdate(
- 'installed_plugin_attr', [ $attrInfo->{id} ], [ {
- value => $pluginAttrs->{$pluginAttrName},
- } ]
- );
- }
- else {
- return if ! $self->_doInsert('installed_plugin_attr', [ {
- installed_plugin_id => $installedPlugin->{id},
- name => $pluginAttrName,
- value => $pluginAttrs->{$pluginAttrName},
- } ] );
- }
- }
- return 1;
+ my $self = shift;
+ my $vendorOSID = shift;
+ my $pluginName = shift;
+ my $pluginAttrs = shift;
+
+ return if !defined $vendorOSID || !$pluginName;
+
+ my $installedPlugin
+ = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1);
+ if (!$installedPlugin) {
+ return if !$self->_doInsert('installed_plugin', [ {
+ vendor_os_id => $vendorOSID,
+ plugin_name => $pluginName,
+ } ] );
+ $installedPlugin
+ = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1);
+ }
+ return if !$installedPlugin;
+ for my $pluginAttrName (keys %$pluginAttrs) {
+ if (exists $installedPlugin->{attrs}->{$pluginAttrName}) {
+ my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName};
+ my $currVal
+ = defined $attrInfo->{value} ? $attrInfo->{value} : '-';
+ my $givenVal
+ = defined $pluginAttrs->{$pluginAttrName}
+ ? $pluginAttrs->{$pluginAttrName}
+ : '-';
+ next if $currVal eq $givenVal;
+ return if ! $self->_doUpdate(
+ 'installed_plugin_attr', [ $attrInfo->{id} ], [ {
+ value => $pluginAttrs->{$pluginAttrName},
+ } ]
+ );
+ }
+ else {
+ return if ! $self->_doInsert('installed_plugin_attr', [ {
+ installed_plugin_id => $installedPlugin->{id},
+ name => $pluginAttrName,
+ value => $pluginAttrs->{$pluginAttrName},
+ } ] );
+ }
+ }
+ return 1;
}
sub removeInstalledPlugin
{
- my $self = shift;
- my $vendorOSID = shift;
- my $pluginName = shift;
+ my $self = shift;
+ my $vendorOSID = shift;
+ my $pluginName = shift;
- return if !defined $vendorOSID || !$pluginName;
+ return if !defined $vendorOSID || !$pluginName;
- my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName);
- return if !$plugin;
- return if !$self->_doDelete(
- 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id'
- );
- return $self->_doDelete('installed_plugin', [ $plugin->{id} ] );
+ my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName);
+ return if !$plugin;
+ return if !$self->_doDelete(
+ 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id'
+ );
+ return $self->_doDelete('installed_plugin', [ $plugin->{id} ] );
}
sub addExport
{
- my $self = shift;
- my $valRows = shift;
+ my $self = shift;
+ my $valRows = shift;
- return $self->_doInsert('export', $valRows);
+ return $self->_doInsert('export', $valRows);
}
sub removeExport
{
- my $self = shift;
- my $exportIDs = shift;
+ my $self = shift;
+ my $exportIDs = shift;
- return $self->_doDelete('export', $exportIDs);
+ return $self->_doDelete('export', $exportIDs);
}
sub changeExport
{
- my $self = shift;
- my $exportIDs = shift;
- my $valRows = shift;
+ my $self = shift;
+ my $exportIDs = shift;
+ my $valRows = shift;
- return $self->_doUpdate('export', $exportIDs, $valRows);
+ return $self->_doUpdate('export', $exportIDs, $valRows);
}
sub changeGlobalInfo
{
- my $self = shift;
- my $id = shift;
- my $value = 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 $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # ... store the systems to get the IDs ...
- my @systemIDs = $self->_doInsert('system', $valRows);
+ # ... store the systems to get the IDs ...
+ my @systemIDs = $self->_doInsert('system', $valRows);
- # ... finally store the individual attribute sets
- foreach my $id (@systemIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setSystemAttrs($id, $attrs);
- }
+ # ... finally store the individual attribute sets
+ foreach my $id (@systemIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setSystemAttrs($id, $attrs);
+ }
- return @systemIDs;
+ return @systemIDs;
}
sub removeSystem
{
- my $self = shift;
- my $systemIDs = shift;
+ my $self = shift;
+ my $systemIDs = shift;
- return $self->_doDelete('system', $systemIDs);
+ return $self->_doDelete('system', $systemIDs);
}
sub changeSystem
{
- my $self = shift;
- my $systemIDs = shift;
- my $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $systemIDs = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # store the attribute hashes individually
- foreach my $id (@$systemIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setSystemAttrs($id, $attrs);
- }
+ # store the attribute hashes individually
+ foreach my $id (@$systemIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setSystemAttrs($id, $attrs);
+ }
- # finally update all systems in one go
- return $self->_doUpdate('system', $systemIDs, $valRows);
+ # finally update all systems in one go
+ return $self->_doUpdate('system', $systemIDs, $valRows);
}
sub setSystemAttrs
{
- my $self = shift;
- my $systemID = shift;
- my $attrs = shift;
-
- # TODO: improve this, as it is pretty slow!
- # for now we take the simple path and remove all attributes ...
- $self->_doDelete('system_attr', [ $systemID ], 'system_id');
-
- # ... and (re-)insert the given ones
- my @attrData
- = map {
- {
- system_id => $systemID,
- name => $_,
- value => $attrs->{$_},
- }
- }
- grep {
- # Write undefined attributes for the default system, such that
- # it shows all existing attributes. All other systems never
- # write undefined attributes (if they have not defined a
- # specific attribute, it is inherited from "above").
- $systemID == 0 || defined $attrs->{$_}
- }
- keys %$attrs;
- $self->_doInsert('system_attr', \@attrData);
- return 1;
+ my $self = shift;
+ my $systemID = shift;
+ my $attrs = shift;
+
+ # TODO: improve this, as it is pretty slow!
+ # for now we take the simple path and remove all attributes ...
+ $self->_doDelete('system_attr', [ $systemID ], 'system_id');
+
+ # ... and (re-)insert the given ones
+ my @attrData
+ = map {
+ {
+ system_id => $systemID,
+ name => $_,
+ value => $attrs->{$_},
+ }
+ }
+ grep {
+ # Write undefined attributes for the default system, such that
+ # it shows all existing attributes. All other systems never
+ # write undefined attributes (if they have not defined a
+ # specific attribute, it is inherited from "above").
+ $systemID == 0 || defined $attrs->{$_}
+ }
+ keys %$attrs;
+ $self->_doInsert('system_attr', \@attrData);
+ return 1;
}
sub setClientIDsOfSystem
{
- my $self = shift;
- my $systemID = shift;
- my $clientIDs = 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
- );
+ my @currClients = $self->fetchClientIDsOfSystem($systemID);
+ return $self->_updateRefTable(
+ 'client_system_ref', $systemID, $clientIDs, 'system_id', 'client_id',
+ \@currClients
+ );
}
sub setGroupIDsOfSystem
{
- my $self = shift;
- my $systemID = shift;
- my $groupIDs = 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
- );
+ my @currGroups = $self->fetchGroupIDsOfSystem($systemID);
+ return $self->_updateRefTable(
+ 'group_system_ref', $systemID, $groupIDs, 'system_id', 'group_id',
+ \@currGroups
+ );
}
sub addClient
{
- my $self = shift;
- my $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # ... store the clients to get the IDs ...
- my @clientIDs = $self->_doInsert('client', $valRows);
+ # ... store the clients to get the IDs ...
+ my @clientIDs = $self->_doInsert('client', $valRows);
- # ... finally store the individual attribute sets
- foreach my $id (@clientIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setClientAttrs($id, $attrs);
- }
+ # ... finally store the individual attribute sets
+ foreach my $id (@clientIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setClientAttrs($id, $attrs);
+ }
- return @clientIDs;
+ return @clientIDs;
}
sub removeAttributeByName
{
- my $self = shift;
- my $attrName = shift;
+ my $self = shift;
+ my $attrName = shift;
- return $self->_doDelete('system_attr', [ $attrName ], 'name')
- && $self->_doDelete('client_attr', [ $attrName ], 'name')
- && $self->_doDelete('group_attr', [ $attrName ], 'name');
+ return $self->_doDelete('system_attr', [ $attrName ], 'name')
+ && $self->_doDelete('client_attr', [ $attrName ], 'name')
+ && $self->_doDelete('group_attr', [ $attrName ], 'name');
}
sub removeClient
{
- my $self = shift;
- my $clientIDs = shift;
+ my $self = shift;
+ my $clientIDs = shift;
- return $self->_doDelete('client', $clientIDs);
+ return $self->_doDelete('client', $clientIDs);
}
sub changeClient
{
- my $self = shift;
- my $clientIDs = shift;
- my $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $clientIDs = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # store the attribute hashes individually
- foreach my $id (@$clientIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setClientAttrs($id, $attrs);
- }
+ # store the attribute hashes individually
+ foreach my $id (@$clientIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setClientAttrs($id, $attrs);
+ }
- # finally update all systems in one go
- return $self->_doUpdate('client', $clientIDs, $valRows);
+ # finally update all systems in one go
+ return $self->_doUpdate('client', $clientIDs, $valRows);
}
sub setClientAttrs
{
- my $self = shift;
- my $clientID = shift;
- my $attrs = shift;
-
- # TODO: improve this, as it is pretty slow!
- # for now we take the simple path and remove all attributes ...
- $self->_doDelete('client_attr', [ $clientID ], 'client_id');
-
- # ... and (re-)insert the given ones
- my @attrData
- = map {
- {
- client_id => $clientID,
- name => $_,
- value => $attrs->{$_},
- }
- }
- grep { defined $attrs->{$_} }
- keys %$attrs;
- $self->_doInsert('client_attr', \@attrData);
- return 1;
+ my $self = shift;
+ my $clientID = shift;
+ my $attrs = shift;
+
+ # TODO: improve this, as it is pretty slow!
+ # for now we take the simple path and remove all attributes ...
+ $self->_doDelete('client_attr', [ $clientID ], 'client_id');
+
+ # ... and (re-)insert the given ones
+ my @attrData
+ = map {
+ {
+ client_id => $clientID,
+ name => $_,
+ value => $attrs->{$_},
+ }
+ }
+ grep { defined $attrs->{$_} }
+ keys %$attrs;
+ $self->_doInsert('client_attr', \@attrData);
+ return 1;
}
sub setSystemIDsOfClient
{
- my $self = shift;
- my $clientID = shift;
- my $systemIDs = shift;
+ my $self = shift;
+ my $clientID = shift;
+ my $systemIDs = shift;
- my @currSystems = $self->fetchSystemIDsOfClient($clientID);
- return $self->_updateRefTable(
- 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id',
- \@currSystems
- );
+ my @currSystems = $self->fetchSystemIDsOfClient($clientID);
+ return $self->_updateRefTable(
+ 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id',
+ \@currSystems
+ );
}
sub setGroupIDsOfClient
{
- my $self = shift;
- my $clientID = shift;
- my $groupIDs = shift;
+ my $self = shift;
+ my $clientID = shift;
+ my $groupIDs = shift;
- my @currGroups = $self->fetchGroupIDsOfClient($clientID);
- return $self->_updateRefTable(
- 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id',
- \@currGroups
- );
+ my @currGroups = $self->fetchGroupIDsOfClient($clientID);
+ return $self->_updateRefTable(
+ 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id',
+ \@currGroups
+ );
}
sub addGroup
{
- my $self = shift;
- my $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # ... store the groups to get the IDs ...
- my @groupIDs = $self->_doInsert('groups', $valRows);
+ # ... store the groups to get the IDs ...
+ my @groupIDs = $self->_doInsert('groups', $valRows);
- # ... finally store the individual attribute sets
- foreach my $id (@groupIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setGroupAttrs($id, $attrs);
- }
+ # ... finally store the individual attribute sets
+ foreach my $id (@groupIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setGroupAttrs($id, $attrs);
+ }
- return @groupIDs;
+ return @groupIDs;
}
sub removeGroup
{
- my $self = shift;
- my $groupIDs = shift;
+ my $self = shift;
+ my $groupIDs = shift;
- return $self->_doDelete('groups', $groupIDs);
+ return $self->_doDelete('groups', $groupIDs);
}
sub changeGroup
{
- my $self = shift;
- my $groupIDs = shift;
- my $valRows = shift;
- my $attrValRows = shift;
+ my $self = shift;
+ my $groupIDs = shift;
+ my $valRows = shift;
+ my $attrValRows = shift;
- # store the attribute hashes individually
- foreach my $id (@$groupIDs) {
- my $attrs = shift @$attrValRows;
- next if !defined $attrs;
- return if !$self->setGroupAttrs($id, $attrs);
- }
+ # store the attribute hashes individually
+ foreach my $id (@$groupIDs) {
+ my $attrs = shift @$attrValRows;
+ next if !defined $attrs;
+ return if !$self->setGroupAttrs($id, $attrs);
+ }
- # finally update all groups in one go
- return $self->_doUpdate('groups', $groupIDs, $valRows);
+ # finally update all groups in one go
+ return $self->_doUpdate('groups', $groupIDs, $valRows);
}
sub setGroupAttrs
{
- my $self = shift;
- my $groupID = shift;
- my $attrs = shift;
-
- # TODO: improve this, as it is pretty slow!
- # for now we take the simple path and remove all attributes ...
- $self->_doDelete('group_attr', [ $groupID ], 'group_id');
-
- # ... and (re-)insert the given ones
- my @attrData
- = map {
- {
- group_id => $groupID,
- name => $_,
- value => $attrs->{$_},
- }
- }
- grep { defined $attrs->{$_} }
- keys %$attrs;
- $self->_doInsert('group_attr', \@attrData);
- return 1;
+ my $self = shift;
+ my $groupID = shift;
+ my $attrs = shift;
+
+ # TODO: improve this, as it is pretty slow!
+ # for now we take the simple path and remove all attributes ...
+ $self->_doDelete('group_attr', [ $groupID ], 'group_id');
+
+ # ... and (re-)insert the given ones
+ my @attrData
+ = map {
+ {
+ group_id => $groupID,
+ name => $_,
+ value => $attrs->{$_},
+ }
+ }
+ grep { defined $attrs->{$_} }
+ keys %$attrs;
+ $self->_doInsert('group_attr', \@attrData);
+ return 1;
}
sub setClientIDsOfGroup
{
- my $self = shift;
- my $groupID = shift;
- my $clientIDs = shift;
+ my $self = shift;
+ my $groupID = shift;
+ my $clientIDs = shift;
- my @currClients = $self->fetchClientIDsOfGroup($groupID);
- return $self->_updateRefTable(
- 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id',
- \@currClients
- );
+ my @currClients = $self->fetchClientIDsOfGroup($groupID);
+ return $self->_updateRefTable(
+ 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id',
+ \@currClients
+ );
}
sub setSystemIDsOfGroup
{
- my $self = shift;
- my $groupID = shift;
- my $systemIDs = shift;
+ my $self = shift;
+ my $groupID = shift;
+ my $systemIDs = shift;
- my @currSystems = $self->fetchSystemIDsOfGroup($groupID);
- return $self->_updateRefTable(
- 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id',
- \@currSystems
- );
+ my @currSystems = $self->fetchSystemIDsOfGroup($groupID);
+ return $self->_updateRefTable(
+ 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id',
+ \@currSystems
+ );
}
################################################################################
@@ -1127,274 +1127,274 @@ sub setSystemIDsOfGroup
################################################################################
sub _convertColDescrsToDBNativeString
{
- my $self = shift;
- my $colDescrs = 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*$]) {
- croak _tr('UnknownDbSchemaColumnDescr', $_);
- }
- "$1 " . $self->schemaConvertTypeDescrToNative($2);
- } @$colDescrs;
- return $colDescrString;
+ 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*$]) {
+ croak _tr('UnknownDbSchemaColumnDescr', $_);
+ }
+ "$1 " . $self->schemaConvertTypeDescrToNative($2);
+ } @$colDescrs;
+ return $colDescrString;
}
sub _convertColDescrsToColNames
{
- my $self = shift;
- my $colDescrs = 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*:.+$]) {
- croak _tr('UnknownDbSchemaColumnDescr', $_);
- }
- $1;
- } @$colDescrs;
+ 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*:.+$]) {
+ croak _tr('UnknownDbSchemaColumnDescr', $_);
+ }
+ $1;
+ } @$colDescrs;
}
sub _convertColDescrsToColNamesString
{
- my $self = shift;
- my $colDescrs = shift;
+ my $self = shift;
+ my $colDescrs = shift;
- return join ', ', $self->_convertColDescrsToColNames($colDescrs);
+ return join ', ', $self->_convertColDescrsToColNames($colDescrs);
}
sub schemaFetchDBVersion
{
- my $self = shift;
+ my $self = shift;
- my $dbh = $self->{dbh};
- local $dbh->{RaiseError} = 1;
- my $row =
- eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); };
- return 0 if $@;
- # no database access possible
- return unless defined $row;
- # no entry in meta-table
- return $row->{schema_version};
+ my $dbh = $self->{dbh};
+ local $dbh->{RaiseError} = 1;
+ my $row =
+ eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); };
+ return 0 if $@;
+ # no database access possible
+ return unless defined $row;
+ # no entry in meta-table
+ return $row->{schema_version};
}
sub schemaSetDBVersion
{
- my $self = shift;
- my $dbVersion = shift;
+ my $self = shift;
+ my $dbVersion = shift;
- $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'")
- or croak _tr('Unable to set DB-schema version to %s!', $dbVersion);
+ $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'")
+ or croak _tr('Unable to set DB-schema version to %s!', $dbVersion);
- return 1;
+ return 1;
}
sub schemaConvertTypeDescrToNative
-{ # a default implementation, many DBs need to override...
- my $self = shift;
- my $typeDescr = lc(shift);
-
- if ($typeDescr eq 'b') {
- return 'integer';
- } elsif ($typeDescr eq 'i') {
- return 'integer';
- } elsif ($typeDescr eq 'pk') {
- return 'integer primary key';
- } elsif ($typeDescr eq 'fk') {
- return 'integer';
- } elsif ($typeDescr =~ m[^s\.(\d+)$]i) {
- return "varchar($1)";
- } else {
- croak _tr('UnknownDbSchemaTypeDescr', $typeDescr);
- }
+{ # a default implementation, many DBs need to override...
+ my $self = shift;
+ my $typeDescr = lc(shift);
+
+ if ($typeDescr eq 'b') {
+ return 'integer';
+ } elsif ($typeDescr eq 'i') {
+ return 'integer';
+ } elsif ($typeDescr eq 'pk') {
+ return 'integer primary key';
+ } elsif ($typeDescr eq 'fk') {
+ return 'integer';
+ } elsif ($typeDescr =~ m[^s\.(\d+)$]i) {
+ return "varchar($1)";
+ } else {
+ croak _tr('UnknownDbSchemaTypeDescr', $typeDescr);
+ }
}
sub schemaAddTable
{
- my $self = shift;
- my $table = shift;
- my $colDescrs = shift;
- my $initialVals = shift;
- my $isSubCmd = shift;
-
- my $dbh = $self->{'dbh'};
- vlog(1, "adding table <$table> to schema...") unless $isSubCmd;
- my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs);
- my $sql = "CREATE TABLE $table ($colDescrString)";
- vlog(3, $sql);
- $dbh->do($sql)
- or croak _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
- $self->_doInsert($table, $initialVals, $ignoreIDs);
- }
- return;
+ my $self = shift;
+ my $table = shift;
+ my $colDescrs = shift;
+ my $initialVals = shift;
+ my $isSubCmd = shift;
+
+ my $dbh = $self->{'dbh'};
+ vlog(1, "adding table <$table> to schema...") unless $isSubCmd;
+ my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs);
+ my $sql = "CREATE TABLE $table ($colDescrString)";
+ vlog(3, $sql);
+ $dbh->do($sql)
+ or croak _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
+ $self->_doInsert($table, $initialVals, $ignoreIDs);
+ }
+ return;
}
sub schemaDropTable
{
- my $self = shift;
- my $table = shift;
- my $isSubCmd = shift;
+ my $self = shift;
+ my $table = shift;
+ my $isSubCmd = shift;
- my $dbh = $self->{'dbh'};
- vlog(1, "dropping table <$table> from schema...") unless $isSubCmd;
- my $sql = "DROP TABLE $table";
- vlog(3, $sql);
- $dbh->do($sql)
- or croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr);
- return;
+ my $dbh = $self->{'dbh'};
+ vlog(1, "dropping table <$table> from schema...") unless $isSubCmd;
+ my $sql = "DROP TABLE $table";
+ vlog(3, $sql);
+ $dbh->do($sql)
+ or croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr);
+ return;
}
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;
- my $colDescrs = shift;
- my $isSubCmd = shift;
-
- my $dbh = $self->{'dbh'};
- vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd;
- my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs);
- my $sql = "CREATE TABLE $newTable ($colDescrString)";
- vlog(3, $sql);
- $dbh->do($sql)
- or croak _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 croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr);
- return;
+ # 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 $dbh = $self->{'dbh'};
+ vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd;
+ my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs);
+ my $sql = "CREATE TABLE $newTable ($colDescrString)";
+ vlog(3, $sql);
+ $dbh->do($sql)
+ or croak _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 croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr);
+ return;
}
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 <table> ADD COLUMN <col>' 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 $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;
- $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!)
-
- if (defined $newColDefaultVals) {
- # default values have been provided, we apply them now:
- $self->_doUpdate($tempTable, undef, $newColDefaultVals);
- }
-
- $self->schemaDropTable($table, 1);
- $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
- return;
+ # 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 <table> ADD COLUMN <col>' 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 $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;
+ $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!)
+
+ if (defined $newColDefaultVals) {
+ # default values have been provided, we apply them now:
+ $self->_doUpdate($tempTable, undef, $newColDefaultVals);
+ }
+
+ $self->schemaDropTable($table, 1);
+ $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+ return;
}
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 <table> 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 $dbh = $self->{'dbh'};
- my $tempTable = "${table}_temp";
- my $dropColStr = join ', ', @$dropColNames;
- 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");
- $self->_doInsert($tempTable, \@dataRows);
-
- $self->schemaDropTable($table, 1);
- $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
- return;
+ # 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 <table> 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 $dbh = $self->{'dbh'};
+ my $tempTable = "${table}_temp";
+ my $dropColStr = join ', ', @$dropColNames;
+ 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");
+ $self->_doInsert($tempTable, \@dataRows);
+
+ $self->schemaDropTable($table, 1);
+ $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+ return;
}
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 <table> 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 $dbh = $self->{'dbh'};
- my $tempTable = "${table}_temp";
- my $changeColStr = join ', ', keys %$colChanges;
- 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");
- foreach my $oldCol (keys %$colChanges) {
- my $newCol =
- $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]);
- # rename current column in all data-rows:
- foreach my $row (@dataRows) {
- $row->{$newCol} = $row->{$oldCol};
- delete $row->{$oldCol};
- }
- }
- $self->_doInsert($tempTable, \@dataRows);
-
- $self->schemaDropTable($table, 1);
- $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
- return;
+ # 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 <table> 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 $dbh = $self->{'dbh'};
+ my $tempTable = "${table}_temp";
+ my $changeColStr = join ', ', keys %$colChanges;
+ 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");
+ foreach my $oldCol (keys %$colChanges) {
+ my $newCol =
+ $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]);
+ # rename current column in all data-rows:
+ foreach my $row (@dataRows) {
+ $row->{$newCol} = $row->{$oldCol};
+ delete $row->{$oldCol};
+ }
+ }
+ $self->_doInsert($tempTable, \@dataRows);
+
+ $self->schemaDropTable($table, 1);
+ $self->schemaRenameTable($tempTable, $table, $colDescrs, 1);
+ return;
}
1;