diff options
author | Sebastian Schmelzer | 2010-09-02 17:50:49 +0200 |
---|---|---|
committer | Sebastian Schmelzer | 2010-09-02 17:50:49 +0200 |
commit | 416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5 (patch) | |
tree | 4715f7d742fec50931017f38fe6ff0a89d4ceccc /config-db/OpenSLX | |
parent | Fix for the problem reported on the list (sed filter forgotten for the (diff) | |
download | core-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.tar.gz core-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.tar.xz core-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.zip |
change dir structure
Diffstat (limited to 'config-db/OpenSLX')
-rw-r--r-- | config-db/OpenSLX/AttributeRoster.pm | 537 | ||||
-rw-r--r-- | config-db/OpenSLX/ConfigDB.pm | 3190 | ||||
-rw-r--r-- | config-db/OpenSLX/ConfigExport/DHCP/ISC.pm | 45 | ||||
-rw-r--r-- | config-db/OpenSLX/DBSchema.pm | 832 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/Base.pm | 1220 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/DBI.pm | 1540 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/SQLite.pm | 130 | ||||
-rw-r--r-- | config-db/OpenSLX/MetaDB/mysql.pm | 179 |
8 files changed, 0 insertions, 7673 deletions
diff --git a/config-db/OpenSLX/AttributeRoster.pm b/config-db/OpenSLX/AttributeRoster.pm deleted file mode 100644 index 88d6295f..00000000 --- a/config-db/OpenSLX/AttributeRoster.pm +++ /dev/null @@ -1,537 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# AttributeRoster.pm -# - provides information about all available attributes -# ----------------------------------------------------------------------------- -package OpenSLX::AttributeRoster; - -use strict; -use warnings; - -use Digest::MD5 qw(md5_hex); - -use OpenSLX::Basics; -use OpenSLX::OSPlugin::Engine; -use OpenSLX::OSPlugin::Roster; -use OpenSLX::Utils; - -my %AttributeInfo; - -#=item C<_init()> -# -#Integrates info about all known attributes (from core and from the plugins) -#into one big hash. -#Returns info about all attributes. -# -#=cut -# -sub _init -{ - my $class = shift; - - # set core attributes - %AttributeInfo = ( - 'automnt_dir' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'automnt_src' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'boot_type' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - Selects the boot technology for this client. - Currently the following boot types are supported: - pxe (is the default) - uses PXE to boot client over LAN - preboot - generates a set of images (see preboot_media) that can - be used to remotely boot the systems referred to by - this client - pbs - preboot server (experimental) - End-of-Here - content_regex => qr{^(pxe|preboot|pbs)$}, - content_descr => '"pxe" or "preboot"', - default => 'pxe', - }, - 'boot_uri' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - specifies the wget(able) address of the remote bootloader - archive that shall be loaded from the preboot environment - End-of-Here - content_regex => undef, - content_descr => 'an uri supported by wget', - default => '', - }, - 'country' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'de', - }, - 'hidden' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - specifies whether or not this system is offered for booting - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '0: system is bootable - 1: system is hidden', - default => '0', - }, - 'kernel_params' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - params to build kernel cmdline for this system - End-of-Here - content_regex => undef, - content_descr => 'kernel cmdline fragment', - default => 'quiet', - }, - 'kernel_params_client' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - client-specific params for kernel cmdline - End-of-Here - content_regex => undef, - content_descr => 'kernel cmdline fragment', - default => '', - }, - 'preboot_media' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - List of preboot media supported by this client. - Currently the following preboot media are supported: - cd - generates a bootable CD-image that can be used to - remotely boot the systems referred to by this client - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'preboot_server' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!experimental!! specifies location of openslx-preboot-server - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_fsmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of filesystem kernel modules to load - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_miscmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of miscellaneous kernel modules to load - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_nicmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of network card modules to load - End-of-Here - content_regex => qr{^\s*([-\w]+\s*)*$}, - content_descr => 'a space-separated list of NIC modules', - default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', - }, - 'hw_local_disk' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - how to handle local disk deploament - no/slxonly/all - End-of-Here - content_regex => undef, - content_descr => 'how to handle local disk (no/slxonly/all)', - default => 'all', - }, - 'scratch' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'start_atd' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_cron' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_dreshal' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_ntp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'initial', - }, - 'start_nfsv4' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_snmp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_sshd' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'timezone' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - textual timezone (e.g. 'Europe/Berlin') - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'Europe/Berlin', - }, - 'unbootable' => { - applies_to_systems => 0, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - specifies whether or not this client is allowed to boot - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '0: client can boot - 1: client is blocked', - default => '0', - }, - ); - - # and add all plugin attributes, too - OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); - - return 1; -} - -=item C<getAttrInfo()> - -Returns info about all attributes. - -=over - -=item Return Value - -An hash-ref with info about all known attributes. - -=back - -=cut - -sub getAttrInfo -{ - my $class = shift; - my $params = shift || {}; - - $class->_init() if !%AttributeInfo; - - if (defined $params->{name}) { - my $attrInfo = $AttributeInfo{$params->{name}}; - return if !defined $attrInfo; - return { $params->{name} => $AttributeInfo{$params->{name}} }; - } - elsif (defined $params->{scope}) { - my %MatchingAttributeInfo; - my $selectedScope = lc($params->{scope}); - foreach my $attr (keys %AttributeInfo) { - my $attrScope = ''; - if ($attr =~ m{^(.+?)::}) { - $attrScope = lc($1); - } - if ((!$attrScope && $selectedScope eq 'core') - || $attrScope eq $selectedScope) { - $MatchingAttributeInfo{$attr} = $AttributeInfo{$attr}; - } - } - return \%MatchingAttributeInfo; - } - - return \%AttributeInfo; -} - -=item C<getStage3Attrs()> - -Returns the stage3 attribute names (which apply to systems or clients). - -=over - -=item Return Value - -An array of attribute names. - -=back - -=cut - -sub getStage3Attrs -{ - my $class = shift; - - $class->_init() if !%AttributeInfo; - - return - grep { - $AttributeInfo{$_}->{applies_to_systems} - || $AttributeInfo{$_}->{applies_to_client} - } - keys %AttributeInfo -} - -=item C<getSystemAttrs()> - -Returns the attribute names that apply to systems. - -=over - -=item Return Value - -An array of attribute names. - -=back - -=cut - -sub getSystemAttrs -{ - my $class = shift; - - $class->_init() if !%AttributeInfo; - - return - grep { $AttributeInfo{$_}->{"applies_to_systems"} } - keys %AttributeInfo -} - -=item C<getClientAttrs()> - -Returns the attribute names that apply to clients. - -=over - -=item Return Value - -An array of attribute names. - -=back - -=cut - -sub getClientAttrs -{ - my $class = shift; - - $class->_init() if !%AttributeInfo; - - return - grep { $AttributeInfo{$_}->{"applies_to_clients"} } - keys %AttributeInfo -} - -=item C<findProblematicValues()> - -Checks if the given stage3 attribute values are allowed (and make sense). - -This method returns an array-ref of problems found. If there were no problems, -this methods returns undef. - -=cut - -sub findProblematicValues -{ - my $class = shift; - my $stage3Attrs = shift || {}; - my $vendorOSName = shift; - my $installedPlugins = shift; - - $class->_init() if !%AttributeInfo; - - my @problems; - - my %attrsByPlugin; - foreach my $key (sort keys %{$stage3Attrs}) { - my $value = $stage3Attrs->{$key}; - if ($key =~ m{^(.+)::.+?$}) { - my $pluginName = $1; - if ($installedPlugins - && !grep { $_->{plugin_name} eq $pluginName } @$installedPlugins) { - # avoid checking attributes of plugins that are not installed - next; - } - $attrsByPlugin{$pluginName} ||= {}; - $attrsByPlugin{$pluginName}->{$key} = $value; - } - - # undefined values are always allowed - next if !defined $value; - - # check the value against the regex of the attribute (if any) - my $attrInfo = $AttributeInfo{$key}; - if (!$attrInfo) { - push @problems, _tr('attribute "%s" is unknown!', $key); - next; - } - my $regex = $attrInfo->{content_regex}; - if ($regex && $value !~ $regex) { - push @problems, _tr( - "the value '%s' for attribute %s is not allowed.\nAllowed values are: %s", - $value, $key, $attrInfo->{content_descr} - ); - } - } - - # if no vendorOS-name has been provided or there are no plugins installed, - # we can't do any further checks - if ($vendorOSName && $installedPlugins) { - # now give each installed plugin a chance to check it's own attributes - # by itself - foreach my $pluginInfo ( - sort { $a->{plugin_name} cmp $b->{plugin_name} } @$installedPlugins - ) { - my $pluginName = $pluginInfo->{plugin_name}; - vlog 2, "checking attrs of plugin: $pluginName\n"; - # create & start OSPlugin-engine for vendor-OS and current plugin - my $engine = OpenSLX::OSPlugin::Engine->new; - if (!$engine->initialize($pluginName, $vendorOSName)) { - warn _tr( - 'unable to create engine for plugin "%s"!', $pluginName - ); - next; - } - $engine->checkStage3AttrValues( - $attrsByPlugin{$pluginName}, \@problems - ); - } - } - - return if !@problems; - - return \@problems; -} - -=item C<computeMD5HashOverAllAttrs()> - -Returns a MD5 hash representing the list of all attributes (including plugins). - -=cut - -sub computeMD5HashOverAllAttrs -{ - my $class = shift; - - $class->_init() if !%AttributeInfo; - - my %attrNames; - @attrNames{keys %AttributeInfo} = (); - - my $pluginInfo = OpenSLX::OSPlugin::Roster->getAvailablePlugins(); - if ($pluginInfo) { - foreach my $pluginName (sort keys %$pluginInfo) { - my $attrInfo - = OpenSLX::OSPlugin::Roster->getPluginAttrInfo($pluginName); - @attrNames{keys %$attrInfo} = (); - } - } - - my $attrNamesAsString = join ',', sort keys %attrNames; - - return md5_hex($attrNamesAsString); -} - -1; diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm deleted file mode 100644 index 89011246..00000000 --- a/config-db/OpenSLX/ConfigDB.pm +++ /dev/null @@ -1,3190 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -package OpenSLX::ConfigDB; - -use strict; -use warnings; - -our (@ISA, @EXPORT_OK, %EXPORT_TAGS, $VERSION); -$VERSION = 1; # API-version - -use Clone qw(clone); -use File::Basename; - -use Exporter; -@ISA = qw(Exporter); - -=pod - -=head1 NAME - -OpenSLX::ConfigDB - the configuration database API class for OpenSLX - -=head1 SYNOPSIS - - use OpenSLX::ConfigDB; - - openslxInit(); - - my $openslxDB = OpenSLX::ConfigDB->new(); - $openslxDB->connect(); - - # fetch a client by name: - my $defaultClient = $openslxDB->fetchClientByFilter({'name' => '<<<default>>>'}) - - # fetch all systems: - my @systems = $openslxDB->fetchSystemByFilter(); - -=head1 DESCRIPTION - -This class defines the OpenSLX API to the config database (the data layer to -the outside world). - -The ConfigDB interface contains of five different parts: - -=over - -=item - L<basic methods> (connection handling) - -=item - L<data access methods> (getting data) - -=item - L<data manipulation methods> (adding, removing and changing data) - -=item - L<data aggregation methods> (getting info about the resulting -configurations after mixing individual client-, group- and system- -configurations). - -=item - L<suppport functions> (useful helpers) - -=back - -=head1 Special Concepts - -=over - -=item C<Filters> - -A filter is a hash-ref defining the filter criteria to be applied to a database -query. Each key of the filter corresponds to a DB column and the (hash-)value -contains the respective column value. - -[At a later stage, this will be improved to support a more structured approach -to filtering (with boolean operators and hierarchical expressions)]. - -=back - -=cut - -my @supportExports = qw( - mergeAttributes pushAttributes - externalIDForSystem externalIDForClient externalConfigNameForClient - generatePlaceholderFor -); - -@EXPORT_OK = (@supportExports); -%EXPORT_TAGS = ('support' => [@supportExports],); - -use OpenSLX::AttributeRoster; -use OpenSLX::Basics; -use OpenSLX::DBSchema; -use OpenSLX::OSPlugin::Roster; -use OpenSLX::Utils; - -=head1 Methods - -=head2 Basic Methods - -=over - -=cut - -=item C<new()> - -Returns an object representing a database handle to the config database. - -=cut - -sub new -{ - my $class = shift; - - my $self = { - 'db-schema' => OpenSLX::DBSchema->new, - }; - - return bless $self, $class; -} - -=item C<connect()> - -Tries to establish a connection to the database specified via the db-... -settings. -The global configuration hash C<%openslxConfig> 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<$openslxConfig{'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<$openslxConfig{'db-name'}> - -The precise name of the database that should be connected (defaults to 'openslx'). - -=back - -=cut - -sub connect ## no critic (ProhibitBuiltinHomonyms) -{ - my $self = shift; - 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 $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; - my $dbModule = "OpenSLX::MetaDB::$dbType"; - unless (eval { require $dbModuleName } ) { - if ($! == 2) { - die _tr( - "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", - $dbModuleName - ); - } else { - die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); - } - } - my $metaDB = $dbModule->new(); - if (!$metaDB->connect($dbParams)) { - warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); - warn _tr("These DB-modules seem to work ok:"); - foreach my $dbMod ('mysql', 'SQLite') { - my $fullDbModName = "DBD/$dbMod.pm"; - if (eval { require $fullDbModName }) { - vlog(0, "\t$dbMod\n"); - } - } - die _tr( - 'Please use slxsettings if you want to switch to another db-type.' - ); - } - - $self->{'db-type'} = $dbType; - $self->{'meta-db'} = $metaDB; - - $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self) - or die _tr('unable to check/update DB schema!'); - - # check if any attributes or plugins have been added/removed since - # last DB-session and bring the DB up-to-date, if so - my $pluginInfoHashVal - = OpenSLX::AttributeRoster->computeMD5HashOverAllAttrs(); - my $pluginInfoHashValInDB = $metaDB->schemaFetchPluginInfoHashVal() || ''; - vlog(1, "plugin-info-hashes: $pluginInfoHashVal <=> $pluginInfoHashValInDB"); - if ($pluginInfoHashValInDB ne $pluginInfoHashVal) { - $self->cleanupAnyInconsistencies(); - return if !$metaDB->schemaSetPluginInfoHashVal($pluginInfoHashVal); - } - - return 1; -} - -=item C<disconnect()> - -Tears down the connection to the database and cleans up. - -=cut - -sub disconnect -{ - my $self = shift; - - $self->{'meta-db'}->disconnect(); - - return 1; -} - -=item C<startTransaction()> - -Opens a database transaction - most useful if you want to make sure a couple of -changes apply as a whole or not at all. - -=cut - -sub startTransaction -{ - my $self = shift; - - $self->{'meta-db'}->startTransaction(); - - return 1; -} - -=item C<commitTransaction()> - -Commits a database transaction - so all changes done inside of this transaction -will be applied to the database. - -=cut - -sub commitTransaction -{ - my $self = shift; - - $self->{'meta-db'}->commitTransaction(); - - return 1; -} - -=item C<rollbackTransaction()> - -Revokes a database transaction - so all changes done inside of this transaction -will be undone. - -=cut - -sub rollbackTransaction -{ - my $self = shift; - - $self->{'meta-db'}->rollbackTransaction(); - - return 1; -} - -=item C<cleanupAnyInconsistencies()> - -Looks for any inconsistencies (stale references, references to non-existing -plugins, ...) and removes them from the DB. - -=cut - -sub cleanupAnyInconsistencies -{ - my $self = shift; - - $self->synchronizeAttributesWithDB(); - - return if !$self->_removeStaleSystemAttributes(); - return if !$self->_removeStaleGroupAttributes(); - return if !$self->_removeStaleClientAttributes(); - return if !$self->_removeStaleVendorOSAttributes(); - - return 1; -} - -=item C<synchronizeAttributesWithDB()> - -Makes sure that all known attributes are referenced by the default system -(and no unknown ones). - -Additionally, all systems, groups and clients can be checked and get their -stale attributes removed, too. - -=cut - -sub synchronizeAttributesWithDB -{ - my $self = shift; - - my $defaultSystem = $self->fetchSystemByID(0); - return if !$defaultSystem; - - # fetch all known attributes from attribute roster and merge these - # into the existing attributes of the default system and client - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - - # add new system attributes to default system - my @newSystemAttrs - = grep { - $attrInfo->{$_}->{applies_to_systems} - && !exists $defaultSystem->{attrs}->{$_} - } keys %{$attrInfo}; - foreach my $attr (@newSystemAttrs) { - $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; - } - - # remove unknown system attributes from default system - my @unknownSystemAttrs - = grep { - !exists $attrInfo->{$_} - || !$attrInfo->{$_}->{applies_to_systems} - } keys %{$defaultSystem->{attrs}}; - foreach my $unknownAttr (@unknownSystemAttrs) { - delete $defaultSystem->{attrs}->{$unknownAttr}; - } - - # now write back the updated default system if necessary - if (@newSystemAttrs || @unknownSystemAttrs) { - return if !$self->changeSystem(0, $defaultSystem); - } - - my $defaultClient = $self->fetchClientByID(0); - return if !$defaultClient; - - # add new client attributes to default client (deal only with - # attributes that are client-only) - my @newClientAttrs - = grep { - $attrInfo->{$_}->{applies_to_clients} - && !$attrInfo->{$_}->{applies_to_systems} - && !exists $defaultClient->{attrs}->{$_} - } keys %{$attrInfo}; - foreach my $attr (@newClientAttrs) { - $defaultClient->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; - } - - # remove unknown client attributes from default client (deal only with - # attributes that are client-only) - my @unknownClientAttrs - = grep { - !exists $attrInfo->{$_} - || !$attrInfo->{$_}->{applies_to_clients} - || $attrInfo->{$_}->{applies_to_systems} - } keys %{$defaultClient->{attrs}}; - foreach my $unknownAttr (@unknownClientAttrs) { - delete $defaultClient->{attrs}->{$unknownAttr}; - } - - # now write back the updated default client if necessary - if (@newClientAttrs || @unknownClientAttrs) { - return if !$self->changeClient(0, $defaultClient); - } - - return 1; -} - -=item C<_removeStaleSystemAttributes()> - -Removes any stale attributes from every system. - -=cut - -sub _removeStaleSystemAttributes -{ - my $self = shift; - - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - - my @systems = $self->fetchSystemByFilter(); - foreach my $system (@systems) { - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$system->{attrs}}; - if (@unknownAttrs) { - foreach my $unknownAttr (@unknownAttrs) { - delete $system->{attrs}->{$unknownAttr}; - } - return if !$self->changeSystem($system->{id}, $system); - } - } - - return 1; -} - -=item C<_removeStaleGroupAttributes()> - -Removes any stale attributes from every group. - -=cut - -sub _removeStaleGroupAttributes -{ - my $self = shift; - - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - - my @groups = $self->fetchGroupByFilter(); - foreach my $group (@groups) { - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$group->{attrs}}; - if (@unknownAttrs) { - foreach my $unknownAttr (@unknownAttrs) { - delete $group->{attrs}->{$unknownAttr}; - } - return if !$self->changeGroup($group->{id}, $group); - } - } - - return 1; -} - -=item C<_removeStaleClientAttributes()> - -Removes any stale attributes from every client. - -=cut - -sub _removeStaleClientAttributes -{ - my $self = shift; - - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - - my @clients = $self->fetchClientByFilter(); - foreach my $client (@clients) { - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$client->{attrs}}; - if (@unknownAttrs) { - foreach my $unknownAttr (@unknownAttrs) { - delete $client->{attrs}->{$unknownAttr}; - } - return if !$self->changeClient($client->{id}, $client); - } - } - - return 1; -} - -=item C<_removeStaleVendorOSAttributes()> - -Removes any stale attributes from every vendor-OS. - -=cut - -sub _removeStaleVendorOSAttributes -{ - my $self = shift; - - my @vendorOSes = $self->fetchVendorOSByFilter(); - foreach my $vendorOS (@vendorOSes) { - my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); - foreach my $plugin (@installedPlugins) { - my $pluginName = $plugin->{plugin_name}; - my $attrInfo - = OpenSLX::OSPlugin::Roster->getPluginAttrInfo($pluginName); - if ($attrInfo) { - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$plugin->{attrs}}; - if (@unknownAttrs) { - foreach my $unknownAttr (@unknownAttrs) { - delete $plugin->{attrs}->{$unknownAttr}; - } - return if !$self->addInstalledPlugin( - $vendorOS->{id}, $pluginName, $plugin->{attrs} - ); - } - } - else { - $self->removeInstalledPlugin($vendorOS->{id}, $pluginName); - } - } - } - - return 1; -} - -=back - -=head2 Data Access Methods - -=over - -=cut - -=item C<getColumnsOfTable($tableName)> - -Returns the names of the columns of the given table. - -=over - -=item Param C<tableName> - -The name of the DB-table whose columns you'd like to retrieve. - -=item Return Value - -An array of column names. - -=back - -=cut - -sub getColumnsOfTable -{ - my $self = shift; - my $tableName = shift; - - return $self->{'db-schema'}->getColumnsOfTable($tableName); -} - -=item C<fetchVendorOSByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all vendor-OSes that match the given -filter. - -=over - -=item Param C<filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchVendorOSByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - my @vendorOS - = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); - - return wantarray() ? @vendorOS : shift @vendorOS; -} - -=item C<fetchVendorOSByID(@$ids, [$resultCols])> - -Fetches and returns information the vendor-OSes with the given IDs. - -=over - -=item Param C<ids> - -An array of the vendor-OS-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchVendorOSByID -{ - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; - - my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); - - return wantarray() ? @vendorOS : shift @vendorOS; -} - -=item C<fetchInstalledPlugins($vendorOSID)> - -Returns the names of all plugins that have been installed into the given -vendor-OS. - -=over - -=item Param C<vendorOSID> - -The id of the vendor-OS whose plugins you are interested in - -=item Param C<pluginName> [Optional] - -The name of a specific plugin you are interested in - -=item Return Value - -An array with the plugin names. - -=back - -=cut - -sub fetchInstalledPlugins -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - - $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); -} - -=item C<fetchExportByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all exports that match the given -filter. - -=over - -=item Param C<filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchExportByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); - - return wantarray() ? @exports : shift @exports; -} - -=item C<fetchExportByID(@$ids, [$resultCols])> - -Fetches and returns information the exports with the given IDs. - -=over - -=item Param C<ids> - -An array of the export-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchExportByID -{ - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; - - my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); - - return wantarray() ? @exports : shift @exports; -} - -=item C<fetchExportIDsOfVendorOS($id)> - -Fetches the IDs of all exports that make use of the vendor-OS with the given ID. - -=over - -=item Param C<id> - -ID of the vendor-OS whose exports shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=cut - -sub fetchExportIDsOfVendorOS -{ - my $self = shift; - my $vendorOSID = shift; - - return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); -} - -=item C<fetchGlobalInfo($id)> - -Fetches the global info element specified by the given ID. - -=over - -=item Param C<id> - -The name of the global info value you are interested in. - -=item Return Value - -The value of the requested global info. - -=back - -=cut - -sub fetchGlobalInfo -{ - my $self = shift; - my $id = shift; - - return $self->{'meta-db'}->fetchGlobalInfo($id); -} - -=item C<fetchSystemByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all systems that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 Param C<$attrFilter> [Optional] - -A hash-ref containing the filter criteria that shall be applied against -attributes. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchSystemByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - my @systems = $self->{'meta-db'}->fetchSystemByFilter( - $filter, $resultCols, $attrFilter - ); - - # unless specific result cols have been given, we mix in the attributes - # of each system, too: - if (!defined $resultCols) { - foreach my $system (@systems) { - $system->{attrs} - = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); - } - } - - return wantarray() ? @systems : shift @systems; -} - -=item C<fetchSystemByID(@$ids, [$resultCols])> - -Fetches and returns information the systems with the given IDs. - -=over - -=item Param C<ids> - -An array of the system-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchSystemByID -{ - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; - - my @systems = $self->{'meta-db'}->fetchSystemByID($ids, $resultCols); - - # unless specific result cols have been given, we mix in the attributes - # of each system, too: - if (!defined $resultCols) { - foreach my $system (@systems) { - $system->{attrs} - = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); - } - } - - return wantarray() ? @systems : shift @systems; -} - -=item C<fetchSystemIDsOfExport($id)> - -Fetches the IDs of all systems that make use of the export with the given ID. - -=over - -=item Param C<id> - -ID of the export whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=cut - -sub fetchSystemIDsOfExport -{ - my $self = shift; - my $exportID = shift; - - return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); -} - -=item C<fetchSystemIDsOfClient($id)> - -Fetches the IDs of all systems that are used by the client with the given -ID. - -=over - -=item Param C<id> - -ID of the client whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=cut - -sub fetchSystemIDsOfClient -{ - my $self = shift; - my $clientID = shift; - - return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); -} - -=item C<fetchSystemIDsOfGroup($id)> - -Fetches the IDs of all systems that are part of the group with the given -ID. - -=over - -=item Param C<id> - -ID of the group whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=cut - -sub fetchSystemIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - - return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); -} - -=item C<fetchClientByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all clients that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 fetchClientByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - my @clients = $self->{'meta-db'}->fetchClientByFilter( - $filter, $resultCols, $attrFilter - ); - - # unless specific result cols have been given, we mix in the attributes - # of each client, too: - if (!defined $resultCols) { - foreach my $client (@clients) { - $client->{attrs} - = $self->{'meta-db'}->fetchClientAttrs($client->{id}); - } - } - - return wantarray() ? @clients : shift @clients; -} - -=item C<fetchClientByID(@$ids, [$resultCols])> - -Fetches and returns information the clients with the given IDs. - -=over - -=item Param C<ids> - -An array of the client-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchClientByID -{ - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; - - my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); - - # unless specific result cols have been given, we mix in the attributes - # of each client, too: - if (!defined $resultCols) { - foreach my $client (@clients) { - $client->{attrs} - = $self->{'meta-db'}->fetchClientAttrs($client->{id}); - } - } - - return wantarray() ? @clients : shift @clients; -} - -=item C<fetchClientIDsOfSystem($id)> - -Fetches the IDs of all clients that make use of the system with the given -ID. - -=over - -=item Param C<id> - -ID of the system whose clients shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - -=cut - -sub fetchClientIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - - return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); -} - -=item C<fetchClientIDsOfGroup($id)> - -Fetches the IDs of all clients that are part of the group with the given -ID. - -=over - -=item Param C<id> - -ID of the group whose clients shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - -=cut - -sub fetchClientIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - - return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); -} - -=item C<fetchGroupByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all groups that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 fetchGroupByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - my @groups = $self->{'meta-db'}->fetchGroupByFilter( - $filter, $resultCols, $attrFilter - ); - - # unless specific result cols have been given, we mix in the attributes - # of each group, too: - if (!defined $resultCols) { - foreach my $group (@groups) { - $group->{attrs} - = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); - } - } - - return wantarray() ? @groups : shift @groups; -} - -=item C<fetchGroupByID(@$ids, [$resultCols])> - -Fetches and returns information the groups with the given IDs. - -=over - -=item Param C<ids> - -An array of the group-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=cut - -sub fetchGroupByID -{ - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; - - my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); - - # unless specific result cols have been given, we mix in the attributes - # of each group, too: - if (!defined $resultCols) { - foreach my $group (@groups) { - $group->{attrs} - = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); - } - } - - return wantarray() ? @groups : shift @groups; -} - -=item C<fetchGroupIDsOfSystem($id)> - -Fetches the IDs of all groups that contain the system with the given -ID. - -=over - -=item Param C<id> - -ID of the system whose groups shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - -=cut - -sub fetchGroupIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - - return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); -} - -=item C<fetchGroupIDsOfClient($id)> - -Fetches the IDs of all groups that contain the client with the given -ID. - -=over - -=item Param C<id> - -ID of the client whose groups shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - -=cut - -sub fetchGroupIDsOfClient -{ - my $self = shift; - my $clientID = shift; - - return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); -} - -=back - -=head2 Data Manipulation Methods - -=over - -=item C<addVendorOS(@$valRows)> - -Adds one or more vendor-OS to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new vendor-OS(es). - -=item Return Value - -The IDs of the new vendor-OS(es), C<undef> if the creation failed. - -=back - -=cut - -sub addVendorOS -{ - my $self = shift; - my $valRows = _aref(shift); - - _checkCols($valRows, 'vendor_os', 'name'); - - my @IDs = $self->{'meta-db'}->addVendorOS($valRows); - return wantarray() ? @IDs : $IDs[0]; -} - -=item C<removeVendorOS(@$vendorOSIDs)> - -Removes one or more vendor-OS from the database. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the vendor-OSes that shall be removed. - -=item Return Value - -C<1> if the vendorOS(es) could be removed, C<undef> if not. - -=back - -=cut - -sub removeVendorOS -{ - my $self = shift; - my $vendorOSIDs = _aref(shift); - - # drop all installed plugins before removing the vendor-OS - foreach my $vendorOSID (@$vendorOSIDs) { - my @installedPlugins - = $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID); - foreach my $plugin (@installedPlugins) { - my $pluginName = $plugin->{plugin_name}; - $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); - } - } - return $self->{'meta-db'}->removeVendorOS($vendorOSIDs); -} - -=item C<changeVendorOS(@$vendorOSIDs, @$valRows)> - -Changes the data of one or more vendor-OS. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the vendor-OSes that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the vendor-OS(es). - -=item Return Value - -C<1> if the vendorOS(es) could be changed, C<undef> if not. - -=back - -=cut - -sub changeVendorOS -{ - my $self = shift; - my $vendorOSIDs = _aref(shift); - my $valRows = _aref(shift); - - return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); -} - -=item C<addInstalledPlugin($vendorOSID, $pluginName)> - -Adds a freshly installed plugin to a vendor-OS. - -=over - -=item Param C<vendorOSID> - -The id of the vendor-OS the given plugin has been installed into - -=item Param C<pluginName> - -The name of the plugin that has been installed - -=item Return Value - -The ID of the new reference entry, C<undef> if the creation failed. - -=back - -=cut - -sub addInstalledPlugin -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $pluginAttrs = shift || {}; - - return $self->{'meta-db'}->addInstalledPlugin( - $vendorOSID, $pluginName, $pluginAttrs - ); -} - -=item C<removeInstalledPlugin($vendorOSID, $pluginName)> - -Removes a uninstalled plugin for a vendor-OS. - -=over - -=item Param C<vendorOSID> - -The id of the vendor-OS the given plugin has been uninstalled from - -=item Param C<pluginName> - -The name of the plugin that has been uninstalled - -=item Return Value - -1 if it worked, C<undef> if it didn't. - -=back - -=cut - -sub removeInstalledPlugin -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - - return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); -} - -=item C<addExport(@$valRows)> - -Adds one or more export to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new export(s). - -=item Return Value - -The IDs of the new export(s), C<undef> if the creation failed. - -=back - -=cut - -sub addExport -{ - my $self = shift; - my $valRows = _aref(shift); - - _checkCols($valRows, 'export', qw(name vendor_os_id type)); - - my @IDs = $self->{'meta-db'}->addExport($valRows); - return wantarray() ? @IDs : $IDs[0]; -} - -=item C<removeExport(@$exportIDs)> - -Removes one or more export from the database. - -=over - -=item Param C<exportIDs> - -An array-ref containing the IDs of the exports that shall be removed. - -=item Return Value - -C<1> if the export(s) could be removed, C<undef> if not. - -=back - -=cut - -sub removeExport -{ - my $self = shift; - my $exportIDs = _aref(shift); - - return $self->{'meta-db'}->removeExport($exportIDs); -} - -=item C<changeExport(@$exportIDs, @$valRows)> - -Changes the data of one or more export. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the exports that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the export(s). - -=item Return Value - -C<1> if the export(s) could be changed, C<undef> if not. - -=back - -=cut - -sub changeExport -{ - my $self = shift; - my $exportIDs = _aref(shift); - my $valRows = _aref(shift); - - return $self->{'meta-db'}->changeExport($exportIDs, $valRows); -} - -=item C<incrementGlobalCounter($counterName)> - -Increments the global counter of the given name and returns the *old* value. - -=over - -=item Param C<counterName> - -The name of the global counter that shall be bumped. - -=item Return Value - -The value the global counter had before it was incremented. - -=back - -=cut - -sub incrementGlobalCounter -{ - my $self = shift; - my $counterName = shift; - - $self->startTransaction(); - my $value = $self->fetchGlobalInfo($counterName); - return unless defined $value; - my $newValue = $value + 1; - $self->changeGlobalInfo($counterName, $newValue); - $self->commitTransaction(); - - return $value; -} - -=item C<changeGlobalInfo($id, $value)> - -Sets the global info element specified by the given ID to the given value. - -=over - -=item Param C<id> - -The ID specifying the global info you'd like to change. - -=item Param C<value> - -The new value for the global info element. - -=item Return Value - -The value the global counter had before it was incremented. - -=back - -=cut - -sub changeGlobalInfo -{ - my $self = shift; - my $id = shift; - my $value = shift; - - return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); - - return $self->{'meta-db'}->changeGlobalInfo($id, $value); -} - -=item C<addSystem(@$valRows)> - -Adds one or more systems to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new system(s). - -=item Return Value - -The IDs of the new system(s), C<undef> if the creation failed. - -=back - -=cut - -sub addSystem -{ - my $self = shift; - my $inValRows = _aref(shift); - - _checkCols($inValRows, 'system', qw(name export_id)); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - foreach my $valRow (@$valRows) { - if (!$valRow->{kernel}) { - $valRow->{kernel} = 'vmlinuz'; - vlog( - 1, - _tr( - "setting kernel of system '%s' to 'vmlinuz'!", - $valRow->{name} - ) - ); - } - if (!$valRow->{label}) { - $valRow->{label} = $valRow->{name}; - } - } - - my @IDs = $self->{'meta-db'}->addSystem($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; -} - -=item C<removeSystem(@$systemIDs)> - -Removes one or more systems from the database. - -=over - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be removed. - -=item Return Value - -C<1> if the system(s) could be removed, C<undef> if not. - -=back - -=cut - -sub removeSystem -{ - my $self = shift; - my $systemIDs = _aref(shift); - - foreach my $system (@$systemIDs) { - $self->setGroupIDsOfSystem($system); - $self->setClientIDsOfSystem($system); - } - - return $self->{'meta-db'}->removeSystem($systemIDs); -} - -=item C<changeSystem(@$systemIDs, @$valRows)> - -Changes the data of one or more systems. - -=over - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the system(s). - -=item Return Value - -C<1> if the system(s) could be changed, C<undef> if not. - -=back - -=cut - -sub changeSystem -{ - my $self = shift; - my $systemIDs = _aref(shift); - my $inValRows = _aref(shift); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); -} - -#=item C<setSystemAttr($systemID, $attrName, $attrValue)> -# -#Sets a value for an attribute of the given system. If the system already -#has a value for this attribute, it will be overwritten. -# -#=over -# -#=item Param C<systemID> -# -#The ID of the system whose attribute shall be changed. -# -#=item Param C<attrName> -# -#The name of the attribute to change. -# -#=item Param C<attrValue> -# -#The new value for the attribute. -# -#=item Return Value -# -#C<1> if the attribute could be set, C<undef> if not. -# -#=back -# -#=cut -# -#sub setSystemAttr -#{ -# my $self = shift; -# my $systemID = shift; -# my $attrName = shift; -# my $attrValue = shift; -# -# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); -#} - -=item C<setClientIDsOfSystem($systemID, @$clientIDs)> - -Specifies all clients that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system whose clients you'd like to specify. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be connected to the -system. - -=item Return Value - -C<1> if the system/client references could be set, C<undef> if not. - -=back - -=cut - -sub setClientIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $clientIDs = _aref(shift); - - # associating a client to the default system makes no sense - return 0 if $systemID == 0; - - my @uniqueClientIDs = _unique(@$clientIDs); - - return $self->{'meta-db'}->setClientIDsOfSystem( - $systemID, \@uniqueClientIDs - ); -} - -=item C<addClientIDsToSystem($systemID, @$clientIDs)> - -Add one or more clients to the set that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system that you wish to add the clients to. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the new clients that shall be added to the -system. - -=item Return Value - -C<1> if the system/client references could be set, C<undef> if not. - -=back - -=cut - -sub addClientIDsToSystem -{ - my $self = shift; - my $systemID = shift; - my $newClientIDs = _aref(shift); - - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - push @clientIDs, @$newClientIDs; - - return $self->setClientIDsOfSystem($systemID, \@clientIDs); -} - -=item C<removeClientIDsFromSystem($systemID, @$clientIDs)> - -Removes the connection between the given clients and the given system. - -=over - -=item Param C<systemID> - -The ID of the system you'd like to remove groups from. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be removed from the -system. - -=item Return Value - -C<1> if the system/client references could be set, C<undef> if not. - -=back - -=cut - -sub removeClientIDsFromSystem -{ - my $self = shift; - my $systemID = shift; - my $removedClientIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - - return $self->setClientIDsOfSystem($systemID, \@clientIDs); -} - -=item C<setGroupIDsOfSystem($systemID, @$groupIDs)> - -Specifies all groups that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system whose groups you'd like to specify. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be connected to the -system. - -=item Return Value - -C<1> if the system/group references could be set, C<undef> if not. - -=back - -=cut - -sub setGroupIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $groupIDs = _aref(shift); - - # associating a group to the default system makes no sense - return 0 if $systemID == 0; - - my @uniqueGroupIDs = _unique(@$groupIDs); - - return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); -} - -=item C<addGroupIDsToSystem($systemID, @$groupIDs)> - -Add one or more groups to the set that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system that you wish to add the groups to. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the new groups that shall be added to the -system. - -=item Return Value - -C<1> if the system/group references could be set, C<undef> if not. - -=back - -=cut - -sub addGroupIDsToSystem -{ - my $self = shift; - my $systemID = shift; - my $newGroupIDs = _aref(shift); - - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - push @groupIDs, @$newGroupIDs; - - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); -} - -=item C<removeGroupIDsFromSystem($systemID, @$groupIDs)> - -Removes the connection between the given groups and the given system. - -=over - -=item Param C<systemID> - -The ID of the system you'd like to remove groups from. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be removed from the -system. - -=item Return Value - -C<1> if the system/group references could be set, C<undef> if not. - -=back - -=cut - -sub removeGroupIDsFromSystem -{ - my $self = shift; - my $systemID = shift; - my $toBeRemovedGroupIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); -} - -=item C<addClient(@$valRows)> - -Adds one or more clients to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new client(s). - -=item Return Value - -The IDs of the new client(s), C<undef> if the creation failed. - -=back - -=cut - -sub addClient -{ - my $self = shift; - my $inValRows = _aref(shift); - - _checkCols($inValRows, 'client', qw(name mac)); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; -} - -=item C<removeClient(@$clientIDs)> - -Removes one or more clients from the database. - -=over - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be removed. - -=item Return Value - -C<1> if the client(s) could be removed, C<undef> if not. - -=back - -=cut - -sub removeClient -{ - my $self = shift; - my $clientIDs = _aref(shift); - - foreach my $client (@$clientIDs) { - $self->setGroupIDsOfClient($client); - $self->setSystemIDsOfClient($client); - } - - return $self->{'meta-db'}->removeClient($clientIDs); -} - -=item C<changeClient(@$clientIDs, @$valRows)> - -Changes the data of one or more clients. - -=over - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the client(s). - -=item Return Value - -C<1> if the client(s) could be changed, C<undef> if not. - -=back - -=cut - -sub changeClient -{ - my $self = shift; - my $clientIDs = _aref(shift); - my $inValRows = _aref(shift); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); -} - -#=item C<setClientAttr($clientID, $attrName, $attrValue)> -# -#Sets a value for an attribute of the given client. If the client already -#has a value for this attribute, it will be overwritten. -# -#=over -# -#=item Param C<clientID> -# -#The ID of the client whose attribute shall be changed. -# -#=item Param C<attrName> -# -#The name of the attribute to change. -# -#=item Param C<attrValue> -# -#The new value for the attribute. -# -#=item Return Value -# -#C<1> if the attribute could be set, C<undef> if not. -# -#=back -# -#=cut -# -#sub setClientAttr -#{ -# my $self = shift; -# my $clientID = shift; -# my $attrName = shift; -# my $attrValue = shift; -# -# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); -#} - -=item C<setSystemIDsOfClient($clientID, @$systemIDs)> - -Specifies all systems that should be offered for booting by the given client. - -=over - -=item Param C<clientID> - -The ID of the client whose systems you'd like to specify. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be connected to the -client. - -=item Return Value - -C<1> if the client/system references could be set, C<undef> if not. - -=back - -=cut - -sub setSystemIDsOfClient -{ - my $self = shift; - my $clientID = shift; - my $systemIDs = _aref(shift); - - # filter out the default system, as no client should be associated to it - my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); - - return $self->{'meta-db'}->setSystemIDsOfClient( - $clientID, \@uniqueSystemIDs - ); -} - -=item C<addSystemIDsToClient($clientID, @$systemIDs)> - -Adds some systems to the set that should be offered for booting by the given client. - -=over - -=item Param C<clientID> - -The ID of the client to which you'd like to add systems to. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the new systems that shall be added to the -client. - -=item Return Value - -C<1> if the client/system references could be set, C<undef> if not. - -=back - -=cut - -sub addSystemIDsToClient -{ - my $self = shift; - my $clientID = shift; - my $newSystemIDs = _aref(shift); - - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - push @systemIDs, @$newSystemIDs; - - return $self->setSystemIDsOfClient($clientID, \@systemIDs); -} - -=item C<removeSystemIDsFromClient($clientID, @$systemIDs)> - -Removes some systems from the set that should be offered for booting by the given client. - -=over - -=item Param C<clientID> - -The ID of the client to which you'd like to remove systems from. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be removed from the -client. - -=item Return Value - -C<1> if the client/system references could be set, C<undef> if not. - -=back - -=cut - -sub removeSystemIDsFromClient -{ - my $self = shift; - my $clientID = shift; - my $removedSystemIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - - return $self->setSystemIDsOfClient($clientID, \@systemIDs); -} - -=item C<setGroupIDsOfClient($clientID, @$groupIDs)> - -Specifies all groups that the given client shall be part of. - -=over - -=item Param C<clientID> - -The ID of the client whose groups you'd like to specify. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that the client should be part of. - -=item Return Value - -C<1> if the client/group references could be set, C<undef> if not. - -=back - -=cut - -sub setGroupIDsOfClient -{ - my $self = shift; - my $clientID = shift; - my $groupIDs = _aref(shift); - - my @uniqueGroupIDs = _unique(@$groupIDs); - - return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); -} - -=item C<addGroupIDsToClient($clientID, @$groupIDs)> - -Adds the given client to the given groups. - -=over - -=item Param C<clientID> - -The ID of the client that you'd like to add to the given groups. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be added to the -client. - -=item Return Value - -C<1> if the client/group references could be set, C<undef> if not. - -=back - -=cut - -sub addGroupIDsToClient -{ - my $self = shift; - my $clientID = shift; - my $newGroupIDs = _aref(shift); - - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - push @groupIDs, @$newGroupIDs; - - return $self->setGroupIDsOfClient($clientID, \@groupIDs); -} - -=item C<removeGroupsIDsFromClient($clientID, @$groupIDs)> - -Removes the given client from the given groups. - -=over - -=item Param C<clientID> - -The ID of the client that you'd like to remove from the given groups. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be removed from the -client. - -=item Return Value - -C<1> if the client/group references could be set, C<undef> if not. - -=back - -=cut - -sub removeGroupIDsFromClient -{ - my $self = shift; - my $clientID = shift; - my $toBeRemovedGroupIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - - return $self->setGroupIDsOfClient($clientID, \@groupIDs); -} - -=item C<addGroup(@$valRows)> - -Adds one or more groups to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new group(s). - -=item Return Value - -The IDs of the new group(s), C<undef> if the creation failed. - -=back - -=cut - -sub addGroup -{ - my $self = shift; - my $inValRows = _aref(shift); - - _checkCols($inValRows, 'group', qw(name)); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - foreach my $valRow (@$valRows) { - if (!defined $valRow->{priority}) { - $valRow->{priority} = '50'; - } - } - my @IDs = $self->{'meta-db'}->addGroup($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; -} - -=item C<removeGroup(@$groupIDs)> - -Removes one or more groups from the database. - -=over - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be removed. - -=item Return Value - -C<1> if the group(s) could be removed, C<undef> if not. - -=back - -=cut - -sub removeGroup -{ - my $self = shift; - my $groupIDs = _aref(shift); - - foreach my $group (@$groupIDs) { - $self->setSystemIDsOfGroup($group, []); - $self->setClientIDsOfGroup($group, []); - } - - return $self->{'meta-db'}->removeGroup($groupIDs); -} - -#=item C<setGroupAttr($groupID, $attrName, $attrValue)> -# -#Sets a value for an attribute of the given group. If the group already -#has a value for this attribute, it will be overwritten. -# -#=over -# -#=item Param C<groupID> -# -#The ID of the group whose attribute shall be changed. -# -#=item Param C<attrName> -# -#The name of the attribute to change. -# -#=item Param C<attrValue> -# -#The new value for the attribute. -# -#=item Return Value -# -#C<1> if the attribute could be set, C<undef> if not. -# -#=back -# -#=cut -# -#sub setGroupAttr -#{ -# my $self = shift; -# my $groupID = shift; -# my $attrName = shift; -# my $attrValue = shift; -# -# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); -#} - -=item C<changeGroup(@$groupIDs, @$valRows)> - -Changes the data of one or more groups. - -=over - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the group(s). - -=item Return Value - -C<1> if the group(s) could be changed, C<undef> if not. - -=back - -=cut - -sub changeGroup -{ - my $self = shift; - my $groupIDs = _aref(shift); - my $inValRows = _aref(shift); - - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - - return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); -} - -=item C<setClientIDsOfGroup($groupID, @$clientIDs)> - -Specifies all clients that should be part of the given group. - -=over - -=item Param C<groupID> - -The ID of the group whose clients you'd like to specify. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be part of the group. - -=item Return Value - -C<1> if the group/client references could be set, C<undef> if not. - -=back - -=cut - -sub setClientIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - my $clientIDs = _aref(shift); - - my @uniqueClientIDs = _unique(@$clientIDs); - - return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); -} - -=item C<addClientIDsToGroup($groupID, @$clientIDs)> - -Add some clients to the given group. - -=over - -=item Param C<groupID> - -The ID of the group to which you'd like to add clients. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be added. - -=item Return Value - -C<1> if the group/client references could be set, C<undef> if not. - -=back - -=cut - -sub addClientIDsToGroup -{ - my $self = shift; - my $groupID = shift; - my $newClientIDs = _aref(shift); - - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - push @clientIDs, @$newClientIDs; - - return $self->setClientIDsOfGroup($groupID, \@clientIDs); -} - -=item C<removeClientIDsFromGroup($groupID, @$clientIDs)> - -Remove some clients from the given group. - -=over - -=item Param C<groupID> - -The ID of the group from which you'd like to remove clients. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be removed. - -=item Return Value - -C<1> if the group/client references could be set, C<undef> if not. - -=back - -=cut - -sub removeClientIDsFromGroup -{ - my $self = shift; - my $groupID = shift; - my $removedClientIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - - return $self->setClientIDsOfGroup($groupID, \@clientIDs); -} - -=item C<setSystemIDsOfGroup($groupID, @$systemIDs)> - -Specifies all systems that should be offered for booting by the given group. - -=over - -=item Param C<groupID> - -The ID of the group whose systems you'd like to specify. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be connected to the -group. - -=item Return Value - -C<1> if the group/system references could be set, C<undef> if not. - -=back - -=cut - -sub setSystemIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - my $systemIDs = _aref(shift); - - # filter out the default system, as no group should be associated to it - my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); - - return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); -} - -=item C<addSystemIDsToGroup($groupID, @$systemIDs)> - -Adds some systems to the set that should be offered for booting by the given group. - -=over - -=item Param C<groupID> - -The ID of the group to which you'd like to add systems. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be added. - -=item Return Value - -C<1> if the group/system references could be set, C<undef> if not. - -=back - -=cut - -sub addSystemIDsToGroup -{ - my $self = shift; - my $groupID = shift; - my $newSystemIDs = _aref(shift); - - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - push @systemIDs, @$newSystemIDs; - - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); -} - -=item C<removeSystemIDsFromGroup($groupID, @$systemIDs)> - -Removes some systems from the set that should be offered for booting by the given group. - -=over - -=item Param C<groupID> - -The ID of the group from which you'd like to remove systems. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be removed. - -=item Return Value - -C<1> if the group/system references could be set, C<undef> if not. - -=back - -=cut - -sub removeSystemIDsFromGroup -{ - my $self = shift; - my $groupID = shift; - my $removedSystemIDs = _aref(shift); - - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); -} - -=item C<emptyDatabase()> - -Removes all data from the database - the tables stay, but they will be empty. - -=over - -=item Return Value - -none - -=back - -=cut - -sub emptyDatabase -{ # clears all user-data from the database - my $self = shift; - - my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); - $self->removeGroup(\@groupIDs); - - my @clientIDs = map { $_->{id} } - grep { $_->{name} ne '<<<default>>>' } $self->fetchClientByFilter(); - $self->removeClient(\@clientIDs); - - my @sysIDs = map { $_->{id} } - grep { $_->{name} ne '<<<default>>>' } $self->fetchSystemByFilter(); - $self->removeSystem(\@sysIDs); - - my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); - $self->removeExport(\@exportIDs); - - my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); - $self->removeVendorOS(\@vendorOSIDs); - - return 1; -} - -=back - -=head2 Data Aggregation Methods - -=over - -=item C<mergeDefaultAttributesIntoSystem($system)> - -merges vendor-OS-specific plugin attributes and default system attributes into -the given system hash, and pushes the default client attributes on top of that. - -=over - -=item Param C<system> - -The system whose attributes shall be merged into (completed). - -=item Return Value - -none - -=back - -=cut - -sub mergeDefaultAttributesIntoSystem -{ - my $self = shift; - my $system = shift; - my $installedPlugins = shift; - my $originInfo = shift; - - # merge any attributes found in the plugins that are installed into - # the vendor-OS: - if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { - for my $plugin (@$installedPlugins) { - mergeAttributes($system, $plugin, $originInfo, 'vendor-OS'); - } - - # the above will have merged stage1 attributes, too, so we remove - # these from the resulting system (as they do not apply to systems) - my @stage3AttrNames = OpenSLX::AttributeRoster->getStage3Attrs(); - for my $attr (keys %{$system->{attrs}}) { - next if grep { $attr eq $_ } @stage3AttrNames; - delete $system->{attrs}->{$attr}; - } - } - - # merge yet unset stuff from default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<<default>>>'}); - mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); - - # finally push the attributes specified for the default client (these - # overrule anything else) - my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); - pushAttributes($system, $defaultClient, $originInfo, 'default-client'); - - return 1; -} - -=item C<mergeDefaultAndGroupAttributesIntoClient($client)> - -merges default and group configurations into the given client hash. - -=over - -=item Param C<client> - -The client whose attributes shall be merged into (completed). - -=item Return Value - -none - -=back - -=cut - -sub mergeDefaultAndGroupAttributesIntoClient -{ - my $self = shift; - my $client = shift; - my $originInfo = shift; - - # step over all groups this client belongs to - # (ordered by priority from highest to lowest): - my @groupIDs = _unique( - $self->fetchGroupIDsOfClient(0), - $self->fetchGroupIDsOfClient($client->{id}) - ); - my @groups - = sort { $a->{priority} <=> $b->{priority} } - $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # merge configuration from this group into the current client: - vlog( - 3, - _tr('merging from group %d:%s...', $group->{id}, $group->{name}) - ); - mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); - } - - # merge configuration from default client: - vlog(3, _tr('merging from default client...')); - my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); - mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); - - return 1; -} - -=item C<aggregatedSystemIDsOfClient($client)> - -Returns an aggregated list of system-IDs that this client should offer for -booting (as indicated by itself, the default client and the client's groups) - -=over - -=item Param C<client> - -The client whose aggregated systems you're interested in. - -=item Return Value - -A list of unqiue system-IDs. - -=back - -=cut - -sub aggregatedSystemIDsOfClient -{ - my $self = shift; - my $client = shift; - - # add all systems directly linked to client: - my @systemIDs = $self->fetchSystemIDsOfClient($client->{id}); - - # step over all groups this client belongs to: - my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); - my @groups = $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # add all systems that the client inherits from the current group: - push @systemIDs, $self->fetchSystemIDsOfGroup($group->{id}); - } - - # add all systems inherited from default client - my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); - push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); - - return _unique(@systemIDs); -} - -=item C<aggregatedClientIDsOfSystem($system)> - -Returns an aggregated list of client-IDs that offer this system for -booting (as indicated by itself, the default system and the system's groups) - -=over - -=item Param C<system> - -The system whose aggregated clients you're interested in. - -=item Return Value - -A list of unqiue client-IDs. - -=back - -=cut - -sub aggregatedClientIDsOfSystem -{ - my $self = shift; - my $system = shift; - - # add all clients directly linked to system: - my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); - my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); - - if (grep { $_ == $defaultClient->{id}; } @clientIDs) { - # add *all* client-IDs if the system is being referenced by - # the default client, as that means that all clients should offer - # this system for booting: - push( - @clientIDs, - map { $_->{id} } $self->fetchClientByFilter(undef, 'id') - ); - } - - # step over all groups this system belongs to: - my @groupIDs = $self->fetchGroupIDsOfSystem($system->{id}); - my @groups = $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # add all clients that the system inherits from the current group: - push @clientIDs, $self->fetchClientIDsOfGroup($group->{id}); - } - - # add all clients inherited from default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<<default>>>'}); - push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); - - return _unique(@clientIDs); -} - -=item C<aggregatedSystemFileInfoFor($system)> - -Returns aggregated information about the kernel and initialramfs -this system is using. - -=over - -=item Param C<system> - -The system whose aggregated info you're interested in. - -=item Return Value - -A hash containing detailled info about the vendor-OS and export used by -this system, as well as the specific kernel-file and export-URI being used. - -=back - -=cut - -sub aggregatedSystemFileInfoFor -{ - my $self = shift; - my $system = shift; - - my $info = clone($system); - - my $export = $self->fetchExportByID($system->{export_id}); - if (!defined $export) { - die _tr( - "DB-problem: system '%s' references export with id=%s, but that doesn't exist!", - $system->{name}, $system->{export_id} || '' - ); - } - $info->{'export'} = $export; - - my $vendorOS = $self->fetchVendorOSByID($export->{vendor_os_id}); - if (!defined $vendorOS) { - die _tr( - "DB-problem: export '%s' references vendor-OS with id=%s, but that doesn't exist!", - $export->{name}, $export->{vendor_os_id} || '' - ); - } - $info->{'vendor-os'} = $vendorOS; - - my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); - $info->{'installed-plugins'} = \@installedPlugins; - - # check if the specified kernel file really exists (follow links while - # checking) and if not, find the newest kernel file that is available. - my $kernelPath - = "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; - my $kernelFile = "$kernelPath/$system->{kernel}"; - while (-l $kernelFile) { - $kernelFile = followLink($kernelFile); - } - if (!-e $kernelFile) { - # pick best kernel file available - my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); - $osSetupEngine->initialize($vendorOS->{name}, 'none'); - $kernelFile = $osSetupEngine->pickKernelFile($kernelPath); - warn( - _tr( - "setting kernel of system '%s' to '%s'!", - $info->{name}, basename($kernelFile) - ) - ); - } - $info->{'kernel-file'} = $kernelFile; - - # auto-generate export_uri if none has been given - my $exportURI = $export->{'uri'} || ''; - if ($exportURI !~ m[\w]) { - # instantiate OSExport engine and ask it for exportURI - my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); - $osExportEngine->initializeFromExisting($export->{name}); - $exportURI = $osExportEngine->generateExportURI($export, $vendorOS); - } - $info->{'export-uri'} = $exportURI; - - return $info; -} - -=back - -=head2 Support Functions - -=over - -=item C<mergeAttributes($target, $source)> - -Copies all attributes from source that are unset in target over (source extends target). - -=over - -=item Param C<target> - -The hash to be used as copy target. - -=item Param C<source> - -The hash to be used as copy source. - -=item Return Value - -none - -=back - -=cut - -sub mergeAttributes -{ - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; - - my $sourceAttrs = $source->{attrs} || {}; - - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; - - foreach my $key (keys %$sourceAttrs) { - my $sourceVal = $sourceAttrs->{$key}; - my $targetVal = $targetAttrs->{$key}; - if (!defined $targetVal) { - vlog(3, _tr( - "merging %s (val=%s)", $key, - defined $sourceVal ? $sourceVal : '' - )); - $targetAttrs->{$key} = $sourceVal; - if (defined $originInfo) { - $originInfo->{$key} = $origin; - } - } - } - - return 1; -} - -=item C<pushAttributes($target, $source)> - -Copies all attributes that are set in source into the target (source overrules target). - -=over - -=item Param C<target> - -The hash to be used as copy target. - -=item Param C<source> - -The hash to be used as copy source. - -=item Return Value - -none - -=back - -=cut - -sub pushAttributes -{ - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; - - my $sourceAttrs = $source->{attrs} || {}; - - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; - - foreach my $key (keys %$sourceAttrs) { - my $sourceVal = $sourceAttrs->{$key}; - if (defined $sourceVal) { - vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal)); - $targetAttrs->{$key} = $sourceVal; - if (defined $originInfo) { - $originInfo->{$key} = $origin; - } - } - } - - return 1; -} - -=item C<externalIDForSystem($system)> - -Returns the given system's name as an external ID - worked into a -state that is usable as a filename. - -=over - -=item Param C<system> - -The system you are interested in. - -=item Return Value - -The external ID (name) of the given system. - -=back - -=cut - -sub externalIDForSystem -{ - my $system = shift; - - return "default" if $system->{name} eq '<<<default>>>'; - - my $name = $system->{name}; - $name =~ tr[/][_]; - - return $name; -} - -=item C<externalIDForClient($client)> - -Returns the given client's MAC as an external ID - worked into a -state that is usable as a filename. - -=over - -=item Param C<client> - -The client you are interested in. - -=item Return Value - -The external ID (MAC) of the given client. - -=back - -=cut - -sub externalIDForClient -{ - my $client = shift; - - return "default" if $client->{name} eq '<<<default>>>'; - - my $mac = lc($client->{mac}); - # PXE seems to expect MACs being all lowercase - $mac =~ tr[:][-]; - - return "01-$mac"; -} - -=item C<externalConfigNameForClient($client)> - -Returns the given client's name as an external ID - worked into a -state that is usable as a filename. - -=over - -=item Param C<client> - -The client you are interested in. - -=item Return Value - -The external name of the given client. - -=back - -=cut - -sub externalConfigNameForClient -{ - my $client = shift; - - return "default" if $client->{name} eq '<<<default>>>'; - - my $name = $client->{name}; - $name =~ tr[/][_]; - - return $name; -} - -=item C<generatePlaceholdersFor($varName)> - -Returns the given variable as a placeholder - surrounded by '@@@' markers. - -=over - -=item Param C<varName> - -The variable you are interested in. - -=item Return Value - -The given variable as a placeholder string. - -=back - -=cut - -sub generatePlaceholderFor -{ - my $varName = shift; - - return '@@@' . $varName . '@@@'; -} - -################################################################################ -### private stuff -################################################################################ -sub _aref -{ # transparently converts the given reference to an array-ref - my $ref = shift; - - return [] unless defined $ref; - $ref = [$ref] unless ref($ref) eq 'ARRAY'; - - return $ref; -} - -sub _unique -{ # return given array filtered to unique elements - my %seenIDs; - return grep { !$seenIDs{$_}++; } @_; -} - -sub _checkCols -{ - my $valRows = shift; - my $table = shift; - my @colNames = @_; - - foreach my $valRow (@$valRows) { - foreach my $col (@colNames) { - die "need to set '$col' for $table!" if !$valRow->{$col}; - } - } - - return 1; -} - -sub _cloneAndUnhingeAttrs -{ - my $inValRows = shift; - - # clone data and unhinge attrs - my (@valRows, @attrValRows); - foreach my $inValRow (@$inValRows) { - push @attrValRows, $inValRow->{attrs}; - my $valRow = clone($inValRow); - delete $valRow->{attrs}; - push @valRows, $valRow; - } - - return (\@valRows, \@attrValRows); -} - -1; diff --git a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm b/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm deleted file mode 100644 index 14b427c8..00000000 --- a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm +++ /dev/null @@ -1,45 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# ISC.pm -# - provides ISC-specific implementation of DHCP export. -# ----------------------------------------------------------------------------- -package OpenSLX::ConfigExport::DHCP::ISC; - -use strict; -use warnings; - -our $VERSION = 1.01; # API-version . implementation-version - -################################################################################ -### This class provides an ISC specific implementation for DHCP export. -################################################################################ -use OpenSLX::Basics; - -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub execute -{ - my $self = shift; - my $clients = shift; - - vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); - foreach my $client (@$clients) { -print "ISC-DHCP: $client->{name}\n"; - } -}
\ No newline at end of file diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm deleted file mode 100644 index d3e7573b..00000000 --- a/config-db/OpenSLX/DBSchema.pm +++ /dev/null @@ -1,832 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# DBSchema.pm -# - provides database schema of the OpenSLX config-db. -# ----------------------------------------------------------------------------- -package OpenSLX::DBSchema; - -use strict; -use warnings; - -use OpenSLX::Basics; - -################################################################################ -### DB-schema definition -### This hash-ref describes the current OpenSLX configuration database -### schema. -### Each table is defined by a list of column descriptions (and optionally -### a list of default values). -### 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) -################################################################################ - -my $VERSION = 0.36; - -my $DbSchema = { - 'version' => $VERSION, - 'tables' => { - 'client' => { - # a client is a PC booting via network - 'cols' => [ - '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 - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default client - 'id' => 0, - 'name' => '<<<default>>>', - 'comment' => 'internal client that holds default values', - }, - ], - }, - 'client_attr' => { - # attributes of clients - 'cols' => [ - 'id:pk', # primary key - 'client_id:fk', # foreign key to client - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'client_system_ref' => { - # clients referring to the systems they should offer for booting - 'cols' => [ - 'client_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, - 'export' => { - # an export describes a vendor-OS "wrapped" in some kind of exporting - # format (NFS or NBD-squash). This represents the rootfs that the - # clients will see. - 'cols' => [ - 'id:pk', # primary key - 'name:s.64', # unique name of export, is automatically - # constructed like this: - # <vendor-os-name>-<export-type> - 'vendor_os_id:fk', # foreign key - 'comment:s.1024', # internal comment (optional, for admins) - 'type:s.10', # 'nbd', 'nfs', ... - 'server_ip:s.16', # IP of exporting server, if empty the - # boot server will be used - 'port:i', # some export types need to use a specific - # port for each incarnation, if that's the - # case you can specify it here - 'uri:s.255', # path to export (squashfs or NFS-path), if - # empty it will be auto-generated by - # config-demuxer - ], - }, - 'global_info' => { - # a home for global counters and other info - 'cols' => [ - 'id:s.32', # key - 'value:s.128', # value - ], - 'vals' => [ - { # add nbd-server-port - 'id' => 'next-nbd-server-port', - 'value' => '5000', - }, - ], - }, - 'groups' => { - # 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. - 'cols' => [ - 'id:pk', # primary key - 'name:s.128', # name of group - 'priority:i', # priority, used for order in group-list - # (from 0-highest to 99-lowest) - 'comment:s.1024', # internal comment (optional, for admins) - ], - }, - 'group_attr' => { - # attributes of groups - 'cols' => [ - 'id:pk', # primary key - 'group_id:fk', # foreign key to group - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'group_client_ref' => { - # groups referring to their clients - 'cols' => [ - '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 - 'cols' => [ - 'group_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, - 'installed_plugin' => { - # holds the plugins that have been installed into a specific - # vendor-OS - 'cols' => [ - 'id:pk', # primary key - 'vendor_os_id:fk', # foreign key - 'plugin_name:s.64', # name of installed plugin - # (e.g. suse-9.3-kde, debian-3.1-ppc, - # suse-10.2-cloned-from-kiwi). - # This is used as the folder name for the - # corresponding stage1, too. - ], - }, - 'installed_plugin_attr' => { - # (stage1-)attributes of installed plugins - 'cols' => [ - 'id:pk', # primary key - 'installed_plugin_id:fk', # foreign key to installed plugin - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'meta' => { - # information about the database as such - 'cols' => [ - 'plugin_info_hash:s.32', # hash-value identifying a specific - # set of plugins and their - # attributes - 'schema_version:s.5', # schema-version currently - # implemented by DB - ], - 'vals' => [ - { - 'plugin_info_hash' => '', - 'schema_version' => $VERSION, - }, - ], - }, - 'system' => { - # a system describes one bootable instance of an export, it - # represents a selectable line in the PXE boot menu of all the - # clients associated with this system - 'cols' => [ - 'id:pk', # primary key - 'export_id:fk', # foreign key - 'name:s.64', # unique name of system, is automatically - # constructed like this: - # <vendor-os-name>-<export-type>-<kernel> - 'label:s.64', # name visible to user (pxe-label) - # if empty, this will be autocreated from - # the name - 'kernel:s.128', # path to kernel file, relative to /boot - 'description:s.512', # visible description (for PXE TEXT) - 'pxe_prefix_ip:s.16', # ip prefix for PXE Menu entry - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default system - 'id' => 0, - 'name' => '<<<default>>>', - 'comment' => 'internal system that holds default values', - }, - ], - }, - 'system_attr' => { - # attributes of systems - 'cols' => [ - 'id:pk', # primary key - 'system_id:fk', # foreign key to system - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'vendor_os' => { - # a vendor-OS describes a folder containing an operating system as - # provided by the vendor (a.k.a. unchanged and thus updatable) - 'cols' => [ - 'id:pk', # primary key - 'name:s.48', # structured name of OS installation - # (e.g. suse-9.3-kde, debian-3.1-ppc, - # suse-10.2-cloned-from-kiwi). - # This is used as the folder name for the - # corresponding stage1, too. - 'comment:s.1024', # internal comment (optional, for admins) - 'clone_source:s.255', # if vendor-OS was cloned, this contains - # the rsync-URI pointing to the original - ], - }, - }, -}; - -################################################################################ -### -### standard methods -### -################################################################################ -sub new -{ - my $class = shift; - - my $self = { - }; - - return bless $self, $class; -} - -sub checkAndUpgradeDBSchemaIfNecessary -{ - my $self = shift; - my $configDB = shift; - - my $metaDB = $configDB->{'meta-db'}; - - vlog(2, "trying to determine schema version..."); - my $currVersion = $metaDB->schemaFetchDBVersion(); - if (!defined $currVersion) { - # that's bad, someone has messed with our DB: 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 == 0) { - vlog(1, _tr('Creating DB (schema version: %s)', $DbSchema->{version})); - foreach my $tableName (keys %{$DbSchema->{tables}}) { - # create table (optionally inserting default values, too) - $metaDB->schemaAddTable( - $tableName, - $DbSchema->{tables}->{$tableName}->{cols}, - $DbSchema->{tables}->{$tableName}->{vals} - ); - } - $metaDB->schemaSetDBVersion($DbSchema->{version}); - $configDB->cleanupAnyInconsistencies() - or die _tr('unable to cleanup DB!'); - vlog(1, _tr('DB has been created successfully')); - } elsif ($currVersion < $DbSchema->{version}) { - vlog( - 1, - _tr( - 'Our schema-version is %s, DB is %s, upgrading DB...', - $DbSchema->{version}, $currVersion - ) - ); - $self->_schemaUpgradeDBFrom($metaDB, $currVersion); - $configDB->cleanupAnyInconsistencies() - or die _tr('unable to cleanup DB!'); - vlog(1, _tr('upgrade done')); - } else { - vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); - } - - return 1; -} - -sub getColumnsOfTable -{ - my $self = shift; - my $tableName = shift; - - return - map { (/^(\w+)\W/) ? $1 : $_; } - @{$DbSchema->{tables}->{$tableName}->{cols}}; -} - -################################################################################ -### -### methods for upgrading the DB schema -### -################################################################################ -my %DbSchemaHistory; - -sub _schemaUpgradeDBFrom -{ - my $self = shift; - my $metaDB = shift; - my $currVersion = shift; - - foreach my $version (sort { $a <=> $b } keys %DbSchemaHistory) { - next if $currVersion >= $version; - - vlog(0, "upgrading schema version to $version"); - if ($DbSchemaHistory{$version}->($metaDB)) { - $metaDB->schemaSetDBVersion($version); - } - } - - return 1; -} - -%DbSchemaHistory = ( - 0.2 => sub { - my $metaDB = shift; - - # move attributes into separate tables ... - # - # ... system attributes ... - $metaDB->schemaAddTable( - 'system_attr', - [ - 'id:pk', - 'system_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $system ($metaDB->fetchSystemByFilter()) { - my %attrs; - foreach my $key (keys %$system) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $system->{$key} || ''; - next if $system->{id} > 0 && !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setSystemAttrs($system->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'system', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_local_disk', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_ramfs_fsmods', - 'attr_ramfs_miscmods', - 'attr_ramfs_nicmods', - 'attr_ramfs_screen', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'export_id:fk', - 'name:s.64', - 'label:s.64', - 'kernel:s.128', - 'kernel_params:s.512', - 'hidden:b', - 'comment:s.1024', - ] - ); - # - # ... client attributes ... - $metaDB->schemaAddTable( - 'client_attr', - [ - 'id:pk', - 'client_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $client ($metaDB->fetchClientByFilter()) { - my %attrs; - foreach my $key (keys %$client) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $client->{$key} || ''; - next if !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setClientAttrs($client->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'client', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_local_disk', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'name:s.128', - 'mac:s.20', - 'boot_type:s.20', - 'unbootable:b', - 'kernel_params:s.128', - 'comment:s.1024', - ] - ); - # - # ... group attributes ... - $metaDB->schemaAddTable( - 'group_attr', - [ - 'id:pk', - 'group_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $group ($metaDB->fetchGroupByFilter()) { - my %attrs; - foreach my $key (keys %$group) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $group->{$key} || ''; - next if !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setGroupAttrs($group->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'groups', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_local_disk', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'name:s.128', - 'priority:i', - 'comment:s.1024', - ] - ); - - return 1; - }, - 0.21 => sub { - my $metaDB = shift; - - # add new table installed_plugin - $metaDB->schemaAddTable( - 'installed_plugin', - [ - 'id:pk', - 'vendor_os_id:fk', - 'plugin_name:s.64', - ] - ); - - return 1; - }, - 0.22 => sub { - my $metaDB = shift; - - # dummy schema change, just to trigger the attribute synchronization - # into the default system - - return 1; - }, - 0.23 => sub { - my $metaDB = shift; - - # add new column system.description - $metaDB->schemaAddColumns( - 'system', - [ - 'description:s.512', - ], - undef, - [ - 'id:pk', - 'export_id:fk', - 'name:s.64', - 'label:s.64', - 'kernel:s.128', - 'kernel_params:s.512', - 'hidden:b', - 'description:s.512', - 'comment:s.1024', - ] - ); - - return 1; - }, - 0.24 => sub { - my $metaDB = shift; - - # split theme::name into theme::splash, theme::displaymanager and - # theme::desktop - foreach my $system ($metaDB->fetchSystemByFilter()) { - my $attrs = $system->{attrs} || {}; - next if !exists $attrs->{'theme::name'}; - $attrs->{'theme::splash'} - = $attrs->{'theme::displaymanager'} - = $attrs->{'theme::desktop'} - = $attrs->{'theme::name'}; - delete $attrs->{'theme::name'}; - $metaDB->setSystemAttrs($system->{id}, $attrs); - } - - # force all plugin names to lowercase - foreach my $vendorOS ($metaDB->fetchVendorOSByFilter()) { - my @installedPlugins - = $metaDB->fetchInstalledPlugins($vendorOS->{id}); - foreach my $plugin (@installedPlugins) { - my $pluginName = $plugin->{plugin_name}; - $metaDB->removeInstalledPlugin($vendorOS->{id}, $pluginName); - $metaDB->addInstalledPlugin($vendorOS->{id}, lc($pluginName)); - } - } - - return 1; - }, - 0.25 => sub { - my $metaDB = shift; - - # drop attribute ramfs_screen - $metaDB->removeAttributeByName('ramfs_screen'); - - return 1; - }, - 0.26 => sub { - my $metaDB = shift; - - # rename all exports and systems that contain a single colon to - # the current naming scheme with a double colon - foreach my $system ($metaDB->fetchSystemByFilter()) { - if ($system->{name} =~ m{^([^:]+):([^:]+)$}) { - if ($system->{label} eq $system->{name}) { - $system->{label} = "${1}::${2}"; - } - $system->{name} = "${1}::${2}"; - $metaDB->changeSystem([ $system->{id} ], [ $system ]); - } - } - foreach my $export ($metaDB->fetchExportByFilter()) { - if ($export->{name} =~ m{^([^:]+):([^:]+)$}) { - $export->{name} = "${1}::${2}"; - $metaDB->changeExport([ $export->{id} ], [ $export ]); - } - } - - return 1; - }, - 0.27 => sub { - my $metaDB = shift; - - # add default vendor-OS, which holds info about the plugins that shall - # be automatically installed into all vendor-OS that are being created. - $metaDB->addVendorOS([{ - id => '0', - name => '<<<default>>>', - comment => 'holds default plugins for all vendor-OS', - }]); - - return 1; - }, - 0.28 => sub { - my $metaDB = shift; - - # correct effects of implementation error last time around that caused - # the default vendor-OS to not have any plugins at all - so we add - # the default plugins here: -# OLTA: deactivated for good since this does not work anymore with newer -# implementations (as addInstalledPlugin requires the table -# 'installed_plugin_attr', which is going to be created in db-schema -# version 0.29 (see below) -# $metaDB->addInstalledPlugin(0, 'theme'); - - return 1; - }, - 0.29 => sub { - my $metaDB = shift; - - # add new table installed_plugin_attrs - $metaDB->schemaAddTable( - 'installed_plugin_attr', - [ - 'id:pk', - 'installed_plugin_id:fk', - 'name:s.128', - 'value:s.255', - ], - ); - - return 1; - }, - 0.30 => sub { - my $metaDB = shift; - - # dummy schema change, just to trigger the attribute synchronization - # into the default system (required since plugins have been added - # and removed) - - return 1; - }, - 0.31 => sub { - my $metaDB = shift; - - # dummy schema change, just to trigger the attribute synchronization - # again, as the respective code has been extended - - return 1; - }, - 0.32 => sub { - my $metaDB = shift; - - # dummy schema change, just to trigger the attribute synchronization, - # as the 'theme' plugin has been removed - - return 1; - }, - 0.33 => sub { - my $metaDB = shift; - - # add new column meta.plugin_info_hash - $metaDB->schemaAddColumns( - 'meta', - [ - 'plugin_info_hash:s.32', - ], - undef, - [ - 'plugin_info_hash:s.32', - 'schema_version:s.5', - ] - ); - - return 1; - }, - 0.34 => sub { - my $metaDB = shift; - - # turn client fields 'boot_type', 'kernel_params' and 'unbootable' - # into attributes: - foreach my $client ($metaDB->fetchClientByFilter()) { - my $attrs = $metaDB->fetchClientAttrs($client->{id}); - $attrs->{boot_type} = $client->{boot_type} || 'pxe'; - $attrs->{kernel_params_client} = $client->{kernel_params}; - $attrs->{unbootable} = $client->{unbootable}; - $metaDB->setClientAttrs($client->{id}, $attrs); - } - $metaDB->schemaDropColumns( - 'client', - [ - 'boot_type', - 'kernel_params', - 'unbootable', - ], - [ - 'id:pk', - 'name:s.128', - 'mac:s.20', - 'comment:s.1024', - ] - ); - - # turn system fields 'hidden' and 'kernel_params' into attributes: - foreach my $system ($metaDB->fetchSystemByFilter()) { - my $attrs = $metaDB->fetchSystemAttrs($system->{id}); - $attrs->{hidden} = $system->{hidden}; - $attrs->{kernel_params} = $system->{kernel_params}; - $metaDB->setSystemAttrs($system->{id}, $attrs); - } - $metaDB->schemaDropColumns( - 'system', - [ - 'hidden', - 'kernel_params', - ], - [ - 'id:pk', - 'export_id:fk', - 'name:s.64', - 'label:s.64', - 'kernel:s.128', - 'description:s.512', - 'comment:s.1024', - ] - ); - - return 1; - }, - 0.35 => sub { - my $metaDB = shift; - - # add new column system.pxe_prefix_ip - $metaDB->schemaAddColumns( - 'system', - [ - 'pxe_prefix_ip:s.16', - ], - undef - ); - - return 1; - }, - 0.36 => sub { - my $metaDB = shift; - - # value 'preboot-cd' in client-attr 'boot_type' has been changed - # to 'preboot', and a separate attribute 'preboot_media' has been - # introduced: - foreach my $client ($metaDB->fetchClientByFilter()) { - my $attrs = $metaDB->fetchClientAttrs($client->{id}); - if ($attrs->{boot_type} eq 'preboot-cd') { - $attrs->{boot_type} = 'preboot'; - $attrs->{preboot_media} = 'cd'; - $metaDB->setClientAttrs($client->{id}, $attrs); - } - } - - return 1; - }, -); - -1; diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm deleted file mode 100644 index f1fbd0f5..00000000 --- a/config-db/OpenSLX/MetaDB/Base.pm +++ /dev/null @@ -1,1220 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# Base.pm -# - provides empty base of the OpenSLX MetaDB API. -# ----------------------------------------------------------------------------- -package OpenSLX::MetaDB::Base; - -use strict; -use warnings; - -our $VERSION = 1.01; # API-version . implementation-version - -use OpenSLX::Basics; - -################################################################################ -### basic functions -################################################################################ -sub new -{ - confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; -} - -sub connect ## no critic (ProhibitBuiltinHomonyms) -{ -} - -sub disconnect -{ -} - -sub quote -{ -} - -################################################################################ -### data access interface -################################################################################ -sub fetchVendorOSByFilter -{ -} - -sub fetchVendorOSByID -{ -} - -sub fetchExportByFilter -{ -} - -sub fetchExportByID -{ -} - -sub fetchExportIDsOfVendorOS -{ -} - -sub fetchSystemByFilter -{ -} - -sub fetchSystemByID -{ -} - -sub fetchSystemIDsOfExport -{ -} - -sub fetchSystemIDsOfClient -{ -} - -sub fetchSystemIDsOfGroup -{ -} - -sub fetchClientByFilter -{ -} - -sub fetchClientByID -{ -} - -sub fetchClientIDsOfSystem -{ -} - -sub fetchClientIDsOfGroup -{ -} - -sub fetchGroupByFilter -{ -} - -sub fetchGroupByID -{ -} - -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; -} - -sub addVendorOS -{ -} - -sub removeVendorOS -{ -} - -sub changeVendorOS -{ -} - -sub addExport -{ -} - -sub removeExport -{ -} - -sub changeExport -{ -} - -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 schemaSetDBVersion -{ -} - -sub schemaCreate -{ -} - -sub schemaUpgradeToCurrent -{ -} - -sub schemaConvertTypeDescrToNative -{ -} - -sub schemaAddTable -{ -} - -sub schemaDropTable -{ -} - -sub schemaRenameTable -{ -} - -sub schemaAddColumns -{ -} - -sub schemaDropColumns -{ -} - -sub schemaChangeColumns -{ -} - -1; -################################################################################ - -=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) { - croak _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). - -=head1 Special Concepts - -=over - -=item C<Filters> - -A filter is a hash-ref defining the filter criteria to be applied to a database -query. Each key of the filter corresponds to a DB column and the (hash-)value -contains the respective column value. - -[At a later stage, this will be improved to support a more structured approach -to filtering (with boolean operators and hierarchical expressions)]. - -=back - -=head1 Methods - -=head2 Basic Methods - -The following basic methods need to be implemented in a MetaDB driver: - -=over - -=item C<connectConfigDB()> - -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-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 - -=item C<disconnectConfigDB()> - -Tears down the connection to the DBMS that this MetaDB driver deals with and -cleans up. - -=item C<quote(string)> - -Returns the given string quoted such that it can be used in SQL-statements -(with respect to the corresponding DBMS). - -This usually involves putting -single quotes around the string and escaping any single quote characters -enclosed in the given string with a backslash. - -=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 - -=item C<fetchVendorOSByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all vendor-OSes that match the given -filter. - -=over - -=item Param C<filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchVendorOSByID(@$ids, [$resultCols])> - -Fetches and returns information the vendor-OSes with the given IDs. - -=over - -=item Param C<ids> - -An array of the vendor-OS-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchExportByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all exports that match the given -filter. - -=over - -=item Param C<filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchExportByID(@$ids, [$resultCols])> - -Fetches and returns information the exports with the given IDs. - -=over - -=item Param C<ids> - -An array of the export-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchExportIDsOfVendorOS($id)> - -Fetches the IDs of all exports that make use of the vendor-OS with the given ID. - -=over - -=item Param C<id> - -ID of the vendor-OS whose exports shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=item C<fetchSystemByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all systems that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 - -=item C<fetchSystemByID(@$ids, [$resultCols])> - -Fetches and returns information the systems with the given IDs. - -=over - -=item Param C<ids> - -An array of the system-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchSystemIDsOfExport($id)> - -Fetches the IDs of all systems that make use of the export with the given ID. - -=over - -=item Param C<id> - -ID of the export whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=item C<fetchSystemIDsOfClient($id)> - -Fetches the IDs of all systems that are used by the client with the given -ID. - -=over - -=item Param C<id> - -ID of the client whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=item C<fetchSystemIDsOfGroup($id)> - -Fetches the IDs of all systems that are part of the group with the given -ID. - -=over - -=item Param C<id> - -ID of the group whose systems shall be returned. - -=item Return Value - -An array of system-IDs. - -=back - -=item C<fetchClientByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all clients that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 - -=item C<fetchClientByID(@$ids, [$resultCols])> - -Fetches and returns information the clients with the given IDs. - -=over - -=item Param C<ids> - -An array of the client-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - -=item C<fetchClientIDsOfSystem($id)> - -Fetches the IDs of all clients that make use of the system with the given -ID. - -=over - -=item Param C<id> - -ID of the system whose clients shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - -=item C<fetchClientIDsOfGroup($id)> - -Fetches the IDs of all clients that are part of the group with the given -ID. - -=over - -=item Param C<id> - -ID of the group whose clients shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - - - -=item C<fetchGroupByFilter([%$filter], [$resultCols])> - -Fetches and returns information about all groups that match the given filter. - -=over - -=item Param C<$filter> - -A hash-ref containing the filter criteria that shall be applied - default -is no filtering. See L</"Filters"> for more info. - -=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 - - - -=item C<fetchGroupByID(@$ids, [$resultCols])> - -Fetches and returns information the groups with the given IDs. - -=over - -=item Param C<ids> - -An array of the group-IDs you are interested in. - -=item Param C<resultCols> - -A string listing the columns that shall be returned - default is all columns. - -=item Return Value - -An array of hash-refs containing the resulting data rows. - -=back - - - -=item C<fetchGroupIDsOfClient($id)> - -Fetches the IDs of all groups that contain the client with the given -ID. - -=over - -=item Param C<id> - -ID of the client whose groups shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - - - -=item C<fetchGroupIDsOfSystem($id)> - -Fetches the IDs of all groups that contain the system with the given -ID. - -=over - -=item Param C<id> - -ID of the system whose groups shall be returned. - -=item Return Value - -An array of client-IDs. - -=back - - - -=head2 Data Manipulation Methods - -The following methods need to be implemented in a MetaDB driver in order to -allow the user to access change the underlying: - - - -=item C<addVendorOS(@$valRows)> - -Adds one or more vendor-OS to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new vendor-OS(es). - -=item Return Value - -The IDs of the new vendor-OS(es), C<undef> if the creation failed. - -=back - - - -=item C<removeVendorOS(@$vendorOSIDs)> - -Removes one or more vendor-OS from the database. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the vendor-OSes that shall be removed. - -=item Return Value - -C<1> if the vendorOS(es) could be removed, C<undef> if not. - -=back - - - -=item C<changeVendorOS(@$vendorOSIDs, @$valRows)> - -Changes the data of one or more vendor-OS. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the vendor-OSes that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the vendor-OS(es). - -=item Return Value - -C<1> if the vendorOS(es) could be changed, C<undef> if not. - -=back - - - -=item C<addExport(@$valRows)> - -Adds one or more export to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new export(s). - -=item Return Value - -The IDs of the new export(s), C<undef> if the creation failed. - -=back - - - -=item C<removeExport(@$exportIDs)> - -Removes one or more export from the database. - -=over - -=item Param C<exportIDs> - -An array-ref containing the IDs of the exports that shall be removed. - -=item Return Value - -C<1> if the export(s) could be removed, C<undef> if not. - -=back - - - -=item C<changeExport(@$exportIDs, @$valRows)> - -Changes the data of one or more export. - -=over - -=item Param C<vendorOSIDs> - -An array-ref containing the IDs of the exports that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the export(s). - -=item Return Value - -C<1> if the export(s) could be changed, C<undef> if not. - -=back - - - -=item C<addSystem(@$valRows)> - -Adds one or more systems to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new system(s). - -=item Return Value - -The IDs of the new system(s), C<undef> if the creation failed. - -=back - - - -=item C<removeSystem(@$systemIDs)> - -Removes one or more systems from the database. - -=over - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be removed. - -=item Return Value - -C<1> if the system(s) could be removed, C<undef> if not. - -=back - - - -=item C<changeSystem(@$systemIDs, @$valRows)> - -Changes the data of one or more systems. - -=over - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the system(s). - -=item Return Value - -C<1> if the system(s) could be changed, C<undef> if not. - -=back - - - -=item C<setClientIDsOfSystem($systemID, @$clientIDs)> - -Specifies all clients that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system whose clients you'd like to specify. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be connected to the -system. - -=item Return Value - -C<1> if the system/client references could be set, C<undef> if not. - -=back - - - -=item C<setGroupIDsOfSystem($systemID, @$groupIDs)> - -Specifies all groups that should offer the given system for booting. - -=over - -=item Param C<systemID> - -The ID of the system whose groups you'd like to specify. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the groups that shall be connected to the -system. - -=item Return Value - -C<1> if the system/group references could be set, C<undef> if not. - -=back - - - -=item C<addClient(@$valRows)> - -Adds one or more clients to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new client(s). - -=item Return Value - -The IDs of the new client(s), C<undef> if the creation failed. - -=back - - - -=item C<removeClient(@$clientIDs)> - -Removes one or more clients from the database. - -=over - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be removed. - -=item Return Value - -C<1> if the client(s) could be removed, C<undef> if not. - -=back - - - -=item C<changeClient(@$clientIDs, @$valRows)> - -Changes the data of one or more clients. - -=over - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the client(s). - -=item Return Value - -C<1> if the client(s) could be changed, C<undef> if not. - -=back - - - -=item C<setSystemIDsOfClient($clientID, @$clientIDs)> - -Specifies all systems that should be offered for booting by the given client. - -=over - -=item Param C<clientID> - -The ID of the client whose systems you'd like to specify. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be connected to the -client. - -=item Return Value - -C<1> if the client/system references could be set, C<undef> if not. - -=back - - - -=item C<setGroupIDsOfClient($clientID, @$groupIDs)> - -Specifies all groups that the given client shall be part of. - -=over - -=item Param C<clientID> - -The ID of the client whose groups you'd like to specify. - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that the client should be part of. - -=item Return Value - -C<1> if the client/group references could be set, C<undef> if not. - -=back - - - -=item C<addGroup(@$valRows)> - -Adds one or more groups to the database. - -=over - -=item Param C<valRows> - -An array-ref containing hash-refs with the data of the new group(s). - -=item Return Value - -The IDs of the new group(s), C<undef> if the creation failed. - -=back - - - -=item C<removeGroup(@$groupIDs)> - -Removes one or more groups from the database. - -=over - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be removed. - -=item Return Value - -C<1> if the group(s) could be removed, C<undef> if not. - -=back - - - -=item C<changeGroup(@$groupIDs, @$valRows)> - -Changes the data of one or more groups. - -=over - -=item Param C<groupIDs> - -An array-ref containing the IDs of the groups that shall be changed. - -=item Param C<valRows> - -An array-ref containing hash-refs with the new data for the group(s). - -=item Return Value - -C<1> if the group(s) could be changed, C<undef> if not. - -=back - - - -=item C<setClientIDsOfGroup($groupID, @$clientIDs)> - -Specifies all clients that should be part of the given group. - -=over - -=item Param C<groupID> - -The ID of the group whose clients you'd like to specify. - -=item Param C<clientIDs> - -An array-ref containing the IDs of the clients that shall be part of the group. - -=item Return Value - -C<1> if the group/client references could be set, C<undef> if not. - -=back - - - -=item C<setSystemIDsOfGroup($groupID, @$groupIDs)> - -Specifies all systems that should be offered for booting by the given group. - -=over - -=item Param C<groupID> - -The ID of the group whose systems you'd like to specify. - -=item Param C<systemIDs> - -An array-ref containing the IDs of the systems that shall be connected to the -group. - -=item Return Value - -C<1> if the group/system references could be set, C<undef> if not. - -=back - - - - - -=head2 Schema Related Methods - -The following methods need to be implemented in a MetaDB driver in order to -be able to automatically adjust to new database schema versions (by adding -and/or removing tables and table-columns). - -=cut diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm deleted file mode 100644 index a5a8e68e..00000000 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ /dev/null @@ -1,1540 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# DBI.pm -# - provides DBI-based implementation of the OpenSLX MetaDB API. -# ----------------------------------------------------------------------------- -package OpenSLX::MetaDB::DBI; - -use strict; -use warnings; - -use base qw(OpenSLX::MetaDB::Base); - -use DBI; -use OpenSLX::Basics; -use OpenSLX::Utils; - -################################################################################ -### basics -################################################################################ -sub new -{ - confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; -} - -sub disconnect -{ - my $self = shift; - - $self->{'dbh'}->disconnect; - $self->{'dbh'} = undef; - return; -} - -sub quote -{ # default implementation quotes any given values through the DBI - my $self = shift; - - return $self->{'dbh'}->quote(@_); -} - -sub startTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; - - return $self->{'dbh'}->begin_work(); -} - -sub commitTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; - - return $self->{'dbh'}->commit(); -} - -sub rollbackTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; - - return $self->{'dbh'}->rollback(); -} - -################################################################################ -### data access -################################################################################ -sub _trim -{ - my $s = shift; - $s =~ s[^\s*(.*?)\s*$][$1]; - return $s; -} - -sub _buildFilterClause -{ - my $self = shift; - my $filter = shift || {}; - my $filterClause = shift || ''; - - my ($connector, $quotedVal); - foreach my $col (keys %$filter) { - $connector = !length($filterClause) ? 'WHERE' : 'AND'; - if (defined $filter->{$col}) { - $quotedVal = $self->{dbh}->quote($filter->{$col}); - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector $col = $quotedVal - End-of-Here - } else { - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector $col IS NULL - End-of-Here - } - } - - return $filterClause || ''; -} - -sub _buildAttrFilterClause -{ - my $self = shift; - my $attrFilter = shift || {}; - my $table = shift; - my $filterClause = shift || ''; - - my %tableMap = ( - 'client' => 'client', - 'group' => 'groups', - 'system' => 'system', - ); - - my ($connector, $quotedName, $quotedValue); - foreach my $name (keys %$attrFilter) { - $connector = !length($filterClause) ? 'WHERE' : 'AND'; - $quotedName = $self->{dbh}->quote($name); - if (defined $attrFilter->{$name}) { - $quotedValue = $self->{dbh}->quote($attrFilter->{$name}); - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector EXISTS ( - SELECT name FROM ${table}_attr - WHERE name = $quotedName - AND value = $quotedValue - AND ${table}_id = $tableMap{$table}.id - ) - End-of-Here - } else { - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector NOT EXISTS ( - SELECT name FROM ${table}_attr - WHERE name = $quotedName - AND ${table}_id = $tableMap{$table}.id - ) - End-of-Here - } - } - - return $filterClause; -} - -sub _doSelect -{ - my $self = shift; - my $sql = shift; - my $resultCol = shift; - - my $dbh = $self->{'dbh'}; - - vlog(3, _trim($sql)); - my $sth = $dbh->prepare($sql) - or croak _tr( - q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr - ); - $sth->execute() - or croak _tr( - q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr - ); - my @vals; - while (my $row = $sth->fetchrow_hashref()) { - if (defined $resultCol) { - return $row->{$resultCol} unless wantarray(); - push @vals, $row->{$resultCol}; - } else { - return $row unless wantarray(); - push @vals, $row; - } - } - - # return undef if there's no result in scalar context - return if !wantarray(); - - return @vals; -} - -sub fetchVendorOSByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - my $sql = "SELECT $resultCols FROM vendor_os $filterClause"; - return $self->_doSelect($sql); -} - -sub fetchVendorOSByID -{ - my $self = shift; - my $ids = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)"; - return $self->_doSelect($sql); -} - -sub fetchInstalledPlugins -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $fullInfo = shift || 0; - - return if !defined $vendorOSID; - my $nameClause - = defined $pluginName - ? "AND plugin_name = '$pluginName'" - : ''; - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT * FROM installed_plugin - WHERE vendor_os_id = '$vendorOSID' - $nameClause - End-of-Here - my @pluginInfos = $self->_doSelect($sql); - return if !@pluginInfos; - - @pluginInfos = map { - my $pluginInfo = $_; - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT * FROM installed_plugin_attr - WHERE installed_plugin_id = '$pluginInfo->{id}' - End-of-Here - my @attrs = $self->_doSelect($sql); - $pluginInfo->{attrs} = { - map { - ( $_->{name}, $fullInfo ? $_ : $_->{value} ) - } @attrs - }; - $pluginInfo; - } - @pluginInfos; - - return wantarray() ? @pluginInfos : $pluginInfos[0]; -} - -sub fetchExportByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - my $sql = "SELECT $resultCols FROM export $filterClause"; - return $self->_doSelect($sql); -} - -sub fetchExportByID -{ - my $self = shift; - my $ids = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)"; - return $self->_doSelect($sql); -} - -sub fetchExportIDsOfVendorOS -{ - my $self = shift; - my $vendorOSID = shift; - - my $sql = qq[ - SELECT id FROM export WHERE vendor_os_id = '$vendorOSID' - ]; - return $self->_doSelect($sql, 'id'); -} - -sub fetchGlobalInfo -{ - my $self = shift; - my $id = shift; - - return if !length($id); - my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id); - return $self->_doSelect($sql, 'value'); -} - -sub fetchSystemByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'system', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM system - $filterClause - End-of-Here - return $self->_doSelect($sql); -} - -sub fetchSystemByID -{ - my $self = shift; - my $ids = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)"; - return $self->_doSelect($sql); -} - -sub fetchSystemAttrs -{ - my $self = shift; - my $systemID = $self->{dbh}->quote(shift); - - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM system_attr - WHERE system_id = $systemID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; -} - -sub fetchSystemIDsOfExport -{ - my $self = shift; - my $exportID = shift; - - my $sql = qq[ - SELECT id FROM system WHERE export_id = '$exportID' - ]; - 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 fetchClientByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'client', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM client - $filterClause - End-of-Here - return $self->_doSelect($sql); -} - -sub fetchClientByID -{ - my $self = shift; - my $ids = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)"; - return $self->_doSelect($sql); -} - -sub fetchClientAttrs -{ - my $self = shift; - my $clientID = $self->{dbh}->quote(shift); - - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM client_attr - WHERE client_id = $clientID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; -} - -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, 'client_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, 'client_id'); -} - -sub fetchGroupByFilter -{ - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; - - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'group', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM groups - $filterClause - End-of-Here - return $self->_doSelect($sql); -} - -sub fetchGroupByID -{ - my $self = shift; - my $ids = shift; - my $resultCols = shift; - - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)"; - return $self->_doSelect($sql); -} - -sub fetchGroupAttrs -{ - my $self = shift; - my $groupID = $self->{dbh}->quote(shift); - - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM group_attr - WHERE group_id = $groupID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; -} - -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 -################################################################################ -sub _doInsert -{ - my $self = shift; - my $table = shift; - my $valRows = shift; - my $ignoreIDs = shift; - - my $dbh = $self->{'dbh'}; - my $valRow = (@$valRows)[0]; - return if !defined $valRow || !scalar keys %$valRow; - - if ($table =~ m[_ref$]) { - # reference tables do not have IDs: - $ignoreIDs = 1; - } - - my $needToGenerateIDs = $self->generateNextIdForTable(undef); - if (!$ignoreIDs && $needToGenerateIDs) { - # DB requires pre-specified IDs, so we add the 'id' column: - $valRow->{id} = undef unless exists $valRow->{id}; - } - my @ids; - foreach my $valRow (@$valRows) { - if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) { - # let DB-backend pre-specify ID, as current DB can't generate IDs: - $valRow->{id} = $self->generateNextIdForTable($table); - vlog(3, "generated id for <$table> is <$valRow->{id}>"); - } - my $cols = join ', ', keys %$valRow; - my $values = join ', ', - map { $self->quote($valRow->{$_}) } keys %$valRow; - my $sql = "INSERT INTO $table ( $cols ) VALUES ( $values )"; - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); - if (!$ignoreIDs) { - my $lastID = $dbh->last_insert_id(undef, undef, $table, 'id'); - if (!defined $valRow->{id}) { - # id has not been pre-specified, we need to fetch it from DB: - $valRow->{'id'} = $lastID; - vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); - } - elsif ($valRow->{'id'} ne $lastID) { - # id has been pre-specified, but DB changed it, so we update - # it with the pre-specified value - my $sql2 = unshiftHereDoc(<<" End-of-Here"); - UPDATE $table SET id='$valRow->{'id'}' WHERE id='$lastID' - End-of-Here - vlog(3, $sql2); - $dbh->do($sql2) or croak _tr( - q[Can't update table <%s> (%s)], $table, $dbh->errstr - ); - } - } - push @ids, $valRow->{'id'}; - } - return wantarray() ? @ids : shift @ids; -} - -sub _doDelete -{ - my $self = shift; - my $table = shift; - my $IDs = shift; - my $idCol = shift; - my $additionalWhereClause = shift; - - my $dbh = $self->{'dbh'}; - - $IDs = [undef] unless defined $IDs; - $idCol = 'id' unless defined $idCol; - foreach my $id (@$IDs) { - my $sql = "DELETE FROM $table"; - if (defined $id) { - $sql .= " WHERE $idCol = " . $self->quote($id); - if (defined $additionalWhereClause) { - $sql .= $additionalWhereClause; - } - } - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); - } - return 1; -} - -sub _doUpdate -{ - my $self = shift; - my $table = shift; - my $IDs = shift; - my $valRows = shift; - - my $dbh = $self->{'dbh'}; - my $valRow = (@$valRows)[0]; - return 1 if !defined $valRow || !scalar keys %$valRow; - - my $idx = 0; - foreach my $valRow (@$valRows) { - my $id = $IDs->[$idx++]; - my %valData = %$valRow; - # fail if asked to change the column 'id', as that is bogus - return if exists $valData{id} && $valData{id} ne $id; - # filter column 'id' if present, as we don't want to write it - delete $valData{id}; - my @cols = map { "$_ = " . $self->quote($valRow->{$_}) } - grep { $_ ne 'id' } - # filter column 'id' if present, as we don't want - # to update it! - keys %$valRow; - next if !@cols; - my $cols = join ', ', @cols; - my $sql = "UPDATE $table SET $cols"; - if (defined $id) { - $sql .= " WHERE id = " . $self->quote($id); - } - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); - } - return 1; -} - -sub _updateRefTable -{ - my $self = shift; - my $table = shift; - my $keyID = shift; - my $newValueIDs = shift; - my $keyCol = shift; - my $valueCol = shift; - my $oldValueIDs = shift; - - my %lastValueIDs; - @lastValueIDs{@$oldValueIDs} = (); - - foreach my $valueID (@$newValueIDs) { - if (!exists $lastValueIDs{$valueID}) { - # value-ID is new, create it - my $valRow = { - $keyCol => $keyID, - $valueCol => $valueID, - }; - $self->_doInsert($table, [$valRow]); - } else { - # value-ID already exists, leave as is, but remove from hash: - delete $lastValueIDs{$valueID}; - } - } - - # all the remaining value-IDs need to be removed: - if (scalar keys %lastValueIDs) { - $self->_doDelete($table, [keys %lastValueIDs], - $valueCol, " AND $keyCol='$keyID'"); - } - return 1; -} - -sub _updateOneToManyRefAttr -{ - my $self = shift; - my $table = shift; - my $oneID = shift; - my $newManyIDs = shift; - my $fkCol = shift; - my $oldManyIDs = shift; - - my %lastManyIDs; - @lastManyIDs{@$oldManyIDs} = (); - - foreach my $id (@$newManyIDs) { - if (!exists $lastManyIDs{$id}) { - # ID has changed, update it - $self->_doUpdate($table, $id, [{$fkCol => $oneID}]); - } else { - # ID hasn't changed, leave as is, but remove from hash: - delete $lastManyIDs{$id}; - } - } - - # all the remaining many-IDs need to be set to 0: - foreach my $id (scalar keys %lastManyIDs) { - $self->_doUpdate($table, $id, [{$fkCol => '0'}]); - } - return 1; -} - -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 addInstalledPlugin -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $newAttrs = shift; - - return if !defined $vendorOSID || !$pluginName; - - my $installedPlugin - = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); - if (!$installedPlugin) { - return if !$self->_doInsert('installed_plugin', [ { - vendor_os_id => $vendorOSID, - plugin_name => $pluginName, - } ] ); - $installedPlugin - = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); - } - return if !$installedPlugin; - - # determine the required attribute actions ... - my $oldAttrs = $installedPlugin->{attrs} || {}; - my @attrsToBeInserted - = grep { - exists $newAttrs->{$_} && !exists $oldAttrs->{$_} - } keys %$newAttrs; - my @attrsToBeDeleted = grep { !exists $newAttrs->{$_} } keys %$oldAttrs; - my @attrsToBeUpdated - = grep { - exists $newAttrs->{$_} && exists $oldAttrs->{$_} - && ($oldAttrs->{$_}->{value} || '-') ne ($newAttrs->{$_} || '-') - } keys %$newAttrs; - - # ... insert the new ones ... - my @attrData - = map { - { - installed_plugin_id => $installedPlugin->{id}, - name => $_, - value => $newAttrs->{$_}, - } - } - @attrsToBeInserted; - $self->_doInsert('installed_plugin_attr', \@attrData); - - # ... delete the old ones ... - my @oldIDs = map { $oldAttrs->{$_}->{id} } @attrsToBeDeleted; - $self->_doDelete('installed_plugin_attr', \@oldIDs); - - # ... and update the changed ones ... - my @IDs = map { $oldAttrs->{$_}->{id} } @attrsToBeUpdated; - @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; - $self->_doUpdate('installed_plugin_attr', \@IDs, \@attrData); - - return 1; -} - -sub removeInstalledPlugin -{ - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - - return if !defined $vendorOSID || !$pluginName; - - my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName); - return if !$plugin; - return if !$self->_doDelete( - 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id' - ); - return $self->_doDelete('installed_plugin', [ $plugin->{id} ] ); -} - -sub addExport -{ - my $self = shift; - my $valRows = shift; - - return $self->_doInsert('export', $valRows); -} - -sub removeExport -{ - my $self = shift; - my $exportIDs = shift; - - return $self->_doDelete('export', $exportIDs); -} - -sub changeExport -{ - my $self = shift; - my $exportIDs = shift; - my $valRows = shift; - - return $self->_doUpdate('export', $exportIDs, $valRows); -} - -sub changeGlobalInfo -{ - my $self = shift; - my $id = shift; - my $value = shift; - - return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); -} - -sub addSystem -{ - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; - - # ... store the systems to get the IDs ... - my @systemIDs = $self->_doInsert('system', $valRows); - - # ... finally store the individual attribute sets - foreach my $id (@systemIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setSystemAttrs($id, $attrs); - } - - return @systemIDs; -} - -sub removeSystem -{ - my $self = shift; - my $systemIDs = shift; - - return $self->_doDelete('system', $systemIDs); -} - -sub changeSystem -{ - my $self = shift; - my $systemIDs = shift; - my $valRows = shift; - my $attrValRows = shift; - - # store the attribute hashes individually - foreach my $id (@$systemIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setSystemAttrs($id, $attrs); - } - - # finally update all systems in one go - return $self->_doUpdate('system', $systemIDs, $valRows); -} - -sub setSystemAttrs -{ - my $self = shift; - my $systemID = shift; - my $newAttrs = shift; - - # fetch info about existing attrs - my $sql = "SELECT * FROM system_attr WHERE system_id = $systemID"; - my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); - - # We write undefined attributes for the default system only, such that - # it shows all existing attributes. All other systems never write undefined - # attributes (if they have not defined a specific attribute, it is - # inherited from "above"). We encapsulate that decision in the following - # delegate - my $valueIsOK = sub { - my $value = shift; - return $systemID == 0 || defined $value; - }; - - # determine the required actions ... - my @attrsToBeInserted - = grep { - $valueIsOK->($newAttrs->{$_}) && !exists $oldAttrs{$_} - } keys %$newAttrs; - my @attrsToBeDeleted - = grep { - !exists $newAttrs->{$_} || !$valueIsOK->($newAttrs->{$_}) - } keys %oldAttrs; - my @attrsToBeUpdated - = grep { - $valueIsOK->($newAttrs->{$_}) && exists $oldAttrs{$_} - && ((defined($oldAttrs{$_}->{value}) xor defined($newAttrs->{$_})) - || (defined($oldAttrs{$_}->{value}) && defined($newAttrs->{$_}) - && $oldAttrs{$_}->{value} ne $newAttrs->{$_})) - } keys %$newAttrs; - - # ... insert the new ones ... - my @attrData - = map { - { - system_id => $systemID, - name => $_, - value => $newAttrs->{$_}, - } - } - @attrsToBeInserted; - $self->_doInsert('system_attr', \@attrData); - - # ... delete the old ones ... - my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; - $self->_doDelete('system_attr', \@oldIDs); - - # ... and update the changed ones ... - my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; - @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; - $self->_doUpdate('system_attr', \@IDs, \@attrData); - - return 1; -} - -sub setClientIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $clientIDs = shift; - - my @currClients = $self->fetchClientIDsOfSystem($systemID); - return $self->_updateRefTable( - 'client_system_ref', $systemID, $clientIDs, 'system_id', 'client_id', - \@currClients - ); -} - -sub setGroupIDsOfSystem -{ - my $self = shift; - my $systemID = shift; - my $groupIDs = shift; - - my @currGroups = $self->fetchGroupIDsOfSystem($systemID); - return $self->_updateRefTable( - 'group_system_ref', $systemID, $groupIDs, 'system_id', 'group_id', - \@currGroups - ); -} - -sub addClient -{ - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; - - # ... store the clients to get the IDs ... - my @clientIDs = $self->_doInsert('client', $valRows); - - # ... finally store the individual attribute sets - foreach my $id (@clientIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setClientAttrs($id, $attrs); - } - - return @clientIDs; -} - -sub removeAttributeByName -{ - my $self = shift; - my $attrName = shift; - - return $self->_doDelete('system_attr', [ $attrName ], 'name') - && $self->_doDelete('client_attr', [ $attrName ], 'name') - && $self->_doDelete('group_attr', [ $attrName ], 'name'); -} - -sub removeClient -{ - my $self = shift; - my $clientIDs = shift; - - return $self->_doDelete('client', $clientIDs); -} - -sub changeClient -{ - my $self = shift; - my $clientIDs = shift; - my $valRows = shift; - my $attrValRows = shift; - - # store the attribute hashes individually - foreach my $id (@$clientIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setClientAttrs($id, $attrs); - } - - # finally update all systems in one go - return $self->_doUpdate('client', $clientIDs, $valRows); -} - -sub setClientAttrs -{ - my $self = shift; - my $clientID = shift; - my $newAttrs = shift; - - # fetch info about existing attrs - my $sql = "SELECT * FROM client_attr WHERE client_id = $clientID"; - my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); - - # determine the required actions ... - my @attrsToBeInserted - = grep { - defined $newAttrs->{$_} && !exists $oldAttrs{$_} - } keys %$newAttrs; - my @attrsToBeDeleted = grep { !defined $newAttrs->{$_} } keys %oldAttrs; - my @attrsToBeUpdated - = grep { - defined $newAttrs->{$_} && exists $oldAttrs{$_} - && ($oldAttrs{$_}->{value} || '') ne ($newAttrs->{$_} || '') - } keys %$newAttrs; - - # ... insert the new ones ... - my @attrData - = map { - { - client_id => $clientID, - name => $_, - value => $newAttrs->{$_}, - } - } - @attrsToBeInserted; - $self->_doInsert('client_attr', \@attrData); - - # ... delete the old ones ... - my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; - $self->_doDelete('client_attr', \@oldIDs); - - # ... and update the changed ones ... - my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; - @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; - $self->_doUpdate('client_attr', \@IDs, \@attrData); - - return 1; -} - -sub setSystemIDsOfClient -{ - my $self = shift; - my $clientID = shift; - my $systemIDs = shift; - - my @currSystems = $self->fetchSystemIDsOfClient($clientID); - return $self->_updateRefTable( - 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id', - \@currSystems - ); -} - -sub setGroupIDsOfClient -{ - my $self = shift; - my $clientID = shift; - my $groupIDs = shift; - - my @currGroups = $self->fetchGroupIDsOfClient($clientID); - return $self->_updateRefTable( - 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id', - \@currGroups - ); -} - -sub addGroup -{ - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; - - # ... store the groups to get the IDs ... - my @groupIDs = $self->_doInsert('groups', $valRows); - - # ... finally store the individual attribute sets - foreach my $id (@groupIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setGroupAttrs($id, $attrs); - } - - return @groupIDs; -} - -sub removeGroup -{ - my $self = shift; - my $groupIDs = shift; - - return $self->_doDelete('groups', $groupIDs); -} - -sub changeGroup -{ - my $self = shift; - my $groupIDs = shift; - my $valRows = shift; - my $attrValRows = shift; - - # store the attribute hashes individually - foreach my $id (@$groupIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setGroupAttrs($id, $attrs); - } - - # finally update all groups in one go - return $self->_doUpdate('groups', $groupIDs, $valRows); -} - -sub setGroupAttrs -{ - my $self = shift; - my $groupID = shift; - my $newAttrs = shift; - - # fetch info about existing attrs - my $sql = "SELECT * FROM group_attr WHERE group_id = $groupID"; - my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); - - # determine the required actions ... - my @attrsToBeInserted - = grep { - defined $newAttrs->{$_} && !exists $oldAttrs{$_} - } keys %$newAttrs; - my @attrsToBeDeleted = grep { !defined $newAttrs->{$_} } keys %oldAttrs; - my @attrsToBeUpdated - = grep { - defined $newAttrs->{$_} && exists $oldAttrs{$_} - && ($oldAttrs{$_}->{value} || '') ne ($newAttrs->{$_} || '') - } keys %$newAttrs; - - # ... insert the new ones ... - my @attrData - = map { - { - group_id => $groupID, - name => $_, - value => $newAttrs->{$_}, - } - } - @attrsToBeInserted; - $self->_doInsert('group_attr', \@attrData); - - # ... delete the old ones ... - my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; - $self->_doDelete('group_attr', \@oldIDs); - - # ... and update the changed ones ... - my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; - @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; - $self->_doUpdate('group_attr', \@IDs, \@attrData); - - return 1; -} - -sub setClientIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - my $clientIDs = shift; - - my @currClients = $self->fetchClientIDsOfGroup($groupID); - return $self->_updateRefTable( - 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id', - \@currClients - ); -} - -sub setSystemIDsOfGroup -{ - my $self = shift; - my $groupID = shift; - my $systemIDs = shift; - - my @currSystems = $self->fetchSystemIDsOfGroup($groupID); - return $self->_updateRefTable( - 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id', - \@currSystems - ); -} - -################################################################################ -### 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*$]) { - croak _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*:.+$]) { - croak _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 unless defined $row; - # no entry in meta-table - return $row->{schema_version}; -} - -sub schemaSetDBVersion -{ - my $self = shift; - my $dbVersion = shift; - - $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'") - or croak _tr('Unable to set DB-schema version to %s!', $dbVersion); - - return 1; -} - -sub schemaFetchPluginInfoHashVal -{ - my $self = shift; - - my $row - = $self->{dbh}->selectrow_hashref('SELECT plugin_info_hash FROM meta'); - - return $row->{plugin_info_hash}; -} - -sub schemaSetPluginInfoHashVal -{ - my $self = shift; - my $pluginInfoHashVal = shift; - - $self->{dbh}->do("UPDATE meta SET plugin_info_hash = '$pluginInfoHashVal'") - or croak _tr( - 'Unable to set plugin-info-hash-value to %s!', $pluginInfoHashVal - ); - - return 1; -} - -sub schemaConvertTypeDescrToNative -{ # a default implementation, many DBs need to override... - my $self = shift; - my $typeDescr = lc(shift); - - if ($typeDescr eq 'b') { - return 'integer'; - } elsif ($typeDescr eq 'i') { - return 'integer'; - } elsif ($typeDescr eq 'pk') { - return 'integer primary key'; - } elsif ($typeDescr eq 'fk') { - return 'integer'; - } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { - return "varchar($1)"; - } else { - croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } -} - -sub schemaAddTable -{ - my $self = shift; - my $table = shift; - my $colDescrs = shift; - my $initialVals = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "adding table <$table> to schema...") unless $isSubCmd; - my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $table ($colDescrString)"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); - if (defined $initialVals) { - # don't care about IDs if there's no 'id' column in this table - my $ignoreIDs = ($colDescrString !~ m[\bid\b]); - $self->_doInsert($table, $initialVals, $ignoreIDs); - } - return; -} - -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 croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); - return; -} - -sub schemaRenameTable -{ # a rather simple-minded implementation that renames a table in several - # steps: - # - create the new table - # - copy the data over from the old one - # - drop the old table - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which - # is much more efficient). - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; - my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $newTable ($colDescrString)"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); - $self->_doInsert($newTable, \@dataRows); - $sql = "DROP TABLE $oldTable"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); - return; -} - -sub schemaAddColumns -{ # a rather simple-minded implementation that adds columns to a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE <table> ADD COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); - my $newColStr = join ', ', @newColNames; - vlog(1, "adding columns <$newColStr> to table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - # N.B.: for the insert, we rely on the caller having added the new - # columns to the end of the table (if that isn't the case, things - # break here!) - - if (defined $newColDefaultVals) { - # default values have been provided, we apply them now: - $self->_doUpdate($tempTable, undef, $newColDefaultVals); - } - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; -} - -sub schemaDropColumns -{ # a rather simple-minded implementation that drops columns from a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <table> DROP COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $dropColStr = join ', ', @$dropColNames; - vlog(1, "dropping columns <$dropColStr> from table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; -} - -sub schemaChangeColumns -{ # a rather simple-minded implementation that changes columns - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <table> CHANGE COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> of table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - foreach my $oldCol (keys %$colChanges) { - my $newCol = - $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); - # rename current column in all data-rows: - foreach my $row (@dataRows) { - $row->{$newCol} = $row->{$oldCol}; - delete $row->{$oldCol}; - } - } - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; -} - -1; - -=head1 NAME - -DBI.pm - provides DBI-based implementation of the OpenSLX MetaDB API. - -=head1 SYNOPSIS - -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. - -=head1 NOTES - -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. - diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm deleted file mode 100644 index 0846582f..00000000 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ /dev/null @@ -1,130 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# SQLite.pm -# - provides SQLite-specific overrides of the OpenSLX MetaDB API. -# ----------------------------------------------------------------------------- -package OpenSLX::MetaDB::SQLite; - -use strict; -use warnings; - -use base qw(OpenSLX::MetaDB::DBI); - -################################################################################ -### This class provides a MetaDB backend for SQLite databases. -### - by default the db will be created inside a 'openslxdata-sqlite' directory. -################################################################################ -use DBD::SQLite; -use OpenSLX::Basics; - -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub databaseExists -{ - my $self = shift; - - my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; - return -e $fullDBPath; -} - -sub dropDatabase -{ - my $self = shift; - - if ($self->{dbh}) { - die "need to disconnect before you can drop the database!"; - } - - my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; - system("rm -rf $fullDBPath") if -e $fullDBPath; -} - -sub connect ## no critic (ProhibitBuiltinHomonyms) -{ - my $self = shift; - - my $dbSpec = $openslxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - my $dbPath = $self->_getDBPath; - system("mkdir -p $dbPath") unless -e $dbPath; - $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; - } - vlog(1, "trying to connect to SQLite-database <$dbSpec>"); - $self->{'dbh'} = DBI->connect( - "dbi:SQLite:$dbSpec", undef, undef, - {PrintError => 0, AutoCommit => 1, sqlite_unicode => 1} - ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); - return 1; -} - -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 croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr)); - return; -} - -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 croak(_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); - } - return; -} - -sub _getDBPath -{ - my $self = shift; - - return "$openslxConfig{'private-path'}/db/sqlite"; -} - -1; diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm deleted file mode 100644 index 82487191..00000000 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ /dev/null @@ -1,179 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# mysql.pm -# - provides mysql-specific overrides of the OpenSLX MetaDB API. -# ----------------------------------------------------------------------------- -package OpenSLX::MetaDB::mysql; - -use strict; -use warnings; - -use base qw(OpenSLX::MetaDB::DBI); - -################################################################################ -### This class provides a MetaDB backend for mysql databases. -### - by default the db will be created inside a 'openslxdata-mysql' directory. -################################################################################ -use DBD::mysql; -use OpenSLX::Basics; -use OpenSLX::Utils; - -################################################################################ -### implementation -################################################################################ -sub new -{ - my $class = shift; - my $self = {}; - return bless $self, $class; -} - -sub connect ## no critic (ProhibitBuiltinHomonyms) -{ - my $self = shift; - - my $dbSpec = $openslxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - $dbSpec = "database=$openslxConfig{'db-name'}"; - } - my $dbUser - = $openslxConfig{'db-user'} - ? $openslxConfig{'db-user'} - : (getpwuid($>))[0]; - my $dbPasswd = $openslxConfig{'db-passwd'}; - if (!defined $dbPasswd) { - $dbPasswd = readPassword("db-password> "); - } - - vlog(1, "trying to connect user '$dbUser' to mysql-database '$dbSpec'"); - $self->{'dbh'} = DBI->connect( - "dbi:mysql:$dbSpec", $dbUser, $dbPasswd, { - PrintError => 0, - mysql_auto_reconnect => 1, - } - ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); - return 1; -} - -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 { - croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } - return; -} - -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 croak _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); - return; -} - -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 croak _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); - } - return; -} - -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 croak _tr(q[Can't drop columns from table <%s> (%s)], $table, - $dbh->errstr); - return; -} - -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 croak _tr(q[Can't change columns in table <%s> (%s)], $table, - $dbh->errstr); - return; -} - -1; |