From 65556841d342d74059f7bc71e7496c64e3f23056 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Mon, 21 Aug 2006 12:03:33 +0000 Subject: * now that project name is fixed, we use it: 'ODLX' => 'OpenSLX' and 'odlx' => 'openslx' git-svn-id: http://svn.openslx.org/svn/openslx/trunk@321 95ad53e4-c205-0410-b2fa-d234c58c8868 --- config-db/ODLX/Basics.pm | 171 ----- config-db/ODLX/ConfigDB.pm | 667 ------------------- config-db/ODLX/DBSchema.pm | 220 ------- config-db/ODLX/MetaDB/Base.pm | 415 ------------ config-db/ODLX/MetaDB/CSV.pm | 127 ---- config-db/ODLX/MetaDB/DBI.pm | 885 -------------------------- config-db/ODLX/MetaDB/SQLite.pm | 96 --- config-db/ODLX/MetaDB/XML.pm | 186 ------ config-db/ODLX/MetaDB/mysql.pm | 161 ----- config-db/ODLX/Translations/de_de_utf_8.pm | 27 - config-db/ODLX/Translations/posix.pm | 33 - config-db/OpenSLX/Basics.pm | 171 +++++ config-db/OpenSLX/ConfigDB.pm | 667 +++++++++++++++++++ config-db/OpenSLX/DBSchema.pm | 220 +++++++ config-db/OpenSLX/MetaDB/Base.pm | 415 ++++++++++++ config-db/OpenSLX/MetaDB/CSV.pm | 127 ++++ config-db/OpenSLX/MetaDB/DBI.pm | 885 ++++++++++++++++++++++++++ config-db/OpenSLX/MetaDB/SQLite.pm | 96 +++ config-db/OpenSLX/MetaDB/XML.pm | 186 ++++++ config-db/OpenSLX/MetaDB/mysql.pm | 161 +++++ config-db/OpenSLX/Translations/de_de_utf_8.pm | 27 + config-db/OpenSLX/Translations/posix.pm | 33 + config-db/config-demuxer.pl | 32 +- config-db/testConfDB.pl | 62 +- 24 files changed, 3035 insertions(+), 3035 deletions(-) delete mode 100644 config-db/ODLX/Basics.pm delete mode 100644 config-db/ODLX/ConfigDB.pm delete mode 100644 config-db/ODLX/DBSchema.pm delete mode 100644 config-db/ODLX/MetaDB/Base.pm delete mode 100644 config-db/ODLX/MetaDB/CSV.pm delete mode 100644 config-db/ODLX/MetaDB/DBI.pm delete mode 100644 config-db/ODLX/MetaDB/SQLite.pm delete mode 100644 config-db/ODLX/MetaDB/XML.pm delete mode 100644 config-db/ODLX/MetaDB/mysql.pm delete mode 100644 config-db/ODLX/Translations/de_de_utf_8.pm delete mode 100644 config-db/ODLX/Translations/posix.pm create mode 100644 config-db/OpenSLX/Basics.pm create mode 100644 config-db/OpenSLX/ConfigDB.pm create mode 100644 config-db/OpenSLX/DBSchema.pm create mode 100644 config-db/OpenSLX/MetaDB/Base.pm create mode 100644 config-db/OpenSLX/MetaDB/CSV.pm create mode 100644 config-db/OpenSLX/MetaDB/DBI.pm create mode 100644 config-db/OpenSLX/MetaDB/SQLite.pm create mode 100644 config-db/OpenSLX/MetaDB/XML.pm create mode 100644 config-db/OpenSLX/MetaDB/mysql.pm create mode 100644 config-db/OpenSLX/Translations/de_de_utf_8.pm create mode 100644 config-db/OpenSLX/Translations/posix.pm diff --git a/config-db/ODLX/Basics.pm b/config-db/ODLX/Basics.pm deleted file mode 100644 index 70206468..00000000 --- a/config-db/ODLX/Basics.pm +++ /dev/null @@ -1,171 +0,0 @@ -package ODLX::Basics; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); - -use Exporter; -$VERSION = 0.02; -@ISA = qw(Exporter); - -@EXPORT = qw( - &odlxInit %odlxConfig - &_tr &trInit - &vlog -); - -use vars qw(%odlxConfig); - -################################################################################ -### Module implementation -################################################################################ -use Carp; -use FindBin; -use Getopt::Long; - -my %translations; -my $loadedTranslationModule; - -# this hash will hold the active odlx configuration, -# it is populated from config files and/or cmdline arguments: -%odlxConfig = ( - 'db-name' => 'odlx', - 'db-type' => 'CSV', - 'locale' => $ENV{LANG}, - # TODO: may need to be improved in order to be portable - 'private-basepath' => '/var/lib/openslx', - 'public-basepath' => '/srv/openslx', - 'shared-basepath' => '/usr/share/openslx', - 'temp-basepath' => '/tmp', -); -$odlxConfig{'db-basepath'} = "$odlxConfig{'private-basepath'}/db", - -# specification of cmdline arguments that are shared by all odlx-scripts: -my %odlxCmdlineArgs = ( - 'db-basepath=s' => \$odlxConfig{'db-basepath'}, - # basic path to odlx database, defaults to "$private-basepath/db" - 'db-datadir=s' => \$odlxConfig{'db-datadir'}, - # data folder created under db-basepath, default depends on db-type - 'db-spec=s' => \$odlxConfig{'db-spec'}, - # full specification of database, a special string defining the - # precise database to connect to (the contents of this string - # depend on db-type) - 'db-name=s' => \$odlxConfig{'db-name'}, - # name of database, defaults to 'odlx' - 'db-type=s' => \$odlxConfig{'db-type'}, - # type of database to connect to (CSV, SQLite, ...), defaults to 'CSV' - 'locale=s' => \$odlxConfig{'locale'}, - # locale to use for translations - 'logfile=s' => \$odlxConfig{'locale'}, - # file to write logging output to, defaults to STDERR - 'private-basepath=s' => \$odlxConfig{'private-basepath'}, - # basic path to private data (which is accessible for clients and - # contains all data required for booting the clients) - 'public-basepath=s' => \$odlxConfig{'public-basepath'}, - # basic path to public data (which contains database, vendorOSes - # and all local extensions [system specific scripts]) - 'shared-basepath=s' => \$odlxConfig{'shared-basepath'}, - # basic path to shared data (functionality templates and distro-specs) - 'temp-basepath=s' => \$odlxConfig{'temp-basepath'}, - # basic path to temporary data (used during demuxing) - 'verbose-level=i' => \$odlxConfig{'verbose-level'}, - # level of logging verbosity (0-3) -); - -# filehandle used for logging: -my $odlxLog = *STDERR; - -# ------------------------------------------------------------------------------ -sub vlog -{ - my $minLevel = shift; - return if $minLevel > $odlxConfig{'verbose-level'}; - print $odlxLog '-'x$minLevel, @_, "\n"; -} - -# ------------------------------------------------------------------------------ -sub odlxInit -{ - # try to read and evaluate config files: - foreach my $f ("ODLX/odlxrc", "$ENV{HOME}/.odlxrc") { - next unless open(CONFIG, "<$f"); - while() { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($key, $value) = split(/\s*=\s*/, $_, 2); - $odlxConfig{$key} = $value; - } - close CONFIG; - } - - # push any cmdline argument directly into our config hash: - GetOptions(%odlxCmdlineArgs); - - if (defined $odlxConfig{'logfile'} - && open(LOG, ">>$odlxConfig{'logfile'}")) { - $odlxLog - } - if ($odlxConfig{'verbose-level'} >= 2) { - foreach my $k (sort keys %odlxConfig) { - vlog 2, "dump-config: $k = $odlxConfig{$k}"; - } - } - - # setup translation "engine": - trInit(); -} - -# ------------------------------------------------------------------------------ -sub trInit -{ - my $locale = $odlxConfig{'locale'}; - $locale =~ tr[A-Z.\-][a-z__]; - - my $trModule = "ODLX::Translations::$locale"; - if ($loadedTranslationModule eq $trModule) { - # requested translations have already been loaded - return; - } - - # load Posix-Translations first in order to fall back to English strings - # if a specific translation isn't available: - if (eval "require ODLX::Translations::posix") { - %translations = %ODLX::Translations::posix::translations; - } else { - carp "Unable to load translations module 'posix' ($!)."; - } - - if ($locale ne 'posix') { - if (eval "require $trModule") { - # Access ODLX::Translations::$locale::%translations - # via a symbolic reference... - no strict 'refs'; - my $translationsRef = \%{"${trModule}::translations"}; - # ...and copy the available translations into our hash: - foreach my $k (keys %{$translationsRef}) { - $translations{$k} = $translationsRef->{$k}; - } - $loadedTranslationModule = $trModule; - } else { - carp "Unable to load translations module '$locale' ($!)."; - } - } - -} - -# ------------------------------------------------------------------------------ -sub _tr -{ - my $trKey = shift; - - my $formatStr = $translations{$trKey}; - if (!defined $formatStr) { -# carp "Translation key '$trKey' not found."; - $formatStr = $trKey; - } - return sprintf($formatStr, @_); -} - -1; \ No newline at end of file diff --git a/config-db/ODLX/ConfigDB.pm b/config-db/ODLX/ConfigDB.pm deleted file mode 100644 index f7f16755..00000000 --- a/config-db/ODLX/ConfigDB.pm +++ /dev/null @@ -1,667 +0,0 @@ -package ODLX::ConfigDB; - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This module defines the data abstraction layer for the ODLX configuration -### database. -### Aim of this abstraction is to hide the details of the data layout and -### the peculiarities of individual database types behind a simple interface -### that offers straightforward access to and manipulation of the ODLX-systems -### and -clients (without the need to use SQL). -### The interface is divided into two parts: -### - data access methods (getting data) -### - data manipulation methods (adding, removing and changing data) -################################################################################ -use Exporter; -@ISA = qw(Exporter); - -my @accessExports = qw( - connectConfigDB disconnectConfigDB - fetchVendorOSesByFilter fetchVendorOSesByID fetchVendorOSIDsOfSystem - fetchSystemsByFilter fetchSystemsByID fetchSystemIDsOfClient - fetchSystemIDsOfGroup - fetchClientsByFilter fetchClientsByID fetchClientIDsOfSystem - fetchClientIDsOfGroup - fetchGroupsByFilter fetchGroupsByID fetchGroupIDsOfClient - fetchGroupIDsOfSystem -); -my @manipulationExports = qw( - addVendorOS removeVendorOS changeVendorOS - setSystemIDsOfVendorOS addSystemIDsToVendorOS removeSystemIDsFromVendorOS - addSystem removeSystem changeSystem - setClientIDsOfSystem addClientIDsToSystem removeClientIDsFromSystem - setGroupIDsOfSystem addGroupIDsToSystem removeGroupIDsFromSystem - addClient removeClient changeClient - setSystemIDsOfClient addSystemIDsToClient removeSystemIDsFromClient - setGroupIDsOfClient addGroupIDsToClient removeGroupIDsFromClient - addGroup removeGroup changeGroup - setClientIDsOfGroup addClientIDsToGroup removeClientIDsFromGroup - setSystemIDsOfGroup addSystemIDsToGroup removeSystemIDsFromGroup -); - -@EXPORT = @accessExports; -@EXPORT_OK = @manipulationExports; -%EXPORT_TAGS = ( - 'access' => [ @accessExports ], - 'manipulation' => [ @manipulationExports ], -); - -################################################################################ -### private stuff -################################################################################ -use Carp; -use ODLX::Basics; -use ODLX::DBSchema; - -sub _checkAndUpgradeDBSchemaIfNecessary -{ - my $metaDB = shift; - - vlog 2, "trying to determine schema version..."; - my $currVersion = $metaDB->schemaFetchDBVersion(); - if (!defined $currVersion) { - # that's bad, someone has messed with our DB, as there is a - # database, but the 'meta'-table is empty. There might still - # be data in the other tables, but we have no way to find out - # which schema version they're in. So it's safer to give up: - croak _tr('Could not determine schema version of database'); - } - - if ($currVersion < $DbSchema->{version}) { - vlog 1, _tr('Our schema-version is %s, DB is %s, upgrading DB...', - $DbSchema->{version}, $currVersion); - foreach my $v (sort { $a <=> $b } keys %DbSchemaHistory) { - next if $v <= $currVersion; - my $changeSet = $DbSchemaHistory{$v}; - foreach my $c (0..scalar(@$changeSet)-1) { - my $changeDescr = @{$changeSet}[$c]; - my $cmd = $changeDescr->{cmd}; - if ($cmd eq 'add-table') { - $metaDB->schemaAddTable($changeDescr->{'table'}, - $changeDescr->{'cols'}, - $changeDescr->{'vals'}); - } elsif ($cmd eq 'drop-table') { - $metaDB->schemaDropTable($changeDescr->{'table'}); - } elsif ($cmd eq 'rename-table') { - $metaDB->schemaRenameTable($changeDescr->{'old-table'}, - $changeDescr->{'new-table'}, - $changeDescr->{'cols'}); - } elsif ($cmd eq 'add-columns') { - $metaDB->schemaAddColumns($changeDescr->{'table'}, - $changeDescr->{'new-cols'}, - $changeDescr->{'cols'}); - } elsif ($cmd eq 'drop-columns') { - $metaDB->schemaDropColumns($changeDescr->{'table'}, - $changeDescr->{'drop-cols'}, - $changeDescr->{'cols'}); - } elsif ($cmd eq 'rename-columns') { - $metaDB->schemaRenameColumns($changeDescr->{'table'}, - $changeDescr->{'col-renames'}, - $changeDescr->{'cols'}); - } else { - confess _tr('UnknownDbSchemaCommand', $cmd); - } - } - } - vlog 1, _tr('upgrade done'); - } else { - vlog 1, _tr('DB matches current schema version %s', $currVersion); - } -} - -sub _aref -{ # transparently converts the given reference to an array-ref - my $ref = shift; - $ref = [ $ref ] unless ref($ref) eq 'ARRAY'; - return $ref; -} - -################################################################################ -### data access interface -################################################################################ -sub connectConfigDB -{ - my $dbParams = shift; - # hash-ref with any additional info that might be required by - # specific metadb-module (not used yet) - - my $dbType = $odlxConfig{'db-type'}; - # name of underlying database module - my $dbModule = "ODLX::MetaDB::$dbType"; - unless (eval "require $dbModule") { - confess _tr('Unable to load DB-module <%s> (%s)', $dbModule, $@); - } - my $modVersion = $dbModule->VERSION; - if ($modVersion < $VERSION) { - confess _tr('Could not load module <%s> (Version <%s> required, but <%s> found)', - $dbModule, $VERSION, $modVersion); - } - $dbModule->import; - - my $metaDB = $dbModule->new(); - $metaDB->connectConfigDB($dbParams); - my $confDB = { - 'db-type' => $dbType, - 'meta-db' => $metaDB, - }; - foreach my $tk (keys %{$DbSchema->{tables}}) { - $metaDB->schemaDeclareTable($tk, $DbSchema->{tables}->{$tk}); - } - - _checkAndUpgradeDBSchemaIfNecessary($metaDB); - - return $confDB; -} - -sub disconnectConfigDB -{ - my $confDB = shift; - - $confDB->{'meta-db'}->disconnectConfigDB(); -} - -sub fetchVendorOSesByFilter -{ - my $confDB = shift; - my $filter = shift; - my $resultCols = shift; - - my @vendorOSes - = $confDB->{'meta-db'}->fetchVendorOSesByFilter($filter, $resultCols); - return wantarray() ? @vendorOSes : shift @vendorOSes; -} - -sub fetchVendorOSesByID -{ - my $confDB = shift; - my $id = shift; - - my $filter = { 'id' => $id }; - my @vendorOSes = $confDB->{'meta-db'}->fetchVendorOSesByFilter($filter); - return wantarray() ? @vendorOSes : shift @vendorOSes; -} - -sub fetchSystemsByFilter -{ - my $confDB = shift; - my $filter = shift; - my $resultCols = shift; - - my @systems - = $confDB->{'meta-db'}->fetchSystemsByFilter($filter, $resultCols); - return wantarray() ? @systems : shift @systems; -} - -sub fetchSystemsByID -{ - my $confDB = shift; - my $id = shift; - - my $filter = { 'id' => $id }; - my @systems = $confDB->{'meta-db'}->fetchSystemsByFilter($filter); - return wantarray() ? @systems : shift @systems; -} - -sub fetchSystemIDsOfVendorOS -{ - my $confDB = shift; - my $vendorOSID = shift; - - return $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); -} - -sub fetchSystemIDsOfClient -{ - my $confDB = shift; - my $clientID = shift; - - return $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); -} - -sub fetchSystemIDsOfGroup -{ - my $confDB = shift; - my $groupID = shift; - - return $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); -} - -sub fetchClientsByFilter -{ - my $confDB = shift; - my $filter = shift; - - my @clients = $confDB->{'meta-db'}->fetchClientsByFilter($filter); - return wantarray() ? @clients : shift @clients; -} - -sub fetchClientsByID -{ - my $confDB = shift; - my $id = shift; - - my $filter = { 'id' => $id }; - my @clients = $confDB->{'meta-db'}->fetchClientsByFilter($filter); - return wantarray() ? @clients : shift @clients; -} - -sub fetchClientIDsOfSystem -{ - my $confDB = shift; - my $systemID = shift; - - return $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); -} - -sub fetchClientIDsOfGroup -{ - my $confDB = shift; - my $groupID = shift; - - return $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); -} - -sub fetchGroupsByFilter -{ - my $confDB = shift; - my $filter = shift; - my $resultCols = shift; - - my @groups - = $confDB->{'meta-db'}->fetchGroupsByFilter($filter, $resultCols); - return wantarray() ? @groups : shift @groups; -} - -sub fetchGroupsByID -{ - my $confDB = shift; - my $id = shift; - - my $filter = { 'id' => $id }; - my @groups = $confDB->{'meta-db'}->fetchGroupsByFilter($filter); - return wantarray() ? @groups : shift @groups; -} - -sub fetchGroupIDsOfSystem -{ - my $confDB = shift; - my $systemID = shift; - - return $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); -} - -sub fetchGroupIDsOfClient -{ - my $confDB = shift; - my $clientID = shift; - - return $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); -} - -################################################################################ -### data manipulation interface -################################################################################ -sub addVendorOS -{ - my $confDB = shift; - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->addVendorOS($valRows); -} - -sub removeVendorOS -{ - my $confDB = shift; - my $vendorOSIDs = _aref(shift); - - return $confDB->{'meta-db'}->removeVendorOS($vendorOSIDs); -} - -sub changeVendorOS -{ - my $confDB = shift; - my $vendorOSIDs = _aref(shift); - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); -} - -sub setSystemIDsOfVendorOS -{ - my $confDB = shift; - my $vendorOSID = shift; - my $systemIDs = _aref(shift); - - my %seen; - my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; - return $confDB->{'meta-db'}->setSystemIDsOfVendorOS($vendorOSID, - \@uniqueSystemIDs); -} - -sub addSystemIDsToVendorOS -{ - my $confDB = shift; - my $vendorOSID = shift; - my $newSystemIDs = _aref(shift); - - my @systemIDs - = $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); - push @systemIDs, @$newSystemIDs; - return setSystemIDsOfVendorOS($confDB, $vendorOSID, \@systemIDs); -} - -sub removeSystemIDsFromVendorOS -{ - my $confDB = shift; - my $vendorOSID = shift; - my $removedSystemIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); - return setSystemIDsOfVendorOS($confDB, $vendorOSID, \@systemIDs); -} - -sub addSystem -{ - my $confDB = shift; - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->addSystem($valRows); -} - -sub removeSystem -{ - my $confDB = shift; - my $systemIDs = _aref(shift); - - return $confDB->{'meta-db'}->removeSystem($systemIDs); -} - -sub changeSystem -{ - my $confDB = shift; - my $systemIDs = _aref(shift); - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->changeSystem($systemIDs, $valRows); -} - -sub setClientIDsOfSystem -{ - my $confDB = shift; - my $systemID = shift; - my $clientIDs = _aref(shift); - - my %seen; - my @uniqueClientIDs = grep { !$seen{$_}++ } @$clientIDs; - return $confDB->{'meta-db'}->setClientIDsOfSystem($systemID, - \@uniqueClientIDs); -} - -sub addClientIDsToSystem -{ - my $confDB = shift; - my $systemID = shift; - my $newClientIDs = _aref(shift); - - my @clientIDs = $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); - push @clientIDs, @$newClientIDs; - return setClientIDsOfSystem($confDB, $systemID, \@clientIDs); -} - -sub removeClientIDsFromSystem -{ - my $confDB = shift; - my $systemID = shift; - my $removedClientIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); - return setClientIDsOfSystem($confDB, $systemID, \@clientIDs); -} - -sub setGroupIDsOfSystem -{ - my $confDB = shift; - my $systemID = shift; - my $groupIDs = _aref(shift); - - my %seen; - my @uniqueGroupIDs = grep { !$seen{$_}++ } @$groupIDs; - return $confDB->{'meta-db'}->setGroupIDsOfSystem($systemID, - \@uniqueGroupIDs); -} - -sub addGroupIDsToSystem -{ - my $confDB = shift; - my $systemID = shift; - my $newGroupIDs = _aref(shift); - - my @groupIDs = $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - push @groupIDs, @$newGroupIDs; - return setGroupIDsOfSystem($confDB, $systemID, \@groupIDs); -} - -sub removeGroupIDsFromSystem -{ - my $confDB = shift; - my $systemID = shift; - my $toBeRemovedGroupIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - return setGroupIDsOfSystem($confDB, $systemID, \@groupIDs); -} - -sub addClient -{ - my $confDB = shift; - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->addClient($valRows); -} - -sub removeClient -{ - my $confDB = shift; - my $clientIDs = _aref(shift); - - return $confDB->{'meta-db'}->removeClient($clientIDs); -} - -sub changeClient -{ - my $confDB = shift; - my $clientIDs = _aref(shift); - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->changeClient($clientIDs, $valRows); -} - -sub setSystemIDsOfClient -{ - my $confDB = shift; - my $clientID = shift; - my $systemIDs = _aref(shift); - - my %seen; - my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; - return $confDB->{'meta-db'}->setSystemIDsOfClient($clientID, - \@uniqueSystemIDs); -} - -sub addSystemIDsToClient -{ - my $confDB = shift; - my $clientID = shift; - my $newSystemIDs = _aref(shift); - - my @systemIDs = $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); - push @systemIDs, @$newSystemIDs; - return setSystemIDsOfClient($confDB, $clientID, \@systemIDs); -} - -sub removeSystemIDsFromClient -{ - my $confDB = shift; - my $clientID = shift; - my $removedSystemIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); - return setSystemIDsOfClient($confDB, $clientID, \@systemIDs); -} - -sub setGroupIDsOfClient -{ - my $confDB = shift; - my $clientID = shift; - my $groupIDs = _aref(shift); - - my %seen; - my @uniqueGroupIDs = grep { !$seen{$_}++ } @$groupIDs; - return $confDB->{'meta-db'}->setGroupIDsOfClient($clientID, - \@uniqueGroupIDs); -} - -sub addGroupIDsToClient -{ - my $confDB = shift; - my $clientID = shift; - my $newGroupIDs = _aref(shift); - - my @groupIDs = $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); - push @groupIDs, @$newGroupIDs; - return setGroupIDsOfClient($confDB, $clientID, \@groupIDs); -} - -sub removeGroupIDsFromClient -{ - my $confDB = shift; - my $clientID = shift; - my $toBeRemovedGroupIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); - return setGroupIDsOfClient($confDB, $clientID, \@groupIDs); -} - -sub addGroup -{ - my $confDB = shift; - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->addGroup($valRows); -} - -sub removeGroup -{ - my $confDB = shift; - my $groupIDs = _aref(shift); - - return $confDB->{'meta-db'}->removeGroup($groupIDs); -} - -sub changeGroup -{ - my $confDB = shift; - my $groupIDs = _aref(shift); - my $valRows = _aref(shift); - - return $confDB->{'meta-db'}->changeGroup($groupIDs, $valRows); -} - -sub setClientIDsOfGroup -{ - my $confDB = shift; - my $groupID = shift; - my $clientIDs = _aref(shift); - - my %seen; - my @uniqueClientIDs = grep { !$seen{$_}++ } @$clientIDs; - return $confDB->{'meta-db'}->setClientIDsOfGroup($groupID, - \@uniqueClientIDs); -} - -sub addClientIDsToGroup -{ - my $confDB = shift; - my $groupID = shift; - my $newClientIDs = _aref(shift); - - my @clientIDs = $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); - push @clientIDs, @$newClientIDs; - return setClientIDsOfGroup($confDB, $groupID, \@clientIDs); -} - -sub removeClientIDsFromGroup -{ - my $confDB = shift; - my $groupID = shift; - my $removedClientIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); - return setClientIDsOfGroup($confDB, $groupID, \@clientIDs); -} - -sub setSystemIDsOfGroup -{ - my $confDB = shift; - my $groupID = shift; - my $systemIDs = _aref(shift); - - my %seen; - my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; - return $confDB->{'meta-db'}->setSystemIDsOfGroup($groupID, - \@uniqueSystemIDs); -} - -sub addSystemIDsToGroup -{ - my $confDB = shift; - my $groupID = shift; - my $newSystemIDs = _aref(shift); - - my @systemIDs = $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - push @systemIDs, @$newSystemIDs; - return setSystemIDsOfGroup($confDB, $groupID, \@systemIDs); -} - -sub removeSystemIDsFromGroup -{ - my $confDB = shift; - my $groupID = shift; - my $removedSystemIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs - = grep { !exists $toBeRemoved{$_} } - $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - return setSystemIDsOfGroup($confDB, $groupID, \@systemIDs); -} - -1; diff --git a/config-db/ODLX/DBSchema.pm b/config-db/ODLX/DBSchema.pm deleted file mode 100644 index 45c78044..00000000 --- a/config-db/ODLX/DBSchema.pm +++ /dev/null @@ -1,220 +0,0 @@ -package ODLX::DBSchema; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); - -use Exporter; -$VERSION = 0.01; -@ISA = qw(Exporter); - -@EXPORT = qw( - $DbSchema %DbSchemaHistory -); - -use vars qw($DbSchema %DbSchemaHistory); - -# configurable attributes for system, client and group: -my @sharedAttributes = ( - 'attrDesktopSession:s.128', - 'attrDomainName:s.64', - 'attrDomainNameServers:s.128', - 'attrFontServers:s.128', - 'attrHwGraphic:s.64', - 'attrHwMonitor:s.64', - 'attrHwMouse:s.64', - 'attrLanguage:s.64', - 'attrLprServers:s.128', - 'attrNetbiosWorkgroup:s.64', - 'attrNisDomain:s.64', - 'attrNisServers:s.128', - 'attrNtpServers:s.128', - 'attrStartRwhod:b', - 'attrStartSnmp:b', - 'attrStartX:s.64', - 'attrStartXdmcp:s.64', - 'attrTexEnable:b', - 'attrVmware:b', -); - -################################################################################ -### DB-schema definition -### This hash-ref describes the current ODLX configuration database schema. -### Each table is defined by a list of column descriptions. -### A column description is simply the name of the column followed by ':' -### followed by the data type description. The following data types are -### currently supported: -### b => boolean (providing the values 1 and 0 only) -### i => integer (32-bit, signed) -### s.20 => string, followed by length argument (in this case: 20) -### pk => primary key (integer) -### fk => foreign key (integer) -################################################################################ - -$DbSchema = { - 'version' => $VERSION, - 'tables' => { - 'meta' => [ - # information about the database as such - 'schema_version:s.5', # schema-version currently implemented by DB - ], - 'vendor_os' => [ - # a vendor os describes a folder containing an operating system as provided by the - # vendor (a.k.a. unchanged and thus updatable) - 'id:pk', # primary key - 'name:s.32', # structured name of OS installation (e.g. suse-9.3-minimal, - # suse-9.3-kde, debian-3.1-ppc) - 'descr:s.1024', # internal description (optional, for admins) - 'path:s.256', # path to os filesystem root - ], - 'system' => [ - # a system describes one bootable instance of a vendor os - 'id:pk', # primary key - 'vendor_os_id:fk', # foreign key - 'name:s.32', # name used in filesystem and passed to kernel via cmdline arg - # (e.g.: suse-9.3-minimal, suse-9.3-minimal-nbd, ...) - 'label:s.128', # visible name (pxe-label) - 'descr:s.1024', # internal description (optional, for admins) - 'export_uri:s.256', # path to export (NDB-image or NFS-path) - 'tftp_uri:s.256', # path to tftp export directory - 'kernel:s.128', # name of kernel file - 'kernel_params:s.512', # kernel-param string for pxe - 'initramfs:s.128', # name of initrd file - 'hidden:b', # hidden systems won't be offered for booting - @sharedAttributes, - ], - 'client' => [ - # a client is a PC booting via network - 'id:pk', # primary key - 'name:s.128', # official name of PC (e.g. as given by sticker - # on case) - 'mac:s.20', # MAC of NIC used for booting - 'descr:s.1024', # internal description (for admins) - 'boot_type:s.20', # type of remote boot procedure (PXE, ...) - 'unbootable:b', # unbootable clients simply won't boot - @sharedAttributes, - ], - 'client_system_ref' => [ - # clients referring to the systems they should offer for booting - 'client_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - 'group' => [ - # a group encapsulates a set of clients as one entity, managing - # a group-specific attribute set. All the different attribute - # sets a client inherits via group membership are folded into - # one resulting attribute set with respect to each group's priority. - 'id:pk', # primary key - 'name:s.128', # name of group - 'descr:s.1024', # internal description (for admins) - 'priority:i', # priority, used for order in group-list - # (from 0-lowest to 10-highest) - @sharedAttributes, - ], - 'group_client_ref' => [ - # groups referring to their clients - 'group_id:fk', # foreign key - 'client_id:fk', # foreign key - ], - 'group_system_ref' => [ - # groups referring to the systems each of their clients should - # offer for booting - 'group_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, -}; - -################################################################################ -### DB-schema history -### This hash contains a description of all the different changes that have -### taken place on the schema. Each version contains a changeset (array) -### with the commands that take the schema from the last version to the -### current. -### The following 'cmd'-types are supported: -### add-table => creates a new table -### 'table' => contains the name of the new table -### 'cols' => contains a list of column descriptions -### 'vals' => optional, contains list of data hashes to be inserted -### into new table -### drop-table => drops an existing table -### 'table => contains the name of the table to be dropped -### rename-table => renames a table -### 'old-table' => contains the old name of the table -### 'new-table' => contains the new name of the table -### add-columns => adds columns to a table -### 'table' => the name of the table the columns should be added to -### 'new-cols' => contains a list of new column descriptions -### 'new-default-vals' => optional, a list of data hashes to be used -### as default values for the new columns -### 'cols' => contains a list of column descriptions -### drop-columns => drops columns from a table -### 'table' => the name of the table the columns should be dropped from -### 'col-changes' => a hash with changed column descriptions -### 'cols' => contains a full list of resulting column descriptions -################################################################################ - -%DbSchemaHistory = ( - '0.01' => [ - # the initial schema version simply adds a couple of tables: - { - 'cmd' => 'add-table', - 'table' => 'meta', - 'cols' => $DbSchema->{'tables'}->{'meta'}, - 'vals' => [ - { # add initial meta info - 'schema_version' => $DbSchema->{'version'}, - }, - ], - }, - { - 'cmd' => 'add-table', - 'table' => 'vendor_os', - 'cols' => $DbSchema->{'tables'}->{'vendor_os'}, - }, - { - 'cmd' => 'add-table', - 'table' => 'system', - 'cols' => $DbSchema->{'tables'}->{'system'}, - 'vals' => [ - { # add default system - 'id' => 0, - 'name' => '<<>>', - 'descr' => 'internal system that holds default values', - }, - ], - }, - { - 'cmd' => 'add-table', - 'table' => 'client', - 'cols' => $DbSchema->{'tables'}->{'client'}, - 'vals' => [ - { # add default client - 'id' => 0, - 'name' => '<<>>', - 'descr' => 'internal client that holds default values', - }, - ], - }, - { - 'cmd' => 'add-table', - 'table' => 'client_system_ref', - 'cols' => $DbSchema->{'tables'}->{'client_system_ref'}, - }, - { - 'cmd' => 'add-table', - 'table' => 'group', - 'cols' => $DbSchema->{'tables'}->{'group'}, - }, - { - 'cmd' => 'add-table', - 'table' => 'group_client_ref', - 'cols' => $DbSchema->{'tables'}->{'group_client_ref'}, - }, - { - 'cmd' => 'add-table', - 'table' => 'group_system_ref', - 'cols' => $DbSchema->{'tables'}->{'group_system_ref'}, - }, - ], -); - diff --git a/config-db/ODLX/MetaDB/Base.pm b/config-db/ODLX/MetaDB/Base.pm deleted file mode 100644 index f386dfc3..00000000 --- a/config-db/ODLX/MetaDB/Base.pm +++ /dev/null @@ -1,415 +0,0 @@ -################################################################################ -# ODLX::MetaDB:Base - the base class for all MetaDB drivers -# -# Copyright 2006 by Oliver Tappe - all rights reserved. -# -# You may distribute this module under the terms of the GNU GPL v2. -################################################################################ - -package ODLX::MetaDB::Base; - -use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -=pod - -=head1 NAME - -ODLX::MetaDB::Base - the base class for all MetaDB drivers - -=head1 SYNOPSIS - - package ODLX::MetaDB::coolnewDB; - - use vars qw(@ISA $VERSION); - @ISA = ('ODLX::MetaDB::Base'); - $VERSION = 1.01; - - my $superVersion = $ODLX::MetaDB::Base::VERSION; - if ($superVersion < $VERSION) { - confess _tr('Unable to load module <%s> (Version <%s> required)', - 'ODLX::MetaDB::Base', $VERSION); - } - - use coolnewDB; - - sub new - { - my $class = shift; - my $self = {}; - return bless $self, $class; - } - - sub connectConfigDB - { - my $self = shift; - - my $dbName = $odlxConfig{'db-name'}; - vlog 1, "trying to connect to coolnewDB-database <$dbName>"; - $self->{'dbh'} = ... # get connection handle from coolnewDB - } - - sub disconnectConfigDB - { - my $self = shift; - - $self->{'dbh'}->disconnect; - } - - # override all methods of ODLX::MetaDB::Base in order to implement - # a full MetaDB driver - ... - -I> - -=head1 DESCRIPTION - -This class defines the MetaDB interface for the ODLX. - -Aim of the MetaDB abstraction is to make it possible to use a large set -of different databases (from CSV-files to a fullblown Oracle-installation) -transparently. - -While ODLX::ConfigDB represents the data layer to the outside world, each -implementation of ODLX::MetaDB::Base provides a backend for a specific database. - -This way, the different ODLX-scripts do not have to burden -themselves with any DB-specific details, they just request the data they want -from the ConfigDB-layer and that in turn creates and communicates with the -appropriate MetaDB driver in order to connect to the database and fetch and/or -change the data as instructed. - -The MetaDB interface contains of four different parts: - -=over - -=item - L (connection handling and utilities) - -=item - L (getting data) - -=item - L (adding, removing and changing data) - -=item - L (migrating between different DB-versions) - -=back - -In order to implement a MetaDB driver for a specific database, you need -to inherit from B and implement the full interface. As this -is quite some work, it might be wiser to actually inherit your driver from -B>, which is a default implementation for SQL databases. - -If there is a DBD-driver for the database your new MetaDB driver wants to talk -to then all you need to do is inherit from B and then -reimplement L> (and maybe some other methods in order to -improve efficiency). - -=cut - -################################################################################ -use strict; -use Carp; - -################################################################################ - -=head2 Basic Methods - -The following basic methods need to be implemented in a MetaDB driver: - -=over - -=cut - -################################################################################ -sub new -{ - confess "Don't create ODLX::MetaDB::Base - objects directly!"; -} - -=item C - - $metaDB->connectConfigDB($dbParams); - -Tries to establish a connection to the DBMS that this MetaDB driver deals with. -The global configuration hash C<%config> contains further info about the -requested connection. When implementing this method, you may have to look at -the following entries in order to find out which database to connect to: - -=over - -=item C<$config{'db-basepath'}> - -basic path to odlx database, defaults to path of running script - -=item C<$config{'db-datadir'}> - -data folder created under db-basepath, default depends on db-type (many -DBMSs don't have such a folder, as they do not store the data in the -filesystem). - -=item C<$config{'db-spec'}> - -full specification of database, a special string defining the -precise database to connect to (this allows connecting to a database -that requires specifications which aren't cared for by the existing -C<%config>-entries). - -=item C<$config{'db-name'}> - -the precise name of the database that should be connected (defaults to 'odlx'). - -=back - -=cut - -sub connectConfigDB -{ -} - -sub disconnectConfigDB -{ -} - -sub quote -{ -} - -################################################################################ - -=back - -=head2 Data Access Methods - -The following methods need to be implemented in a MetaDB driver in order to -allow the user to access data: - -=over - -=cut - -################################################################################ - -=item C - - my $filter = { 'os_type' => 'LINUX' }; - my $resultCols = 'id,name,descr'; - my @systems = $metaDBH->fetchSystemsByFilter($filter, $resultCols); - -Fetches and returns information about all systems match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref defining the filter criteria to be applied. Each key corresponds -to a DB column and the (hash-)value contains the respective column value. [At a -later stage, this might be improved to support more structured approach to -filtering (with boolean operators and more)]. - -=item Param C<$resultCols> [Optional] - -A comma-separated list of colunm names that shall be returned. If not defined, -all available data must be returned. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - - -=back - -=cut - -sub fetchVendorOSesByFilter -{ -} - -sub fetchVendorOSesById -{ -} - -sub fetchSystemsByFilter -{ -} - -sub fetchSystemsById -{ -} - -sub fetchSystemIDsOfVendorOS -{ -} - -sub fetchSystemIDsOfClient -{ -} - -sub fetchSystemIDsOfGroup -{ -} - -sub fetchClientsByFilter -{ -} - -sub fetchClientsById -{ -} - -sub fetchClientIDsOfSystem -{ -} - -sub fetchClientIDsOfGroup -{ -} - -sub fetchGroupsByFilter -{ -} - -sub fetchGroupsById -{ -} - -sub fetchGroupIDsOfClient -{ -} - -sub fetchGroupIDsOfSystem -{ -} - -################################################################################ -### data manipulation interface -################################################################################ -sub generateNextIdForTable -{ # some DBs (CSV for instance) aren't able to generate any IDs, so we - # offer an alternative way (by pre-specifying IDs for INSERTs). - # NB: if this method is called without a tablename, it returns: - # 1 if this backend requires manual ID generation - # 0 if not. - return undef; -} - -sub addVendorOS -{ -} - -sub removeVendorOS -{ -} - -sub changeVendorOS -{ -} - -sub setSystemIDsOfVendorOS -{ -} - -sub addSystem -{ -} - -sub removeSystem -{ -} - -sub changeSystem -{ -} - -sub setClientIDsOfSystem -{ -} - -sub setGroupIDsOfSystem -{ -} - -sub addClient -{ -} - -sub removeClient -{ -} - -sub changeClient -{ -} - -sub setSystemIDsOfClient -{ -} - -sub setGroupIDsOfClient -{ -} - -sub addGroup -{ -} - -sub removeGroup -{ -} - -sub changeGroup -{ -} - -sub setClientIDsOfGroup -{ -} - -sub setSystemIDsOfGroup -{ -} - -################################################################################ -### schema related functions -################################################################################ -sub schemaFetchDBVersion -{ -} - -sub schemaConvertTypeDescrToNative -{ -} - -sub schemaDeclareTable -{ -} - -sub schemaAddTable -{ -} - -sub schemaDropTable -{ -} - -sub schemaRenameTable -{ -} - -sub schemaAddColumns -{ -} - -sub schemaDropColumns -{ -} - -sub schemaChangeColumns -{ -} - -=back - -=cut - -1; \ No newline at end of file diff --git a/config-db/ODLX/MetaDB/CSV.pm b/config-db/ODLX/MetaDB/CSV.pm deleted file mode 100644 index c1c5a620..00000000 --- a/config-db/ODLX/MetaDB/CSV.pm +++ /dev/null @@ -1,127 +0,0 @@ -package ODLX::MetaDB::CSV; - -use vars qw(@ISA $VERSION); -@ISA = ('ODLX::MetaDB::DBI'); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This class provides a MetaDB backend for CSV files (CSV = comma separated -### files). -### - each table will be stored into a CSV file. -### - by default all files will be created inside a 'odlxdata-csv' directory. -################################################################################ -use strict; -use Carp; -use Fcntl qw(:DEFAULT :flock); -use ODLX::Basics; -use ODLX::MetaDB::DBI $VERSION; - -my $superVersion = $ODLX::MetaDB::DBI::VERSION; -if ($superVersion < $VERSION) { - confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', - 'ODLX::MetaDB::DBI', $VERSION, $superVersion); -} -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub connectConfigDB -{ - my $self = shift; - - my $dbSpec = $odlxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - my $dbBasepath = $odlxConfig{'db-basepath'}; - my $dbDatadir = $odlxConfig{'db-datadir'} || 'odlxdata-csv'; - my $dbPath = "$dbBasepath/$dbDatadir"; - mkdir $dbPath unless -e $dbPath; - $dbSpec = "f_dir=$dbPath"; - } - vlog 1, "trying to connect to CSV-database <$dbSpec>"; - $self->{'dbh'} = DBI->connect("dbi:CSV:$dbSpec", undef, undef, - {PrintError => 0}) - or confess _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... - my $self = shift; - my $val = shift; - - $val =~ s[(['])][\\$1]go; - return "'$val'"; -} - -sub generateNextIdForTable -{ # CSV doesn't provide any mechanism to generate IDs, we just... - my $self = shift; - my $table = shift; - - return 1 unless defined $table; - - # now fetch the next ID from a table-specific file: - 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, $!); - flock(IDFILE, LOCK_EX) - or confess _tr(q[Can't lock ID-file <%s> (%s)], $idFile, $!); - my $nextID = ; - if (!$nextID) { - # no ID information available, we protect against users having - # deleted the ID-file by fetching the highest ID from the DB: - $nextID = 1+$self->_doSelect("SELECT max(id) AS id FROM $table", 'id'); - } - seek(IDFILE, 0, 0) - 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, $!); - close(IDFILE); - - return $nextID; -} - -sub schemaDeclareTable -{ # 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"}; -} - -sub schemaRenameTable -{ # renames corresponding id-file after renaming the table - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - - $self->schemaDeclareTable($newTable); - $self->SUPER::schemaRenameTable($oldTable, $newTable, @_); - my $dbh = $self->{'dbh'}; - rename "$dbh->{'f_dir'}/id-$oldTable", "$dbh->{'f_dir'}/id-$newTable"; -} - -sub schemaDropTable -{ # removes corresponding id-file after dropping the table - my $self = shift; - my $table = shift; - - $self->SUPER::schemaDropTable($table, @_); - my $dbh = $self->{'dbh'}; - unlink "$dbh->{'f_dir'}/id-$table"; -} - -1; \ No newline at end of file diff --git a/config-db/ODLX/MetaDB/DBI.pm b/config-db/ODLX/MetaDB/DBI.pm deleted file mode 100644 index 83372ad9..00000000 --- a/config-db/ODLX/MetaDB/DBI.pm +++ /dev/null @@ -1,885 +0,0 @@ -package ODLX::MetaDB::DBI; - -use vars qw(@ISA $VERSION); -@ISA = ('ODLX::MetaDB::Base'); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This class is the base for all DBI-related metaDB variants. -### It provides a default implementation for every method, such that -### each DB-specific implementation needs to override only the methods -### that require a different implementation than the one provided here. -### -### N.B.: In case you ask yourself why none of the SQL-statements in this -### file make use of SQL bind params (?), the answer is that at least -### one DBD-driver didn't like them at all. As the performance gains -### from bound params are not really necessary here, we simply do -### not use them. -################################################################################ - -use strict; -use Carp; -use DBI; -use ODLX::Basics; -use ODLX::MetaDB::Base; - -my $superVersion = $ODLX::MetaDB::Base::VERSION; -if ($superVersion < $VERSION) { - confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', - 'ODLX::MetaDB::Base', $VERSION, $superVersion); -} - -################################################################################ -### basics -################################################################################ -sub new -{ - confess "Don't call ODLX::MetaDB::DBI::new directly!"; -} - -sub disconnectConfigDB -{ - my $self = shift; - - $self->{'dbh'}->disconnect; - $self->{'dbh'} = undef; -} - -sub quote -{ # default implementation quotes any given values through the DBD-driver - my $self = shift; - - return $self->{'dbh'}->quote(@_); -} - -################################################################################ -### data access functions -################################################################################ -sub _doSelect -{ - my $self = shift; - my $sql = shift; - my $resultCol = shift; - - my $dbh = $self->{'dbh'}; - - my $sth = $dbh->prepare($sql) - 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); - my (@vals, $row); - while($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 @vals; -} - -sub fetchVendorOSesByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $sql = "SELECT $resultCols FROM vendor_os"; - my $connector; - foreach my $col (keys %$filter) { - $connector = !defined $connector ? 'WHERE' : 'AND'; - $sql .= " $connector $col = '$filter->{$col}'"; - } - return $self->_doSelect($sql); -} - -sub fetchVendorOSesById -{ - my $self = shift; - my $id = shift; - my $resultCols = shift; - - return $self->fetchVendorOSesByFilter({'id' => $id}, $resultCols); -} - -sub fetchSystemsByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $sql = "SELECT $resultCols FROM system"; - my $connector; - foreach my $col (keys %$filter) { - $connector = !defined $connector ? 'WHERE' : 'AND'; - $sql .= " $connector $col = '$filter->{$col}'"; - } - return $self->_doSelect($sql); -} - -sub fetchSystemsById -{ - my $self = shift; - my $id = shift; - my $resultCols = shift; - - return $self->fetchSystemsByFilter({'id' => $id}, $resultCols); -} - -sub fetchSystemIDsOfVendorOS -{ - my $self = shift; - my $vendorOSID = shift; - - my $sql = qq[ - SELECT id FROM system WHERE vendor_os_id = '$vendorOSID' - ]; - return $self->_doSelect($sql, 'id'); -} - -sub fetchSystemIDsOfClient -{ - 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'); -} - -sub fetchSystemIDsOfGroup -{ - 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'); -} - -sub fetchClientsByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $sql = "SELECT $resultCols FROM client"; - my $connector; - foreach my $col (keys %$filter) { - $connector = !defined $connector ? 'WHERE' : 'AND'; - $sql .= " $connector $col = '$filter->{$col}'"; - } - return $self->_doSelect($sql); -} - -sub fetchClientsById -{ - my $self = shift; - my $id = shift; - my $resultCols = shift; - - return $self->fetchClientsByFilter({'id' => $id}, $resultCols); -} - -sub fetchClientIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - - my $sql = qq[ - SELECT client_id FROM client_system_ref WHERE system_id = '$systemID' - ]; - return $self->_doSelect($sql, 'system_id'); -} - -sub fetchClientIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - - my $sql = qq[ - SELECT client_id FROM group_client_ref WHERE group_id = '$groupID' - ]; - return $self->_doSelect($sql, 'system_id'); -} - -sub fetchGroupsByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $sql = "SELECT $resultCols FROM group"; - my $connector; - foreach my $col (keys %$filter) { - $connector = !defined $connector ? 'WHERE' : 'AND'; - $sql .= " $connector $col = '$filter->{$col}'"; - } - return $self->_doSelect($sql); -} - -sub fetchGroupsById -{ - my $self = shift; - my $id = shift; - my $resultCols = shift; - - return $self->fetchGroupsByFilter({'id' => $id}, $resultCols); -} - -sub fetchGroupIDsOfSystem -{ - 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'); -} - -sub fetchGroupIDsOfClient -{ - 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'); -} - -################################################################################ -### data manipulation functions -### -### N.B.: In case you ask yourself why none of the SQL-statements in -### the following functions make use of SQL-placeholders (?), the answer -### is that at least one DBD-driver didn't like them at all. -### As the improved performance gained from using placeholders is not -### really necessary here, we simply do not use them. -################################################################################ -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; - - 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 )"; - my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); - vlog 3, $sql; - $sth->execute() - 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'); - 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 $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); - } - my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); - vlog 3, $sql; - $sth->execute() - 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 $valRows = shift; - - my $dbh = $self->{'dbh'}; - my $valRow = (@$valRows)[0]; - return if !defined $valRow; - - my $idx = 0; - foreach my $valRow (@$valRows) { - 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; - my $sql = "UPDATE $table SET $cols"; - if (defined $id) { - $sql .= " WHERE id = ".$self->quote($id); - } - my $sth = $dbh->prepare($sql) - or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); - vlog 3, $sql; - $sth->execute() - 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 $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); - } -} - -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' }]); - } -} - -sub addVendorOS -{ - my $self = shift; - my $valRows = shift; - - return $self->_doInsert('vendor_os', $valRows); -} - -sub removeVendorOS -{ - my $self = shift; - my $vendorOSIDs = shift; - - return $self->_doDelete('vendor_os', $vendorOSIDs); -} - -sub changeVendorOS -{ - my $self = shift; - my $vendorOSIDs = shift; - my $valRows = shift; - - return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); -} - -sub setSystemIDsOfVendorOS -{ - my $self = shift; - my $vendorOSID = shift; - my $systemIDs = shift; - - my @currSystems = $self->fetchSystemsOfVendorOS($vendorOSID); - $self->_updateOneToManyRefAttr('system', $vendorOSID, $systemIDs, - 'vendor_os_id', \@currSystems); -} - -sub addSystem -{ - my $self = shift; - my $valRows = shift; - - return $self->_doInsert('system', $valRows); -} - -sub removeSystem -{ - my $self = shift; - my $systemIDs = shift; - - return $self->_doDelete('system', $systemIDs); -} - -sub changeSystem -{ - my $self = shift; - my $systemIDs = shift; - my $valRows = shift; - - return $self->_doUpdate('system', $systemIDs, $valRows); -} - -sub setClientIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $clientIDs = shift; - - my @currClients = $self->fetchClientIDsOfSystem($systemID); - $self->_updateRefTable('client_system_ref', $systemID, $clientIDs, - 'system_id', 'client_id', \@currClients); -} - -sub setGroupIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $groupIDs = shift; - - my @currGroups = $self->fetchGroupIDsOfSystem($systemID); - $self->_updateRefTable('grop_system_ref', $systemID, $groupIDs, - 'system_id', 'group_id', \@currGroups); -} - -sub addClient -{ - my $self = shift; - my $valRows = shift; - - return $self->_doInsert('client', $valRows); -} - -sub removeClient -{ - my $self = shift; - my $clientIDs = shift; - - return $self->_doDelete('client', $clientIDs); -} - -sub changeClient -{ - my $self = shift; - my $clientIDs = shift; - my $valRows = shift; - - return $self->_doUpdate('client', $clientIDs, $valRows); -} - -sub setSystemIDsOfClient -{ - 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); -} - -sub setGroupIDsOfClient -{ - 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); -} - -sub addGroup -{ - my $self = shift; - my $valRows = shift; - - return $self->_doInsert('group', $valRows); -} - -sub removeGroup -{ - my $self = shift; - my $groupIDs = shift; - - return $self->_doDelete('group', $groupIDs); -} - -sub changeGroup -{ - my $self = shift; - my $groupIDs = shift; - my $valRows = shift; - - return $self->_doUpdate('group', $groupIDs, $valRows); -} - -sub setClientIDsOfGroup -{ - 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); -} - -sub setSystemIDsOfGroup -{ - 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); -} - -################################################################################ -### schema related functions -################################################################################ -sub _convertColDescrsToDBNativeString -{ - 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; - return $colDescrString; -} - -sub _convertColDescrsToColNames -{ - 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; - } - @$colDescrs; -} - -sub _convertColDescrsToColNamesString -{ - my $self = shift; - my $colDescrs = shift; - - return join ', ', $self->_convertColDescrsToColNames($colDescrs); -} - -sub schemaFetchDBVersion -{ - 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 undef unless defined $row; - # no entry in meta-table - return $row->{schema_version}; -} - -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 { - confess _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 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 - $self->_doInsert($table, $initialVals, $ignoreIDs); - } -} - -sub schemaDropTable -{ - 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 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 RENAME TO ' 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 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); -} - -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 RENAME TO ' 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 @colNames = $self->_convertColDescrsToColNames($colDescrs); - 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); -} - -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 DROP COLUMN ' 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); -} - -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 CHANGE COLUMN ' 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); -} - -1; \ No newline at end of file diff --git a/config-db/ODLX/MetaDB/SQLite.pm b/config-db/ODLX/MetaDB/SQLite.pm deleted file mode 100644 index c8aa30fe..00000000 --- a/config-db/ODLX/MetaDB/SQLite.pm +++ /dev/null @@ -1,96 +0,0 @@ -package ODLX::MetaDB::SQLite; - -use vars qw(@ISA $VERSION); -@ISA = ('ODLX::MetaDB::DBI'); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This class provides a MetaDB backend for SQLite databases. -### - by default the db will be created inside a 'odlxdata-sqlite' directory. -################################################################################ -use strict; -use Carp; -use ODLX::Basics; -use ODLX::MetaDB::DBI $VERSION; - -my $superVersion = $ODLX::MetaDB::DBI::VERSION; -if ($superVersion < $VERSION) { - confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', - 'ODLX::MetaDB::DBI', $VERSION, $superVersion); -} - -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub connectConfigDB -{ - my $self = shift; - - my $dbSpec = $odlxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - my $dbBasepath = $odlxConfig{'db-basepath'}; - my $dbDatadir = $odlxConfig{'db-datadir'} || 'odlxdata-sqlite'; - my $dbPath = "$dbBasepath/$dbDatadir"; - mkdir $dbPath unless -e $dbPath; - my $dbName = $odlxConfig{'db-name'}; - $dbSpec = "dbname=$dbPath/$dbName"; - } - vlog 1, "trying to connect to SQLite-database <$dbSpec>"; - $self->{'dbh'} = DBI->connect("dbi:SQLite:$dbSpec", undef, undef, - {PrintError => 0}) - or confess _tr("Cannot connect to database <%s> (%s)"), - $dbSpec, $DBI::errstr; -} - -sub schemaRenameTable -{ - 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 $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); -} - -sub schemaAddColumns -{ - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog 1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd; - foreach my $colDescr (@$newColDescrs) { - 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); - } - # if default values have been provided, we apply them now: - if (defined $newColDefaultVals) { - $self->_doUpdate($table, undef, $newColDefaultVals); - } -} - -1; \ No newline at end of file diff --git a/config-db/ODLX/MetaDB/XML.pm b/config-db/ODLX/MetaDB/XML.pm deleted file mode 100644 index fd27c9b7..00000000 --- a/config-db/ODLX/MetaDB/XML.pm +++ /dev/null @@ -1,186 +0,0 @@ -package ODLX::MetaDB::XML; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); - -use Exporter; -$VERSION = 0.02; -@ISA = qw(Exporter); - -@EXPORT = qw( - &metaConnectConfigDB &metaDisconnectConfigDB - &metaAddSystem - &metaFetchDBSchemaVersion &metaSchemaAddTable &metaSchemaDeclareTable -); - -################################################################################ -### private stuff required by this module -################################################################################ -use Carp; -use DBI; -use ODLX::Base; - -################################################################################ -### basics -################################################################################ -sub metaConnectConfigDB -{ - my $dbParams = shift; - - my $dbPath = $dbParams->{'db-path'} - || '/home/zooey/Sources/odlx/config-db/datafiles-xml'; - mkdir $dbPath; - vlog 1, "trying to connect to XML-database <$dbPath>"; - my $dbh = DBI->connect("dbi:AnyData:", - undef, undef, - {PrintError => 0}) - or confess _tr("Cannot connect to database <%s> (%s)"), - $dbPath, $DBI::errstr; - my $metaDB = { - 'db-path' => $dbPath, - 'dbi-dbh' => $dbh, - }; - return $metaDB; -} - -sub metaDisconnectConfigDB -{ - my $metaDB = shift; - - my $dbh = $metaDB->{'dbi-dbh'}; - - $dbh->disconnect; -} - -################################################################################ -### data access functions -################################################################################ - -sub metaFetchSystemsById -{ -} - -################################################################################ -### data manipulation functions -################################################################################ - -sub metaDoInsert -{ - my $metaDB = shift; - my $table = shift; - my $valRows = shift; - - my $dbh = $metaDB->{'dbi-dbh'}; - my $valRow = (@$valRows)[0]; - return if !defined $valRow; - my $cols = join ', ', keys %$valRow; -print "cols: $cols\n"; - my $placeholders = join ', ', map { '?' } keys %$valRow; - my $sql = "INSERT INTO $table ( $cols ) VALUES ( $placeholders )"; - my $sth = $dbh->prepare($sql) - or confess _tr("Cannot insert into table <%s> (%s)", $table, $dbh->errstr); - foreach my $valRow (@$valRows) { - vlog 3, $sql; -my $vals = join ', ', values %$valRow; -print "vals: $vals\n"; - $sth->execute(values %$valRow) - or confess _tr("Cannot insert into table <%s> (%s)", - $table, $dbh->errstr); - } - -} - -sub metaAddSystem -{ - my $metaDB = shift; - my $valRows = shift; - - metaDoInsert($metaDB, 'system', $valRows); -} - -################################################################################ -### schema related functions -################################################################################ -sub metaFetchDBSchemaVersion -{ - my $metaDB = shift; - - my $dbh = $metaDB->{'dbi-dbh'}; - local $dbh->{RaiseError} = 0; - my $sth = $dbh->prepare('SELECT schema_version FROM meta') - or return 0; - my $row = $sth->fetchrow_hashref(); - return 0 unless defined $row; - # no entry in meta-table - return $row->{schema_version}; -} - -sub metaSchemaConvertTypeDescrToNative -{ - 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 { - confess _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } -} - -sub metaSchemaDeclareTable -{ - my $metaDB = shift; - my $table = shift; - my $colDescrs = shift; - - my $dbh = $metaDB->{'dbi-dbh'}; - my $dbPath = $metaDB->{'db-path'}; - my @colNames = map { my $col = $_; $col =~ s[:.+$][]; $col } @$colDescrs; - my $cols = join(', ', @colNames); - vlog 2, "declaring table <$table> as ($cols)..."; - $dbh->func( $table, 'XML', "$dbPath/${table}.xml", - { 'col_map' => [ @colNames ], 'pretty_print' => 'indented' }, - 'ad_catalog'); -} - -sub metaSchemaAddTable -{ - my $metaDB = shift; - my $changeDescr = shift; - - my $dbh = $metaDB->{'dbi-dbh'}; - my $table = $changeDescr->{table}; - vlog 2, "adding table <$table> to schema..."; - my $cols = - 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 ".metaSchemaConvertTypeDescrToNative($2); - } - @{$changeDescr->{cols}}; - my $sql = "CREATE TABLE $changeDescr->{table} ($cols)"; - vlog 3, $sql; - $dbh->do($sql) - or confess _tr("Cannot create table <%s> (%s)", $table, $dbh->errstr); - if (exists $changeDescr->{vals}) { - metaDoInsert($metaDB, $table, $changeDescr->{vals}); - } - -print "exporting...\n"; - $dbh->func( $table, 'XML', "$metaDB->{'db-path'}/$table.xml", - {'pretty_print' => 'indented'}, 'ad_export'); -print "exporting done\n"; -} - -1; \ No newline at end of file diff --git a/config-db/ODLX/MetaDB/mysql.pm b/config-db/ODLX/MetaDB/mysql.pm deleted file mode 100644 index 625ef08f..00000000 --- a/config-db/ODLX/MetaDB/mysql.pm +++ /dev/null @@ -1,161 +0,0 @@ -package ODLX::MetaDB::mysql; - -use vars qw(@ISA $VERSION); -@ISA = ('ODLX::MetaDB::DBI'); -$VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This class provides a MetaDB backend for mysql databases. -### - by default the db will be created inside a 'odlxdata-mysql' directory. -################################################################################ -use strict; -use Carp; -use ODLX::Basics; -use ODLX::MetaDB::DBI $VERSION; - -my $superVersion = $ODLX::MetaDB::DBI::VERSION; -if ($superVersion < $VERSION) { - confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', - 'ODLX::MetaDB::DBI', $VERSION, $superVersion); -} - -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub connectConfigDB -{ - my $self = shift; - - my $dbSpec = $odlxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - my $dbName = $odlxConfig{'db-name'}; - $dbSpec = "database=$dbName"; - } - 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 confess _tr("Cannot connect to database <%s> (%s)"), - $dbSpec, $DBI::errstr; -} - -sub schemaConvertTypeDescrToNative -{ - 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 AUTO_INCREMENT primary key'; - } elsif ($typeDescr eq 'fk') { - return 'integer'; - } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { - return "varchar($1)"; - } else { - confess _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } -} - -sub schemaRenameTable -{ - 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 $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); -} - -sub schemaAddColumns -{ - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - 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; - 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); - # if default values have been provided, we apply them now: - if (defined $newColDefaultVals) { - $self->_doUpdate($table, undef, $newColDefaultVals); - } -} - -sub schemaDropColumns -{ - my $self = shift; - my $table = shift; - my $dropColNames = 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; - 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); -} - -sub schemaChangeColumns -{ - my $self = shift; - my $table = shift; - my $colChanges = 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; - 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); -} -1; \ No newline at end of file diff --git a/config-db/ODLX/Translations/de_de_utf_8.pm b/config-db/ODLX/Translations/de_de_utf_8.pm deleted file mode 100644 index 36a2a814..00000000 --- a/config-db/ODLX/Translations/de_de_utf_8.pm +++ /dev/null @@ -1,27 +0,0 @@ -package ODLX::Translations::de_de_utf_8; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); - -use Exporter; -$VERSION = 0.02; -@ISA = qw(Exporter); - -@EXPORT = qw(%translations); - -use vars qw(%translations); - -################################################################################ -### Translations -################################################################################ - -%translations = ( - 'Could not determine schema version of database' - => 'Die Version des Datenbank-Schemas konnte nicht bestimmt werden', - 'Unable to load DB-module <%s> (%s)' - => 'Kann DB-Modul <%s> nicht laden (%s)', - 'UnknownDbSchemaCommand' - => 'Unbekannter DbSchema-Befehl <%s> wird übergangen', -); - -1; \ No newline at end of file diff --git a/config-db/ODLX/Translations/posix.pm b/config-db/ODLX/Translations/posix.pm deleted file mode 100644 index 4b48cb55..00000000 --- a/config-db/ODLX/Translations/posix.pm +++ /dev/null @@ -1,33 +0,0 @@ -package ODLX::Translations::posix; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); - -use Exporter; -$VERSION = 0.02; -@ISA = qw(Exporter); - -@EXPORT = qw(%translations); - -use vars qw(%translations); - -################################################################################ -### Translations -################################################################################ - -%translations = ( - 'Could not determine schema version of database' - => 'Could not determine schema version of database', - 'Unable to load DB-module <%s> (%s)' - => 'Unable to load DB-module <%s> (%s)', - 'Unable to load module <%s> (Version <%s> required, but <%s> found)' - => 'Unable to load module <%s> (Version <%s> required, but <%s> found)', - 'UnknownDbSchemaCommand' - => 'Unknown DbSchema command <%s> found', - 'UnknownDbSchemaColumnDescr' - => 'Unknown DbSchema column description <%s> found', - 'UnknownDbSchemaTypeDescr' - => 'Unknown DbSchema type description <%s> found', -); - -1; \ No newline at end of file diff --git a/config-db/OpenSLX/Basics.pm b/config-db/OpenSLX/Basics.pm new file mode 100644 index 00000000..5a797034 --- /dev/null +++ b/config-db/OpenSLX/Basics.pm @@ -0,0 +1,171 @@ +package OpenSLX::Basics; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 0.02; +@ISA = qw(Exporter); + +@EXPORT = qw( + &openslxInit %openslxConfig + &_tr &trInit + &vlog +); + +use vars qw(%openslxConfig); + +################################################################################ +### Module implementation +################################################################################ +use Carp; +use FindBin; +use Getopt::Long; + +my %translations; +my $loadedTranslationModule; + +# this hash will hold the active openslx configuration, +# it is populated from config files and/or cmdline arguments: +%openslxConfig = ( + 'db-name' => 'openslx', + 'db-type' => 'CSV', + 'locale' => $ENV{LANG}, + # TODO: may need to be improved in order to be portable + 'private-basepath' => '/var/lib/openslx', + 'public-basepath' => '/srv/openslx', + 'shared-basepath' => '/usr/share/openslx', + 'temp-basepath' => '/tmp', +); +$openslxConfig{'db-basepath'} = "$openslxConfig{'private-basepath'}/db", + +# specification of cmdline arguments that are shared by all openslx-scripts: +my %openslxCmdlineArgs = ( + 'db-basepath=s' => \$openslxConfig{'db-basepath'}, + # basic path to openslx database, defaults to "$private-basepath/db" + 'db-datadir=s' => \$openslxConfig{'db-datadir'}, + # data folder created under db-basepath, default depends on db-type + 'db-spec=s' => \$openslxConfig{'db-spec'}, + # full specification of database, a special string defining the + # precise database to connect to (the contents of this string + # depend on db-type) + 'db-name=s' => \$openslxConfig{'db-name'}, + # name of database, defaults to 'openslx' + 'db-type=s' => \$openslxConfig{'db-type'}, + # type of database to connect to (CSV, SQLite, ...), defaults to 'CSV' + 'locale=s' => \$openslxConfig{'locale'}, + # locale to use for translations + 'logfile=s' => \$openslxConfig{'locale'}, + # file to write logging output to, defaults to STDERR + 'private-basepath=s' => \$openslxConfig{'private-basepath'}, + # basic path to private data (which is accessible for clients and + # contains all data required for booting the clients) + 'public-basepath=s' => \$openslxConfig{'public-basepath'}, + # basic path to public data (which contains database, vendorOSes + # and all local extensions [system specific scripts]) + 'shared-basepath=s' => \$openslxConfig{'shared-basepath'}, + # basic path to shared data (functionality templates and distro-specs) + 'temp-basepath=s' => \$openslxConfig{'temp-basepath'}, + # basic path to temporary data (used during demuxing) + 'verbose-level=i' => \$openslxConfig{'verbose-level'}, + # level of logging verbosity (0-3) +); + +# filehandle used for logging: +my $openslxLog = *STDERR; + +# ------------------------------------------------------------------------------ +sub vlog +{ + my $minLevel = shift; + return if $minLevel > $openslxConfig{'verbose-level'}; + print $openslxLog '-'x$minLevel, @_, "\n"; +} + +# ------------------------------------------------------------------------------ +sub openslxInit +{ + # try to read and evaluate config files: + foreach my $f ("OpenSLX/openslxrc", "$ENV{HOME}/.openslxrc") { + next unless open(CONFIG, "<$f"); + while() { + chomp; + s/#.*//; + s/^\s+//; + s/\s+$//; + next unless length; + my ($key, $value) = split(/\s*=\s*/, $_, 2); + $openslxConfig{$key} = $value; + } + close CONFIG; + } + + # push any cmdline argument directly into our config hash: + GetOptions(%openslxCmdlineArgs); + + if (defined $openslxConfig{'logfile'} + && open(LOG, ">>$openslxConfig{'logfile'}")) { + $openslxLog + } + if ($openslxConfig{'verbose-level'} >= 2) { + foreach my $k (sort keys %openslxConfig) { + vlog 2, "dump-config: $k = $openslxConfig{$k}"; + } + } + + # setup translation "engine": + trInit(); +} + +# ------------------------------------------------------------------------------ +sub trInit +{ + my $locale = $openslxConfig{'locale'}; + $locale =~ tr[A-Z.\-][a-z__]; + + my $trModule = "OpenSLX::Translations::$locale"; + if ($loadedTranslationModule eq $trModule) { + # requested translations have already been loaded + return; + } + + # load Posix-Translations first in order to fall back to English strings + # if a specific translation isn't available: + if (eval "require OpenSLX::Translations::posix") { + %translations = %OpenSLX::Translations::posix::translations; + } else { + carp "Unable to load translations module 'posix' ($!)."; + } + + if ($locale ne 'posix') { + if (eval "require $trModule") { + # Access OpenSLX::Translations::$locale::%translations + # via a symbolic reference... + no strict 'refs'; + my $translationsRef = \%{"${trModule}::translations"}; + # ...and copy the available translations into our hash: + foreach my $k (keys %{$translationsRef}) { + $translations{$k} = $translationsRef->{$k}; + } + $loadedTranslationModule = $trModule; + } else { + carp "Unable to load translations module '$locale' ($!)."; + } + } + +} + +# ------------------------------------------------------------------------------ +sub _tr +{ + my $trKey = shift; + + my $formatStr = $translations{$trKey}; + if (!defined $formatStr) { +# carp "Translation key '$trKey' not found."; + $formatStr = $trKey; + } + return sprintf($formatStr, @_); +} + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm new file mode 100644 index 00000000..6f8d811e --- /dev/null +++ b/config-db/OpenSLX/ConfigDB.pm @@ -0,0 +1,667 @@ +package OpenSLX::ConfigDB; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This module defines the data abstraction layer for the OpenSLX configuration +### database. +### Aim of this abstraction is to hide the details of the data layout and +### the peculiarities of individual database types behind a simple interface +### that offers straightforward access to and manipulation of the OpenSLX-systems +### and -clients (without the need to use SQL). +### The interface is divided into two parts: +### - data access methods (getting data) +### - data manipulation methods (adding, removing and changing data) +################################################################################ +use Exporter; +@ISA = qw(Exporter); + +my @accessExports = qw( + connectConfigDB disconnectConfigDB + fetchVendorOSesByFilter fetchVendorOSesByID fetchVendorOSIDsOfSystem + fetchSystemsByFilter fetchSystemsByID fetchSystemIDsOfClient + fetchSystemIDsOfGroup + fetchClientsByFilter fetchClientsByID fetchClientIDsOfSystem + fetchClientIDsOfGroup + fetchGroupsByFilter fetchGroupsByID fetchGroupIDsOfClient + fetchGroupIDsOfSystem +); +my @manipulationExports = qw( + addVendorOS removeVendorOS changeVendorOS + setSystemIDsOfVendorOS addSystemIDsToVendorOS removeSystemIDsFromVendorOS + addSystem removeSystem changeSystem + setClientIDsOfSystem addClientIDsToSystem removeClientIDsFromSystem + setGroupIDsOfSystem addGroupIDsToSystem removeGroupIDsFromSystem + addClient removeClient changeClient + setSystemIDsOfClient addSystemIDsToClient removeSystemIDsFromClient + setGroupIDsOfClient addGroupIDsToClient removeGroupIDsFromClient + addGroup removeGroup changeGroup + setClientIDsOfGroup addClientIDsToGroup removeClientIDsFromGroup + setSystemIDsOfGroup addSystemIDsToGroup removeSystemIDsFromGroup +); + +@EXPORT = @accessExports; +@EXPORT_OK = @manipulationExports; +%EXPORT_TAGS = ( + 'access' => [ @accessExports ], + 'manipulation' => [ @manipulationExports ], +); + +################################################################################ +### private stuff +################################################################################ +use Carp; +use OpenSLX::Basics; +use OpenSLX::DBSchema; + +sub _checkAndUpgradeDBSchemaIfNecessary +{ + my $metaDB = shift; + + vlog 2, "trying to determine schema version..."; + my $currVersion = $metaDB->schemaFetchDBVersion(); + if (!defined $currVersion) { + # that's bad, someone has messed with our DB, as there is a + # database, but the 'meta'-table is empty. There might still + # be data in the other tables, but we have no way to find out + # which schema version they're in. So it's safer to give up: + croak _tr('Could not determine schema version of database'); + } + + if ($currVersion < $DbSchema->{version}) { + vlog 1, _tr('Our schema-version is %s, DB is %s, upgrading DB...', + $DbSchema->{version}, $currVersion); + foreach my $v (sort { $a <=> $b } keys %DbSchemaHistory) { + next if $v <= $currVersion; + my $changeSet = $DbSchemaHistory{$v}; + foreach my $c (0..scalar(@$changeSet)-1) { + my $changeDescr = @{$changeSet}[$c]; + my $cmd = $changeDescr->{cmd}; + if ($cmd eq 'add-table') { + $metaDB->schemaAddTable($changeDescr->{'table'}, + $changeDescr->{'cols'}, + $changeDescr->{'vals'}); + } elsif ($cmd eq 'drop-table') { + $metaDB->schemaDropTable($changeDescr->{'table'}); + } elsif ($cmd eq 'rename-table') { + $metaDB->schemaRenameTable($changeDescr->{'old-table'}, + $changeDescr->{'new-table'}, + $changeDescr->{'cols'}); + } elsif ($cmd eq 'add-columns') { + $metaDB->schemaAddColumns($changeDescr->{'table'}, + $changeDescr->{'new-cols'}, + $changeDescr->{'cols'}); + } elsif ($cmd eq 'drop-columns') { + $metaDB->schemaDropColumns($changeDescr->{'table'}, + $changeDescr->{'drop-cols'}, + $changeDescr->{'cols'}); + } elsif ($cmd eq 'rename-columns') { + $metaDB->schemaRenameColumns($changeDescr->{'table'}, + $changeDescr->{'col-renames'}, + $changeDescr->{'cols'}); + } else { + confess _tr('UnknownDbSchemaCommand', $cmd); + } + } + } + vlog 1, _tr('upgrade done'); + } else { + vlog 1, _tr('DB matches current schema version %s', $currVersion); + } +} + +sub _aref +{ # transparently converts the given reference to an array-ref + my $ref = shift; + $ref = [ $ref ] unless ref($ref) eq 'ARRAY'; + return $ref; +} + +################################################################################ +### data access interface +################################################################################ +sub connectConfigDB +{ + my $dbParams = shift; + # hash-ref with any additional info that might be required by + # specific metadb-module (not used yet) + + my $dbType = $openslxConfig{'db-type'}; + # name of underlying database module + my $dbModule = "OpenSLX::MetaDB::$dbType"; + unless (eval "require $dbModule") { + confess _tr('Unable to load DB-module <%s> (%s)', $dbModule, $@); + } + my $modVersion = $dbModule->VERSION; + if ($modVersion < $VERSION) { + confess _tr('Could not load module <%s> (Version <%s> required, but <%s> found)', + $dbModule, $VERSION, $modVersion); + } + $dbModule->import; + + my $metaDB = $dbModule->new(); + $metaDB->connectConfigDB($dbParams); + my $confDB = { + 'db-type' => $dbType, + 'meta-db' => $metaDB, + }; + foreach my $tk (keys %{$DbSchema->{tables}}) { + $metaDB->schemaDeclareTable($tk, $DbSchema->{tables}->{$tk}); + } + + _checkAndUpgradeDBSchemaIfNecessary($metaDB); + + return $confDB; +} + +sub disconnectConfigDB +{ + my $confDB = shift; + + $confDB->{'meta-db'}->disconnectConfigDB(); +} + +sub fetchVendorOSesByFilter +{ + my $confDB = shift; + my $filter = shift; + my $resultCols = shift; + + my @vendorOSes + = $confDB->{'meta-db'}->fetchVendorOSesByFilter($filter, $resultCols); + return wantarray() ? @vendorOSes : shift @vendorOSes; +} + +sub fetchVendorOSesByID +{ + my $confDB = shift; + my $id = shift; + + my $filter = { 'id' => $id }; + my @vendorOSes = $confDB->{'meta-db'}->fetchVendorOSesByFilter($filter); + return wantarray() ? @vendorOSes : shift @vendorOSes; +} + +sub fetchSystemsByFilter +{ + my $confDB = shift; + my $filter = shift; + my $resultCols = shift; + + my @systems + = $confDB->{'meta-db'}->fetchSystemsByFilter($filter, $resultCols); + return wantarray() ? @systems : shift @systems; +} + +sub fetchSystemsByID +{ + my $confDB = shift; + my $id = shift; + + my $filter = { 'id' => $id }; + my @systems = $confDB->{'meta-db'}->fetchSystemsByFilter($filter); + return wantarray() ? @systems : shift @systems; +} + +sub fetchSystemIDsOfVendorOS +{ + my $confDB = shift; + my $vendorOSID = shift; + + return $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); +} + +sub fetchSystemIDsOfClient +{ + my $confDB = shift; + my $clientID = shift; + + return $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); +} + +sub fetchSystemIDsOfGroup +{ + my $confDB = shift; + my $groupID = shift; + + return $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); +} + +sub fetchClientsByFilter +{ + my $confDB = shift; + my $filter = shift; + + my @clients = $confDB->{'meta-db'}->fetchClientsByFilter($filter); + return wantarray() ? @clients : shift @clients; +} + +sub fetchClientsByID +{ + my $confDB = shift; + my $id = shift; + + my $filter = { 'id' => $id }; + my @clients = $confDB->{'meta-db'}->fetchClientsByFilter($filter); + return wantarray() ? @clients : shift @clients; +} + +sub fetchClientIDsOfSystem +{ + my $confDB = shift; + my $systemID = shift; + + return $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); +} + +sub fetchClientIDsOfGroup +{ + my $confDB = shift; + my $groupID = shift; + + return $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); +} + +sub fetchGroupsByFilter +{ + my $confDB = shift; + my $filter = shift; + my $resultCols = shift; + + my @groups + = $confDB->{'meta-db'}->fetchGroupsByFilter($filter, $resultCols); + return wantarray() ? @groups : shift @groups; +} + +sub fetchGroupsByID +{ + my $confDB = shift; + my $id = shift; + + my $filter = { 'id' => $id }; + my @groups = $confDB->{'meta-db'}->fetchGroupsByFilter($filter); + return wantarray() ? @groups : shift @groups; +} + +sub fetchGroupIDsOfSystem +{ + my $confDB = shift; + my $systemID = shift; + + return $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); +} + +sub fetchGroupIDsOfClient +{ + my $confDB = shift; + my $clientID = shift; + + return $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); +} + +################################################################################ +### data manipulation interface +################################################################################ +sub addVendorOS +{ + my $confDB = shift; + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->addVendorOS($valRows); +} + +sub removeVendorOS +{ + my $confDB = shift; + my $vendorOSIDs = _aref(shift); + + return $confDB->{'meta-db'}->removeVendorOS($vendorOSIDs); +} + +sub changeVendorOS +{ + my $confDB = shift; + my $vendorOSIDs = _aref(shift); + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); +} + +sub setSystemIDsOfVendorOS +{ + my $confDB = shift; + my $vendorOSID = shift; + my $systemIDs = _aref(shift); + + my %seen; + my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; + return $confDB->{'meta-db'}->setSystemIDsOfVendorOS($vendorOSID, + \@uniqueSystemIDs); +} + +sub addSystemIDsToVendorOS +{ + my $confDB = shift; + my $vendorOSID = shift; + my $newSystemIDs = _aref(shift); + + my @systemIDs + = $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); + push @systemIDs, @$newSystemIDs; + return setSystemIDsOfVendorOS($confDB, $vendorOSID, \@systemIDs); +} + +sub removeSystemIDsFromVendorOS +{ + my $confDB = shift; + my $vendorOSID = shift; + my $removedSystemIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchSystemIDsOfVendorOS($vendorOSID); + return setSystemIDsOfVendorOS($confDB, $vendorOSID, \@systemIDs); +} + +sub addSystem +{ + my $confDB = shift; + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->addSystem($valRows); +} + +sub removeSystem +{ + my $confDB = shift; + my $systemIDs = _aref(shift); + + return $confDB->{'meta-db'}->removeSystem($systemIDs); +} + +sub changeSystem +{ + my $confDB = shift; + my $systemIDs = _aref(shift); + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->changeSystem($systemIDs, $valRows); +} + +sub setClientIDsOfSystem +{ + my $confDB = shift; + my $systemID = shift; + my $clientIDs = _aref(shift); + + my %seen; + my @uniqueClientIDs = grep { !$seen{$_}++ } @$clientIDs; + return $confDB->{'meta-db'}->setClientIDsOfSystem($systemID, + \@uniqueClientIDs); +} + +sub addClientIDsToSystem +{ + my $confDB = shift; + my $systemID = shift; + my $newClientIDs = _aref(shift); + + my @clientIDs = $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); + push @clientIDs, @$newClientIDs; + return setClientIDsOfSystem($confDB, $systemID, \@clientIDs); +} + +sub removeClientIDsFromSystem +{ + my $confDB = shift; + my $systemID = shift; + my $removedClientIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchClientIDsOfSystem($systemID); + return setClientIDsOfSystem($confDB, $systemID, \@clientIDs); +} + +sub setGroupIDsOfSystem +{ + my $confDB = shift; + my $systemID = shift; + my $groupIDs = _aref(shift); + + my %seen; + my @uniqueGroupIDs = grep { !$seen{$_}++ } @$groupIDs; + return $confDB->{'meta-db'}->setGroupIDsOfSystem($systemID, + \@uniqueGroupIDs); +} + +sub addGroupIDsToSystem +{ + my $confDB = shift; + my $systemID = shift; + my $newGroupIDs = _aref(shift); + + my @groupIDs = $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + push @groupIDs, @$newGroupIDs; + return setGroupIDsOfSystem($confDB, $systemID, \@groupIDs); +} + +sub removeGroupIDsFromSystem +{ + my $confDB = shift; + my $systemID = shift; + my $toBeRemovedGroupIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + return setGroupIDsOfSystem($confDB, $systemID, \@groupIDs); +} + +sub addClient +{ + my $confDB = shift; + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->addClient($valRows); +} + +sub removeClient +{ + my $confDB = shift; + my $clientIDs = _aref(shift); + + return $confDB->{'meta-db'}->removeClient($clientIDs); +} + +sub changeClient +{ + my $confDB = shift; + my $clientIDs = _aref(shift); + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->changeClient($clientIDs, $valRows); +} + +sub setSystemIDsOfClient +{ + my $confDB = shift; + my $clientID = shift; + my $systemIDs = _aref(shift); + + my %seen; + my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; + return $confDB->{'meta-db'}->setSystemIDsOfClient($clientID, + \@uniqueSystemIDs); +} + +sub addSystemIDsToClient +{ + my $confDB = shift; + my $clientID = shift; + my $newSystemIDs = _aref(shift); + + my @systemIDs = $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); + push @systemIDs, @$newSystemIDs; + return setSystemIDsOfClient($confDB, $clientID, \@systemIDs); +} + +sub removeSystemIDsFromClient +{ + my $confDB = shift; + my $clientID = shift; + my $removedSystemIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchSystemIDsOfClient($clientID); + return setSystemIDsOfClient($confDB, $clientID, \@systemIDs); +} + +sub setGroupIDsOfClient +{ + my $confDB = shift; + my $clientID = shift; + my $groupIDs = _aref(shift); + + my %seen; + my @uniqueGroupIDs = grep { !$seen{$_}++ } @$groupIDs; + return $confDB->{'meta-db'}->setGroupIDsOfClient($clientID, + \@uniqueGroupIDs); +} + +sub addGroupIDsToClient +{ + my $confDB = shift; + my $clientID = shift; + my $newGroupIDs = _aref(shift); + + my @groupIDs = $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); + push @groupIDs, @$newGroupIDs; + return setGroupIDsOfClient($confDB, $clientID, \@groupIDs); +} + +sub removeGroupIDsFromClient +{ + my $confDB = shift; + my $clientID = shift; + my $toBeRemovedGroupIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchGroupIDsOfClient($clientID); + return setGroupIDsOfClient($confDB, $clientID, \@groupIDs); +} + +sub addGroup +{ + my $confDB = shift; + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->addGroup($valRows); +} + +sub removeGroup +{ + my $confDB = shift; + my $groupIDs = _aref(shift); + + return $confDB->{'meta-db'}->removeGroup($groupIDs); +} + +sub changeGroup +{ + my $confDB = shift; + my $groupIDs = _aref(shift); + my $valRows = _aref(shift); + + return $confDB->{'meta-db'}->changeGroup($groupIDs, $valRows); +} + +sub setClientIDsOfGroup +{ + my $confDB = shift; + my $groupID = shift; + my $clientIDs = _aref(shift); + + my %seen; + my @uniqueClientIDs = grep { !$seen{$_}++ } @$clientIDs; + return $confDB->{'meta-db'}->setClientIDsOfGroup($groupID, + \@uniqueClientIDs); +} + +sub addClientIDsToGroup +{ + my $confDB = shift; + my $groupID = shift; + my $newClientIDs = _aref(shift); + + my @clientIDs = $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); + push @clientIDs, @$newClientIDs; + return setClientIDsOfGroup($confDB, $groupID, \@clientIDs); +} + +sub removeClientIDsFromGroup +{ + my $confDB = shift; + my $groupID = shift; + my $removedClientIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchClientIDsOfGroup($groupID); + return setClientIDsOfGroup($confDB, $groupID, \@clientIDs); +} + +sub setSystemIDsOfGroup +{ + my $confDB = shift; + my $groupID = shift; + my $systemIDs = _aref(shift); + + my %seen; + my @uniqueSystemIDs = grep { !$seen{$_}++ } @$systemIDs; + return $confDB->{'meta-db'}->setSystemIDsOfGroup($groupID, + \@uniqueSystemIDs); +} + +sub addSystemIDsToGroup +{ + my $confDB = shift; + my $groupID = shift; + my $newSystemIDs = _aref(shift); + + my @systemIDs = $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + push @systemIDs, @$newSystemIDs; + return setSystemIDsOfGroup($confDB, $groupID, \@systemIDs); +} + +sub removeSystemIDsFromGroup +{ + my $confDB = shift; + my $groupID = shift; + my $removedSystemIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs + = grep { !exists $toBeRemoved{$_} } + $confDB->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + return setSystemIDsOfGroup($confDB, $groupID, \@systemIDs); +} + +1; diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm new file mode 100644 index 00000000..477ced97 --- /dev/null +++ b/config-db/OpenSLX/DBSchema.pm @@ -0,0 +1,220 @@ +package OpenSLX::DBSchema; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 0.01; +@ISA = qw(Exporter); + +@EXPORT = qw( + $DbSchema %DbSchemaHistory +); + +use vars qw($DbSchema %DbSchemaHistory); + +# configurable attributes for system, client and group: +my @sharedAttributes = ( + 'attrDesktopSession:s.128', + 'attrDomainName:s.64', + 'attrDomainNameServers:s.128', + 'attrFontServers:s.128', + 'attrHwGraphic:s.64', + 'attrHwMonitor:s.64', + 'attrHwMouse:s.64', + 'attrLanguage:s.64', + 'attrLprServers:s.128', + 'attrNetbiosWorkgroup:s.64', + 'attrNisDomain:s.64', + 'attrNisServers:s.128', + 'attrNtpServers:s.128', + 'attrStartRwhod:b', + 'attrStartSnmp:b', + 'attrStartX:s.64', + 'attrStartXdmcp:s.64', + 'attrTexEnable:b', + 'attrVmware:b', +); + +################################################################################ +### DB-schema definition +### This hash-ref describes the current OpenSLX configuration database schema. +### Each table is defined by a list of column descriptions. +### A column description is simply the name of the column followed by ':' +### followed by the data type description. The following data types are +### currently supported: +### b => boolean (providing the values 1 and 0 only) +### i => integer (32-bit, signed) +### s.20 => string, followed by length argument (in this case: 20) +### pk => primary key (integer) +### fk => foreign key (integer) +################################################################################ + +$DbSchema = { + 'version' => $VERSION, + 'tables' => { + 'meta' => [ + # information about the database as such + 'schema_version:s.5', # schema-version currently implemented by DB + ], + 'vendor_os' => [ + # a vendor os describes a folder containing an operating system as provided by the + # vendor (a.k.a. unchanged and thus updatable) + 'id:pk', # primary key + 'name:s.32', # structured name of OS installation (e.g. suse-9.3-minimal, + # suse-9.3-kde, debian-3.1-ppc) + 'descr:s.1024', # internal description (optional, for admins) + 'path:s.256', # path to os filesystem root + ], + 'system' => [ + # a system describes one bootable instance of a vendor os + 'id:pk', # primary key + 'vendor_os_id:fk', # foreign key + 'name:s.32', # name used in filesystem and passed to kernel via cmdline arg + # (e.g.: suse-9.3-minimal, suse-9.3-minimal-nbd, ...) + 'label:s.128', # visible name (pxe-label) + 'descr:s.1024', # internal description (optional, for admins) + 'export_uri:s.256', # path to export (NDB-image or NFS-path) + 'tftp_uri:s.256', # path to tftp export directory + 'kernel:s.128', # name of kernel file + 'kernel_params:s.512', # kernel-param string for pxe + 'initramfs:s.128', # name of initrd file + 'hidden:b', # hidden systems won't be offered for booting + @sharedAttributes, + ], + 'client' => [ + # a client is a PC booting via network + 'id:pk', # primary key + 'name:s.128', # official name of PC (e.g. as given by sticker + # on case) + 'mac:s.20', # MAC of NIC used for booting + 'descr:s.1024', # internal description (for admins) + 'boot_type:s.20', # type of remote boot procedure (PXE, ...) + 'unbootable:b', # unbootable clients simply won't boot + @sharedAttributes, + ], + 'client_system_ref' => [ + # clients referring to the systems they should offer for booting + 'client_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + 'group' => [ + # a group encapsulates a set of clients as one entity, managing + # a group-specific attribute set. All the different attribute + # sets a client inherits via group membership are folded into + # one resulting attribute set with respect to each group's priority. + 'id:pk', # primary key + 'name:s.128', # name of group + 'descr:s.1024', # internal description (for admins) + 'priority:i', # priority, used for order in group-list + # (from 0-lowest to 10-highest) + @sharedAttributes, + ], + 'group_client_ref' => [ + # groups referring to their clients + 'group_id:fk', # foreign key + 'client_id:fk', # foreign key + ], + 'group_system_ref' => [ + # groups referring to the systems each of their clients should + # offer for booting + 'group_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, +}; + +################################################################################ +### DB-schema history +### This hash contains a description of all the different changes that have +### taken place on the schema. Each version contains a changeset (array) +### with the commands that take the schema from the last version to the +### current. +### The following 'cmd'-types are supported: +### add-table => creates a new table +### 'table' => contains the name of the new table +### 'cols' => contains a list of column descriptions +### 'vals' => optional, contains list of data hashes to be inserted +### into new table +### drop-table => drops an existing table +### 'table => contains the name of the table to be dropped +### rename-table => renames a table +### 'old-table' => contains the old name of the table +### 'new-table' => contains the new name of the table +### add-columns => adds columns to a table +### 'table' => the name of the table the columns should be added to +### 'new-cols' => contains a list of new column descriptions +### 'new-default-vals' => optional, a list of data hashes to be used +### as default values for the new columns +### 'cols' => contains a list of column descriptions +### drop-columns => drops columns from a table +### 'table' => the name of the table the columns should be dropped from +### 'col-changes' => a hash with changed column descriptions +### 'cols' => contains a full list of resulting column descriptions +################################################################################ + +%DbSchemaHistory = ( + '0.01' => [ + # the initial schema version simply adds a couple of tables: + { + 'cmd' => 'add-table', + 'table' => 'meta', + 'cols' => $DbSchema->{'tables'}->{'meta'}, + 'vals' => [ + { # add initial meta info + 'schema_version' => $DbSchema->{'version'}, + }, + ], + }, + { + 'cmd' => 'add-table', + 'table' => 'vendor_os', + 'cols' => $DbSchema->{'tables'}->{'vendor_os'}, + }, + { + 'cmd' => 'add-table', + 'table' => 'system', + 'cols' => $DbSchema->{'tables'}->{'system'}, + 'vals' => [ + { # add default system + 'id' => 0, + 'name' => '<<>>', + 'descr' => 'internal system that holds default values', + }, + ], + }, + { + 'cmd' => 'add-table', + 'table' => 'client', + 'cols' => $DbSchema->{'tables'}->{'client'}, + 'vals' => [ + { # add default client + 'id' => 0, + 'name' => '<<>>', + 'descr' => 'internal client that holds default values', + }, + ], + }, + { + 'cmd' => 'add-table', + 'table' => 'client_system_ref', + 'cols' => $DbSchema->{'tables'}->{'client_system_ref'}, + }, + { + 'cmd' => 'add-table', + 'table' => 'group', + 'cols' => $DbSchema->{'tables'}->{'group'}, + }, + { + 'cmd' => 'add-table', + 'table' => 'group_client_ref', + 'cols' => $DbSchema->{'tables'}->{'group_client_ref'}, + }, + { + 'cmd' => 'add-table', + 'table' => 'group_system_ref', + 'cols' => $DbSchema->{'tables'}->{'group_system_ref'}, + }, + ], +); + diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm new file mode 100644 index 00000000..d59ce888 --- /dev/null +++ b/config-db/OpenSLX/MetaDB/Base.pm @@ -0,0 +1,415 @@ +################################################################################ +# OpenSLX::MetaDB:Base - the base class for all MetaDB drivers +# +# Copyright 2006 by Oliver Tappe - all rights reserved. +# +# You may distribute this module under the terms of the GNU GPL v2. +################################################################################ + +package OpenSLX::MetaDB::Base; + +use vars qw($VERSION); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +=pod + +=head1 NAME + +OpenSLX::MetaDB::Base - the base class for all MetaDB drivers + +=head1 SYNOPSIS + + package OpenSLX::MetaDB::coolnewDB; + + use vars qw(@ISA $VERSION); + @ISA = ('OpenSLX::MetaDB::Base'); + $VERSION = 1.01; + + my $superVersion = $OpenSLX::MetaDB::Base::VERSION; + if ($superVersion < $VERSION) { + confess _tr('Unable to load module <%s> (Version <%s> required)', + 'OpenSLX::MetaDB::Base', $VERSION); + } + + use coolnewDB; + + sub new + { + my $class = shift; + my $self = {}; + return bless $self, $class; + } + + sub connectConfigDB + { + my $self = shift; + + my $dbName = $openslxConfig{'db-name'}; + vlog 1, "trying to connect to coolnewDB-database <$dbName>"; + $self->{'dbh'} = ... # get connection handle from coolnewDB + } + + sub disconnectConfigDB + { + my $self = shift; + + $self->{'dbh'}->disconnect; + } + + # override all methods of OpenSLX::MetaDB::Base in order to implement + # a full MetaDB driver + ... + +I> + +=head1 DESCRIPTION + +This class defines the MetaDB interface for the OpenSLX. + +Aim of the MetaDB abstraction is to make it possible to use a large set +of different databases (from CSV-files to a fullblown Oracle-installation) +transparently. + +While OpenSLX::ConfigDB represents the data layer to the outside world, each +implementation of OpenSLX::MetaDB::Base provides a backend for a specific database. + +This way, the different OpenSLX-scripts do not have to burden +themselves with any DB-specific details, they just request the data they want +from the ConfigDB-layer and that in turn creates and communicates with the +appropriate MetaDB driver in order to connect to the database and fetch and/or +change the data as instructed. + +The MetaDB interface contains of four different parts: + +=over + +=item - L (connection handling and utilities) + +=item - L (getting data) + +=item - L (adding, removing and changing data) + +=item - L (migrating between different DB-versions) + +=back + +In order to implement a MetaDB driver for a specific database, you need +to inherit from B and implement the full interface. As this +is quite some work, it might be wiser to actually inherit your driver from +B>, which is a default implementation for SQL databases. + +If there is a DBD-driver for the database your new MetaDB driver wants to talk +to then all you need to do is inherit from B and then +reimplement L> (and maybe some other methods in order to +improve efficiency). + +=cut + +################################################################################ +use strict; +use Carp; + +################################################################################ + +=head2 Basic Methods + +The following basic methods need to be implemented in a MetaDB driver: + +=over + +=cut + +################################################################################ +sub new +{ + confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; +} + +=item C + + $metaDB->connectConfigDB($dbParams); + +Tries to establish a connection to the DBMS that this MetaDB driver deals with. +The global configuration hash C<%config> contains further info about the +requested connection. When implementing this method, you may have to look at +the following entries in order to find out which database to connect to: + +=over + +=item C<$config{'db-basepath'}> + +basic path to openslx database, defaults to path of running script + +=item C<$config{'db-datadir'}> + +data folder created under db-basepath, default depends on db-type (many +DBMSs don't have such a folder, as they do not store the data in the +filesystem). + +=item C<$config{'db-spec'}> + +full specification of database, a special string defining the +precise database to connect to (this allows connecting to a database +that requires specifications which aren't cared for by the existing +C<%config>-entries). + +=item C<$config{'db-name'}> + +the precise name of the database that should be connected (defaults to 'openslx'). + +=back + +=cut + +sub connectConfigDB +{ +} + +sub disconnectConfigDB +{ +} + +sub quote +{ +} + +################################################################################ + +=back + +=head2 Data Access Methods + +The following methods need to be implemented in a MetaDB driver in order to +allow the user to access data: + +=over + +=cut + +################################################################################ + +=item C + + my $filter = { 'os_type' => 'LINUX' }; + my $resultCols = 'id,name,descr'; + my @systems = $metaDBH->fetchSystemsByFilter($filter, $resultCols); + +Fetches and returns information about all systems match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref defining the filter criteria to be applied. Each key corresponds +to a DB column and the (hash-)value contains the respective column value. [At a +later stage, this might be improved to support more structured approach to +filtering (with boolean operators and more)]. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + + +=back + +=cut + +sub fetchVendorOSesByFilter +{ +} + +sub fetchVendorOSesById +{ +} + +sub fetchSystemsByFilter +{ +} + +sub fetchSystemsById +{ +} + +sub fetchSystemIDsOfVendorOS +{ +} + +sub fetchSystemIDsOfClient +{ +} + +sub fetchSystemIDsOfGroup +{ +} + +sub fetchClientsByFilter +{ +} + +sub fetchClientsById +{ +} + +sub fetchClientIDsOfSystem +{ +} + +sub fetchClientIDsOfGroup +{ +} + +sub fetchGroupsByFilter +{ +} + +sub fetchGroupsById +{ +} + +sub fetchGroupIDsOfClient +{ +} + +sub fetchGroupIDsOfSystem +{ +} + +################################################################################ +### data manipulation interface +################################################################################ +sub generateNextIdForTable +{ # some DBs (CSV for instance) aren't able to generate any IDs, so we + # offer an alternative way (by pre-specifying IDs for INSERTs). + # NB: if this method is called without a tablename, it returns: + # 1 if this backend requires manual ID generation + # 0 if not. + return undef; +} + +sub addVendorOS +{ +} + +sub removeVendorOS +{ +} + +sub changeVendorOS +{ +} + +sub setSystemIDsOfVendorOS +{ +} + +sub addSystem +{ +} + +sub removeSystem +{ +} + +sub changeSystem +{ +} + +sub setClientIDsOfSystem +{ +} + +sub setGroupIDsOfSystem +{ +} + +sub addClient +{ +} + +sub removeClient +{ +} + +sub changeClient +{ +} + +sub setSystemIDsOfClient +{ +} + +sub setGroupIDsOfClient +{ +} + +sub addGroup +{ +} + +sub removeGroup +{ +} + +sub changeGroup +{ +} + +sub setClientIDsOfGroup +{ +} + +sub setSystemIDsOfGroup +{ +} + +################################################################################ +### schema related functions +################################################################################ +sub schemaFetchDBVersion +{ +} + +sub schemaConvertTypeDescrToNative +{ +} + +sub schemaDeclareTable +{ +} + +sub schemaAddTable +{ +} + +sub schemaDropTable +{ +} + +sub schemaRenameTable +{ +} + +sub schemaAddColumns +{ +} + +sub schemaDropColumns +{ +} + +sub schemaChangeColumns +{ +} + +=back + +=cut + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm new file mode 100644 index 00000000..b291e33d --- /dev/null +++ b/config-db/OpenSLX/MetaDB/CSV.pm @@ -0,0 +1,127 @@ +package OpenSLX::MetaDB::CSV; + +use vars qw(@ISA $VERSION); +@ISA = ('OpenSLX::MetaDB::DBI'); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This class provides a MetaDB backend for CSV files (CSV = comma separated +### files). +### - each table will be stored into a CSV file. +### - by default all files will be created inside a 'openslxdata-csv' directory. +################################################################################ +use strict; +use Carp; +use Fcntl qw(:DEFAULT :flock); +use OpenSLX::Basics; +use OpenSLX::MetaDB::DBI $VERSION; + +my $superVersion = $OpenSLX::MetaDB::DBI::VERSION; +if ($superVersion < $VERSION) { + confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', + 'OpenSLX::MetaDB::DBI', $VERSION, $superVersion); +} +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub connectConfigDB +{ + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + my $dbBasepath = $openslxConfig{'db-basepath'}; + my $dbDatadir = $openslxConfig{'db-datadir'} || 'openslxdata-csv'; + my $dbPath = "$dbBasepath/$dbDatadir"; + mkdir $dbPath unless -e $dbPath; + $dbSpec = "f_dir=$dbPath"; + } + vlog 1, "trying to connect to CSV-database <$dbSpec>"; + $self->{'dbh'} = DBI->connect("dbi:CSV:$dbSpec", undef, undef, + {PrintError => 0}) + or confess _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... + my $self = shift; + my $val = shift; + + $val =~ s[(['])][\\$1]go; + return "'$val'"; +} + +sub generateNextIdForTable +{ # CSV doesn't provide any mechanism to generate IDs, we just... + my $self = shift; + my $table = shift; + + return 1 unless defined $table; + + # now fetch the next ID from a table-specific file: + 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, $!); + flock(IDFILE, LOCK_EX) + or confess _tr(q[Can't lock ID-file <%s> (%s)], $idFile, $!); + my $nextID = ; + if (!$nextID) { + # no ID information available, we protect against users having + # deleted the ID-file by fetching the highest ID from the DB: + $nextID = 1+$self->_doSelect("SELECT max(id) AS id FROM $table", 'id'); + } + seek(IDFILE, 0, 0) + 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, $!); + close(IDFILE); + + return $nextID; +} + +sub schemaDeclareTable +{ # 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"}; +} + +sub schemaRenameTable +{ # renames corresponding id-file after renaming the table + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + + $self->schemaDeclareTable($newTable); + $self->SUPER::schemaRenameTable($oldTable, $newTable, @_); + my $dbh = $self->{'dbh'}; + rename "$dbh->{'f_dir'}/id-$oldTable", "$dbh->{'f_dir'}/id-$newTable"; +} + +sub schemaDropTable +{ # removes corresponding id-file after dropping the table + my $self = shift; + my $table = shift; + + $self->SUPER::schemaDropTable($table, @_); + my $dbh = $self->{'dbh'}; + unlink "$dbh->{'f_dir'}/id-$table"; +} + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm new file mode 100644 index 00000000..be47a061 --- /dev/null +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -0,0 +1,885 @@ +package OpenSLX::MetaDB::DBI; + +use vars qw(@ISA $VERSION); +@ISA = ('OpenSLX::MetaDB::Base'); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This class is the base for all DBI-related metaDB variants. +### It provides a default implementation for every method, such that +### each DB-specific implementation needs to override only the methods +### that require a different implementation than the one provided here. +### +### N.B.: In case you ask yourself why none of the SQL-statements in this +### file make use of SQL bind params (?), the answer is that at least +### one DBD-driver didn't like them at all. As the performance gains +### from bound params are not really necessary here, we simply do +### not use them. +################################################################################ + +use strict; +use Carp; +use DBI; +use OpenSLX::Basics; +use OpenSLX::MetaDB::Base; + +my $superVersion = $OpenSLX::MetaDB::Base::VERSION; +if ($superVersion < $VERSION) { + confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', + 'OpenSLX::MetaDB::Base', $VERSION, $superVersion); +} + +################################################################################ +### basics +################################################################################ +sub new +{ + confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; +} + +sub disconnectConfigDB +{ + my $self = shift; + + $self->{'dbh'}->disconnect; + $self->{'dbh'} = undef; +} + +sub quote +{ # default implementation quotes any given values through the DBD-driver + my $self = shift; + + return $self->{'dbh'}->quote(@_); +} + +################################################################################ +### data access functions +################################################################################ +sub _doSelect +{ + my $self = shift; + my $sql = shift; + my $resultCol = shift; + + my $dbh = $self->{'dbh'}; + + my $sth = $dbh->prepare($sql) + 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); + my (@vals, $row); + while($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 @vals; +} + +sub fetchVendorOSesByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $sql = "SELECT $resultCols FROM vendor_os"; + my $connector; + foreach my $col (keys %$filter) { + $connector = !defined $connector ? 'WHERE' : 'AND'; + $sql .= " $connector $col = '$filter->{$col}'"; + } + return $self->_doSelect($sql); +} + +sub fetchVendorOSesById +{ + my $self = shift; + my $id = shift; + my $resultCols = shift; + + return $self->fetchVendorOSesByFilter({'id' => $id}, $resultCols); +} + +sub fetchSystemsByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $sql = "SELECT $resultCols FROM system"; + my $connector; + foreach my $col (keys %$filter) { + $connector = !defined $connector ? 'WHERE' : 'AND'; + $sql .= " $connector $col = '$filter->{$col}'"; + } + return $self->_doSelect($sql); +} + +sub fetchSystemsById +{ + my $self = shift; + my $id = shift; + my $resultCols = shift; + + return $self->fetchSystemsByFilter({'id' => $id}, $resultCols); +} + +sub fetchSystemIDsOfVendorOS +{ + my $self = shift; + my $vendorOSID = shift; + + my $sql = qq[ + SELECT id FROM system WHERE vendor_os_id = '$vendorOSID' + ]; + return $self->_doSelect($sql, 'id'); +} + +sub fetchSystemIDsOfClient +{ + 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'); +} + +sub fetchSystemIDsOfGroup +{ + 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'); +} + +sub fetchClientsByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $sql = "SELECT $resultCols FROM client"; + my $connector; + foreach my $col (keys %$filter) { + $connector = !defined $connector ? 'WHERE' : 'AND'; + $sql .= " $connector $col = '$filter->{$col}'"; + } + return $self->_doSelect($sql); +} + +sub fetchClientsById +{ + my $self = shift; + my $id = shift; + my $resultCols = shift; + + return $self->fetchClientsByFilter({'id' => $id}, $resultCols); +} + +sub fetchClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + + my $sql = qq[ + SELECT client_id FROM client_system_ref WHERE system_id = '$systemID' + ]; + return $self->_doSelect($sql, 'system_id'); +} + +sub fetchClientIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + + my $sql = qq[ + SELECT client_id FROM group_client_ref WHERE group_id = '$groupID' + ]; + return $self->_doSelect($sql, 'system_id'); +} + +sub fetchGroupsByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $sql = "SELECT $resultCols FROM group"; + my $connector; + foreach my $col (keys %$filter) { + $connector = !defined $connector ? 'WHERE' : 'AND'; + $sql .= " $connector $col = '$filter->{$col}'"; + } + return $self->_doSelect($sql); +} + +sub fetchGroupsById +{ + my $self = shift; + my $id = shift; + my $resultCols = shift; + + return $self->fetchGroupsByFilter({'id' => $id}, $resultCols); +} + +sub fetchGroupIDsOfSystem +{ + 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'); +} + +sub fetchGroupIDsOfClient +{ + 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'); +} + +################################################################################ +### data manipulation functions +### +### N.B.: In case you ask yourself why none of the SQL-statements in +### the following functions make use of SQL-placeholders (?), the answer +### is that at least one DBD-driver didn't like them at all. +### As the improved performance gained from using placeholders is not +### really necessary here, we simply do not use them. +################################################################################ +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; + + 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 )"; + my $sth = $dbh->prepare($sql) + or confess _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); + vlog 3, $sql; + $sth->execute() + 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'); + 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 $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); + } + my $sth = $dbh->prepare($sql) + or confess _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); + vlog 3, $sql; + $sth->execute() + 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 $valRows = shift; + + my $dbh = $self->{'dbh'}; + my $valRow = (@$valRows)[0]; + return if !defined $valRow; + + my $idx = 0; + foreach my $valRow (@$valRows) { + 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; + my $sql = "UPDATE $table SET $cols"; + if (defined $id) { + $sql .= " WHERE id = ".$self->quote($id); + } + my $sth = $dbh->prepare($sql) + or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + vlog 3, $sql; + $sth->execute() + 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 $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); + } +} + +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' }]); + } +} + +sub addVendorOS +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('vendor_os', $valRows); +} + +sub removeVendorOS +{ + my $self = shift; + my $vendorOSIDs = shift; + + return $self->_doDelete('vendor_os', $vendorOSIDs); +} + +sub changeVendorOS +{ + my $self = shift; + my $vendorOSIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); +} + +sub setSystemIDsOfVendorOS +{ + my $self = shift; + my $vendorOSID = shift; + my $systemIDs = shift; + + my @currSystems = $self->fetchSystemsOfVendorOS($vendorOSID); + $self->_updateOneToManyRefAttr('system', $vendorOSID, $systemIDs, + 'vendor_os_id', \@currSystems); +} + +sub addSystem +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('system', $valRows); +} + +sub removeSystem +{ + my $self = shift; + my $systemIDs = shift; + + return $self->_doDelete('system', $systemIDs); +} + +sub changeSystem +{ + my $self = shift; + my $systemIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('system', $systemIDs, $valRows); +} + +sub setClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $clientIDs = shift; + + my @currClients = $self->fetchClientIDsOfSystem($systemID); + $self->_updateRefTable('client_system_ref', $systemID, $clientIDs, + 'system_id', 'client_id', \@currClients); +} + +sub setGroupIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $groupIDs = shift; + + my @currGroups = $self->fetchGroupIDsOfSystem($systemID); + $self->_updateRefTable('grop_system_ref', $systemID, $groupIDs, + 'system_id', 'group_id', \@currGroups); +} + +sub addClient +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('client', $valRows); +} + +sub removeClient +{ + my $self = shift; + my $clientIDs = shift; + + return $self->_doDelete('client', $clientIDs); +} + +sub changeClient +{ + my $self = shift; + my $clientIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('client', $clientIDs, $valRows); +} + +sub setSystemIDsOfClient +{ + 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); +} + +sub setGroupIDsOfClient +{ + 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); +} + +sub addGroup +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('group', $valRows); +} + +sub removeGroup +{ + my $self = shift; + my $groupIDs = shift; + + return $self->_doDelete('group', $groupIDs); +} + +sub changeGroup +{ + my $self = shift; + my $groupIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('group', $groupIDs, $valRows); +} + +sub setClientIDsOfGroup +{ + 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); +} + +sub setSystemIDsOfGroup +{ + 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); +} + +################################################################################ +### schema related functions +################################################################################ +sub _convertColDescrsToDBNativeString +{ + 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; + return $colDescrString; +} + +sub _convertColDescrsToColNames +{ + 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; + } + @$colDescrs; +} + +sub _convertColDescrsToColNamesString +{ + my $self = shift; + my $colDescrs = shift; + + return join ', ', $self->_convertColDescrsToColNames($colDescrs); +} + +sub schemaFetchDBVersion +{ + 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 undef unless defined $row; + # no entry in meta-table + return $row->{schema_version}; +} + +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 { + confess _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 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 + $self->_doInsert($table, $initialVals, $ignoreIDs); + } +} + +sub schemaDropTable +{ + 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 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 RENAME TO ' 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 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); +} + +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 RENAME TO ' 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 @colNames = $self->_convertColDescrsToColNames($colDescrs); + 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); +} + +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 DROP COLUMN ' 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); +} + +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 CHANGE COLUMN ' 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); +} + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm new file mode 100644 index 00000000..f40c618f --- /dev/null +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -0,0 +1,96 @@ +package OpenSLX::MetaDB::SQLite; + +use vars qw(@ISA $VERSION); +@ISA = ('OpenSLX::MetaDB::DBI'); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This class provides a MetaDB backend for SQLite databases. +### - by default the db will be created inside a 'openslxdata-sqlite' directory. +################################################################################ +use strict; +use Carp; +use OpenSLX::Basics; +use OpenSLX::MetaDB::DBI $VERSION; + +my $superVersion = $OpenSLX::MetaDB::DBI::VERSION; +if ($superVersion < $VERSION) { + confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', + 'OpenSLX::MetaDB::DBI', $VERSION, $superVersion); +} + +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub connectConfigDB +{ + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + my $dbBasepath = $openslxConfig{'db-basepath'}; + my $dbDatadir = $openslxConfig{'db-datadir'} || 'openslxdata-sqlite'; + my $dbPath = "$dbBasepath/$dbDatadir"; + mkdir $dbPath unless -e $dbPath; + my $dbName = $openslxConfig{'db-name'}; + $dbSpec = "dbname=$dbPath/$dbName"; + } + vlog 1, "trying to connect to SQLite-database <$dbSpec>"; + $self->{'dbh'} = DBI->connect("dbi:SQLite:$dbSpec", undef, undef, + {PrintError => 0}) + or confess _tr("Cannot connect to database <%s> (%s)"), + $dbSpec, $DBI::errstr; +} + +sub schemaRenameTable +{ + 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 $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); +} + +sub schemaAddColumns +{ + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); + vlog 1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd; + foreach my $colDescr (@$newColDescrs) { + 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); + } + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } +} + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/MetaDB/XML.pm b/config-db/OpenSLX/MetaDB/XML.pm new file mode 100644 index 00000000..14a12174 --- /dev/null +++ b/config-db/OpenSLX/MetaDB/XML.pm @@ -0,0 +1,186 @@ +package OpenSLX::MetaDB::XML; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 0.02; +@ISA = qw(Exporter); + +@EXPORT = qw( + &metaConnectConfigDB &metaDisconnectConfigDB + &metaAddSystem + &metaFetchDBSchemaVersion &metaSchemaAddTable &metaSchemaDeclareTable +); + +################################################################################ +### private stuff required by this module +################################################################################ +use Carp; +use DBI; +use OpenSLX::Base; + +################################################################################ +### basics +################################################################################ +sub metaConnectConfigDB +{ + my $dbParams = shift; + + my $dbPath = $dbParams->{'db-path'} + || '/home/zooey/Sources/openslx/config-db/datafiles-xml'; + mkdir $dbPath; + vlog 1, "trying to connect to XML-database <$dbPath>"; + my $dbh = DBI->connect("dbi:AnyData:", + undef, undef, + {PrintError => 0}) + or confess _tr("Cannot connect to database <%s> (%s)"), + $dbPath, $DBI::errstr; + my $metaDB = { + 'db-path' => $dbPath, + 'dbi-dbh' => $dbh, + }; + return $metaDB; +} + +sub metaDisconnectConfigDB +{ + my $metaDB = shift; + + my $dbh = $metaDB->{'dbi-dbh'}; + + $dbh->disconnect; +} + +################################################################################ +### data access functions +################################################################################ + +sub metaFetchSystemsById +{ +} + +################################################################################ +### data manipulation functions +################################################################################ + +sub metaDoInsert +{ + my $metaDB = shift; + my $table = shift; + my $valRows = shift; + + my $dbh = $metaDB->{'dbi-dbh'}; + my $valRow = (@$valRows)[0]; + return if !defined $valRow; + my $cols = join ', ', keys %$valRow; +print "cols: $cols\n"; + my $placeholders = join ', ', map { '?' } keys %$valRow; + my $sql = "INSERT INTO $table ( $cols ) VALUES ( $placeholders )"; + my $sth = $dbh->prepare($sql) + or confess _tr("Cannot insert into table <%s> (%s)", $table, $dbh->errstr); + foreach my $valRow (@$valRows) { + vlog 3, $sql; +my $vals = join ', ', values %$valRow; +print "vals: $vals\n"; + $sth->execute(values %$valRow) + or confess _tr("Cannot insert into table <%s> (%s)", + $table, $dbh->errstr); + } + +} + +sub metaAddSystem +{ + my $metaDB = shift; + my $valRows = shift; + + metaDoInsert($metaDB, 'system', $valRows); +} + +################################################################################ +### schema related functions +################################################################################ +sub metaFetchDBSchemaVersion +{ + my $metaDB = shift; + + my $dbh = $metaDB->{'dbi-dbh'}; + local $dbh->{RaiseError} = 0; + my $sth = $dbh->prepare('SELECT schema_version FROM meta') + or return 0; + my $row = $sth->fetchrow_hashref(); + return 0 unless defined $row; + # no entry in meta-table + return $row->{schema_version}; +} + +sub metaSchemaConvertTypeDescrToNative +{ + 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 { + confess _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } +} + +sub metaSchemaDeclareTable +{ + my $metaDB = shift; + my $table = shift; + my $colDescrs = shift; + + my $dbh = $metaDB->{'dbi-dbh'}; + my $dbPath = $metaDB->{'db-path'}; + my @colNames = map { my $col = $_; $col =~ s[:.+$][]; $col } @$colDescrs; + my $cols = join(', ', @colNames); + vlog 2, "declaring table <$table> as ($cols)..."; + $dbh->func( $table, 'XML', "$dbPath/${table}.xml", + { 'col_map' => [ @colNames ], 'pretty_print' => 'indented' }, + 'ad_catalog'); +} + +sub metaSchemaAddTable +{ + my $metaDB = shift; + my $changeDescr = shift; + + my $dbh = $metaDB->{'dbi-dbh'}; + my $table = $changeDescr->{table}; + vlog 2, "adding table <$table> to schema..."; + my $cols = + 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 ".metaSchemaConvertTypeDescrToNative($2); + } + @{$changeDescr->{cols}}; + my $sql = "CREATE TABLE $changeDescr->{table} ($cols)"; + vlog 3, $sql; + $dbh->do($sql) + or confess _tr("Cannot create table <%s> (%s)", $table, $dbh->errstr); + if (exists $changeDescr->{vals}) { + metaDoInsert($metaDB, $table, $changeDescr->{vals}); + } + +print "exporting...\n"; + $dbh->func( $table, 'XML', "$metaDB->{'db-path'}/$table.xml", + {'pretty_print' => 'indented'}, 'ad_export'); +print "exporting done\n"; +} + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm new file mode 100644 index 00000000..dc6ef7d0 --- /dev/null +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -0,0 +1,161 @@ +package OpenSLX::MetaDB::mysql; + +use vars qw(@ISA $VERSION); +@ISA = ('OpenSLX::MetaDB::DBI'); +$VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This class provides a MetaDB backend for mysql databases. +### - by default the db will be created inside a 'openslxdata-mysql' directory. +################################################################################ +use strict; +use Carp; +use OpenSLX::Basics; +use OpenSLX::MetaDB::DBI $VERSION; + +my $superVersion = $OpenSLX::MetaDB::DBI::VERSION; +if ($superVersion < $VERSION) { + confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)', + 'OpenSLX::MetaDB::DBI', $VERSION, $superVersion); +} + +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub connectConfigDB +{ + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + my $dbName = $openslxConfig{'db-name'}; + $dbSpec = "database=$dbName"; + } + 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 confess _tr("Cannot connect to database <%s> (%s)"), + $dbSpec, $DBI::errstr; +} + +sub schemaConvertTypeDescrToNative +{ + 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 AUTO_INCREMENT primary key'; + } elsif ($typeDescr eq 'fk') { + return 'integer'; + } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { + return "varchar($1)"; + } else { + confess _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } +} + +sub schemaRenameTable +{ + 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 $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); +} + +sub schemaAddColumns +{ + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + 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; + 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); + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } +} + +sub schemaDropColumns +{ + my $self = shift; + my $table = shift; + my $dropColNames = 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; + 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); +} + +sub schemaChangeColumns +{ + my $self = shift; + my $table = shift; + my $colChanges = 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; + 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); +} +1; \ No newline at end of file diff --git a/config-db/OpenSLX/Translations/de_de_utf_8.pm b/config-db/OpenSLX/Translations/de_de_utf_8.pm new file mode 100644 index 00000000..36a2a814 --- /dev/null +++ b/config-db/OpenSLX/Translations/de_de_utf_8.pm @@ -0,0 +1,27 @@ +package ODLX::Translations::de_de_utf_8; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 0.02; +@ISA = qw(Exporter); + +@EXPORT = qw(%translations); + +use vars qw(%translations); + +################################################################################ +### Translations +################################################################################ + +%translations = ( + 'Could not determine schema version of database' + => 'Die Version des Datenbank-Schemas konnte nicht bestimmt werden', + 'Unable to load DB-module <%s> (%s)' + => 'Kann DB-Modul <%s> nicht laden (%s)', + 'UnknownDbSchemaCommand' + => 'Unbekannter DbSchema-Befehl <%s> wird übergangen', +); + +1; \ No newline at end of file diff --git a/config-db/OpenSLX/Translations/posix.pm b/config-db/OpenSLX/Translations/posix.pm new file mode 100644 index 00000000..4b48cb55 --- /dev/null +++ b/config-db/OpenSLX/Translations/posix.pm @@ -0,0 +1,33 @@ +package ODLX::Translations::posix; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 0.02; +@ISA = qw(Exporter); + +@EXPORT = qw(%translations); + +use vars qw(%translations); + +################################################################################ +### Translations +################################################################################ + +%translations = ( + 'Could not determine schema version of database' + => 'Could not determine schema version of database', + 'Unable to load DB-module <%s> (%s)' + => 'Unable to load DB-module <%s> (%s)', + 'Unable to load module <%s> (Version <%s> required, but <%s> found)' + => 'Unable to load module <%s> (Version <%s> required, but <%s> found)', + 'UnknownDbSchemaCommand' + => 'Unknown DbSchema command <%s> found', + 'UnknownDbSchemaColumnDescr' + => 'Unknown DbSchema column description <%s> found', + 'UnknownDbSchemaTypeDescr' + => 'Unknown DbSchema type description <%s> found', +); + +1; \ No newline at end of file diff --git a/config-db/config-demuxer.pl b/config-db/config-demuxer.pl index c5fe2c39..47b78922 100755 --- a/config-db/config-demuxer.pl +++ b/config-db/config-demuxer.pl @@ -6,8 +6,8 @@ use lib $FindBin::Bin; use Getopt::Long qw(:config pass_through); -use ODLX::Basics; -use ODLX::ConfigDB; +use OpenSLX::Basics; +use OpenSLX::ConfigDB; my ( $dryRun, @@ -24,20 +24,20 @@ GetOptions( # would have been written ); -odlxInit(); +openslxInit(); -my $odlxDB = connectConfigDB(); +my $openslxDB = connectConfigDB(); -my $configPath = "$odlxConfig{'private-basepath'}/config"; +my $configPath = "$openslxConfig{'private-basepath'}/config"; if (!-d $configPath) { die _tr("Unable to access config-path '%s'!", $configPath); } -my $tempPath = "$odlxConfig{'temp-basepath'}/oslx-demuxer"; +my $tempPath = "$openslxConfig{'temp-basepath'}/oslx-demuxer"; mkdir $tempPath; if (!-d $tempPath) { die _tr("Unable to create or access temp-path '%s'!", $tempPath); } -my $exportPath = "$odlxConfig{'public-basepath'}/tftpboot"; +my $exportPath = "$openslxConfig{'public-basepath'}/tftpboot"; system("rm -rf $exportPath/client-conf/* $exportPath/pxe/pxelinux.cfg/*"); system("mkdir -p $exportPath/client-conf $exportPath/pxe/pxelinux.cfg"); if (!-d $exportPath) { @@ -50,7 +50,7 @@ if (!$dryRun) { writeConfigurations(); } -disconnectConfigDB($odlxDB); +disconnectConfigDB($openslxDB); system("rm -rf $tempPath"); @@ -178,9 +178,9 @@ sub writeSystemConfigurations sub initSystemConfigurations { - $defaultSystem = fetchSystemsByID($odlxDB, 0); + $defaultSystem = fetchSystemsByID($openslxDB, 0); - foreach my $s (fetchSystemsByFilter($odlxDB)) { + foreach my $s (fetchSystemsByFilter($openslxDB)) { next unless $s->{id} > 0; vlog 2, _tr('read system %d:%s...', $s->{id}, $s->{name}); @@ -215,19 +215,19 @@ sub linkClientToSystems sub demuxClientConfigurations { my %groups; - foreach my $g (fetchGroupsByFilter($odlxDB)) { + foreach my $g (fetchGroupsByFilter($openslxDB)) { vlog 2, _tr('read group %d:%s...', $g->{id}, $g->{name}); $groups{$g->{id}} = $g; } - $defaultClient = fetchClientsByID($odlxDB, 0); + $defaultClient = fetchClientsByID($openslxDB, 0); - foreach my $client (fetchClientsByFilter($odlxDB)) { + foreach my $client (fetchClientsByFilter($openslxDB)) { next unless $client->{id} > 0; vlog 2, _tr('read client %d:%s...', $client->{id}, $client->{name}); # add all systems directly linked to client: -my @sysIDs = fetchSystemIDsOfClient($odlxDB, $client->{id}); +my @sysIDs = fetchSystemIDsOfClient($openslxDB, $client->{id}); linkClientToSystems($client, @sysIDs ); @@ -238,12 +238,12 @@ my @sysIDs = fetchSystemIDsOfClient($odlxDB, $client->{id}); map { $groups{$_} } grep { exists $groups{$_} } # just to be safe: filter out unknown group-IDs - fetchGroupIDsOfClient($odlxDB, $client->{id}); + fetchGroupIDsOfClient($openslxDB, $client->{id}); foreach my $group (@clientGroups) { # fetch and add all systems that the client inherits from # the current group: linkClientToSystems($client, - fetchSystemIDsOfGroup($odlxDB, $group->{id})); + fetchSystemIDsOfGroup($openslxDB, $group->{id})); # merge configuration from this group into the current client: vlog 3, _tr('merging from group %d:%s...', $group->{id}, $group->{name}); diff --git a/config-db/testConfDB.pl b/config-db/testConfDB.pl index 9a400694..a1d9e5d3 100755 --- a/config-db/testConfDB.pl +++ b/config-db/testConfDB.pl @@ -4,24 +4,24 @@ use FindBin; use lib $FindBin::Bin; -use ODLX::Basics; -use ODLX::ConfigDB qw(:access :manipulation); +use OpenSLX::Basics; +use OpenSLX::ConfigDB qw(:access :manipulation); -odlxInit(); +openslxInit(); -my $odlxDB = connectConfigDB(); +my $openslxDB = connectConfigDB(); -addVendorOS($odlxDB, { +addVendorOS($openslxDB, { 'name' => "suse-93-minimal", 'descr' => "SuSE 9.3 minimale Installation", }); -addVendorOS($odlxDB, { +addVendorOS($openslxDB, { 'name' => "suse-93-KDE", 'descr' => "SuSE 9.3 grafische Installation mit KDE", }); -addVendorOS($odlxDB, { +addVendorOS($openslxDB, { 'name' => "debian-31", 'descr' => "Debian 3.1 Default-Installation", }); @@ -34,20 +34,20 @@ foreach my $id (1..10) { 'vendor_os_id' => 1 + $id % 3, }; } -addSystem($odlxDB, \@systems); +addSystem($openslxDB, \@systems); -removeSystem($odlxDB, [1,3,5,7,9,11,13,15,17,19] ); +removeSystem($openslxDB, [1,3,5,7,9,11,13,15,17,19] ); -changeSystem($odlxDB, [ 2 ], [ { 'name' => 'new name of 2'} ] ); +changeSystem($openslxDB, [ 2 ], [ { 'name' => 'new name of 2'} ] ); -changeSystem($odlxDB, [ 0 ], [ { 'attrStartX' => 'kde,gnome'} ] ); -changeSystem($odlxDB, [ 1,2,3 ], [ { 'attrHwMonitor' => '1280x1024'} ] ); -changeSystem($odlxDB, [ 4 ], [ { 'attrHwMonitor' => '800x600'} ] ); +changeSystem($openslxDB, [ 0 ], [ { 'attrStartX' => 'kde,gnome'} ] ); +changeSystem($openslxDB, [ 1,2,3 ], [ { 'attrHwMonitor' => '1280x1024'} ] ); +changeSystem($openslxDB, [ 4 ], [ { 'attrHwMonitor' => '800x600'} ] ); -changeSystem($odlxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); +changeSystem($openslxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); -my $metaDB = $odlxDB->{'meta-db'}; +my $metaDB = $openslxDB->{'meta-db'}; my $colDescrs = [ 'id:pk', 'name:s.30', @@ -124,70 +124,70 @@ foreach my $row (@rows) { $metaDB->schemaDropTable('test2'); -my $clientG01ID = addClient($odlxDB, { +my $clientG01ID = addClient($openslxDB, { 'name' => "PC-G-01", 'mac' => "00:14:85:80:00:35", 'boot_type' => 'pxe', }); -my $clientG02ID = addClient($odlxDB, { +my $clientG02ID = addClient($openslxDB, { 'name' => "PC-G-02", 'mac' => "00:14:85:80:00:36", 'boot_type' => 'pxe', }); -my $clientG03ID = addClient($odlxDB, { +my $clientG03ID = addClient($openslxDB, { 'name' => "PC-G-03", 'mac' => "00:14:85:80:00:37", 'boot_type' => 'pxe', }); -my $clientG04ID = addClient($odlxDB, { +my $clientG04ID = addClient($openslxDB, { 'name' => "PC-G-04", 'mac' => "00:14:85:80:00:38", 'boot_type' => 'pxe', 'unbootable' => 1, }); -my $clientF01ID = addClient($odlxDB, { +my $clientF01ID = addClient($openslxDB, { 'name' => "PC-F-01", 'mac' => "00:14:85:80:00:31", 'boot_type' => 'other', }); -my $clientF02ID = addClient($odlxDB, { +my $clientF02ID = addClient($openslxDB, { 'name' => "PC-F-02", 'mac' => "00:14:85:80:00:32", 'boot_type' => 'pxe', }); -my $clientF03ID = addClient($odlxDB, { +my $clientF03ID = addClient($openslxDB, { 'name' => "PC-F-03", 'mac' => "00:14:85:80:00:33", 'boot_type' => 'pxe', }); -addClientIDsToSystem($odlxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); +addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); -my $group1ID = addGroup($odlxDB, { +my $group1ID = addGroup($openslxDB, { 'name' => "Gell-PCs", 'descr' => "Gell-Threemansion PCs from 2002", 'attrHwMouse' => 'serial', }); -addClientIDsToGroup($odlxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); +addClientIDsToGroup($openslxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); -my $group2ID = addGroup($odlxDB, { +my $group2ID = addGroup($openslxDB, { 'name' => "Teacher-PCs", 'descr' => "all PCs sitting on teacher's desks", 'attrHwMonitor' => '1600x1200', }); -addClientIDsToGroup($odlxDB, $group2ID, [$clientG01ID, $clientF01ID]); -addSystemIDsToGroup($odlxDB, $group2ID, [2, 3]); +addClientIDsToGroup($openslxDB, $group2ID, [$clientG01ID, $clientF01ID]); +addSystemIDsToGroup($openslxDB, $group2ID, [2, 3]); -my $group3ID = addGroup($odlxDB, { +my $group3ID = addGroup($openslxDB, { 'name' => "PCs in room G", 'descr' => "all PCs of room 234", }); -addClientIDsToGroup($odlxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); +addClientIDsToGroup($openslxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); -disconnectConfigDB($odlxDB); +disconnectConfigDB($openslxDB); -- cgit v1.2.3-55-g7522