diff options
Diffstat (limited to 'src/config-db/OpenSLX/ConfigDB.pm')
| -rw-r--r-- | src/config-db/OpenSLX/ConfigDB.pm | 3190 |
1 files changed, 3190 insertions, 0 deletions
diff --git a/src/config-db/OpenSLX/ConfigDB.pm b/src/config-db/OpenSLX/ConfigDB.pm new file mode 100644 index 00000000..89011246 --- /dev/null +++ b/src/config-db/OpenSLX/ConfigDB.pm @@ -0,0 +1,3190 @@ +# 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; |