diff options
author | Oliver Tappe | 2006-08-21 14:03:33 +0200 |
---|---|---|
committer | Oliver Tappe | 2006-08-21 14:03:33 +0200 |
commit | 65556841d342d74059f7bc71e7496c64e3f23056 (patch) | |
tree | f375be4afcad2b83b1a7d2cce1e4db4f44b70192 /config-db/OpenSLX | |
parent | * replaced all occurrences of 'opendiskless' with 'openslx' (diff) | |
download | core-65556841d342d74059f7bc71e7496c64e3f23056.tar.gz core-65556841d342d74059f7bc71e7496c64e3f23056.tar.xz core-65556841d342d74059f7bc71e7496c64e3f23056.zip |
* 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
Diffstat (limited to 'config-db/OpenSLX')
-rw-r--r-- | config-db/OpenSLX/Basics.pm | 171 | ||||
-rw-r--r-- | config-db/OpenSLX/ConfigDB.pm | 667 | ||||
-rw-r--r-- | config-db/OpenSLX/DBSchema.pm | 220 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/Base.pm | 415 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/CSV.pm | 127 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/DBI.pm | 885 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/SQLite.pm | 96 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/XML.pm | 186 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/mysql.pm | 161 | ||||
-rw-r--r-- | config-db/OpenSLX/Translations/de_de_utf_8.pm | 27 | ||||
-rw-r--r-- | config-db/OpenSLX/Translations/posix.pm | 33 |
11 files changed, 2988 insertions, 0 deletions
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(<CONFIG>) { + 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' => '<<<default>>>', + 'descr' => 'internal system that holds default values', + }, + ], + }, + { + 'cmd' => 'add-table', + 'table' => 'client', + 'cols' => $DbSchema->{'tables'}->{'client'}, + 'vals' => [ + { # add default client + 'id' => 0, + 'name' => '<<<default>>>', + '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<The synopsis above outlines a class that implements a +MetaDB driver for the (imaginary) database B<coolnewDB>> + +=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<basic methods> (connection handling and utilities) + +=item - L<data access methods> (getting data) + +=item - L<data manipulation methods> (adding, removing and changing data) + +=item - L<schema related methods> (migrating between different DB-versions) + +=back + +In order to implement a MetaDB driver for a specific database, you need +to inherit from B<OpenSLX::MetaDB::Base> and implement the full interface. As this +is quite some work, it might be wiser to actually inherit your driver from +B<L<OpenSLX::MetaDB::DBI|OpenSLX::MetaDB::DBI>>, 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<OpenSLX::MetaDB::DBI> and then +reimplement L<C<connectConfigDB>> (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<connectConfigDB> + + $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<fetchSystemsByFilter> + + 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 = <IDFILE>; + 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 <old> RENAME TO <new>' SQL-command (which + # is much more efficient). + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog 1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $newTable ($colDescrString)"; + vlog 3, $sql; + $dbh->do($sql) + or 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 <old> RENAME TO <new>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $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 <old> DROP COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $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 <old> CHANGE COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $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 |