# 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' => '<<>>'}) # 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 (connection handling) =item - L (getting data) =item - L (adding, removing and changing data) =item - L (getting info about the resulting configurations after mixing individual client-, group- and system- configurations). =item - L (useful helpers) =back =head1 Special Concepts =over =item C 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 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 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 Tears down the connection to the database and cleans up. =cut sub disconnect { my $self = shift; $self->{'meta-db'}->disconnect(); return 1; } =item C 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 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 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 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 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 Returns the names of the columns of the given table. =over =item Param C 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 Fetches and returns information about all vendor-OSes that match the given filter. =over =item Param C A hash-ref containing the filter criteria that shall be applied - default is no filtering. See L for more info. =item Param C 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 Fetches and returns information the vendor-OSes with the given IDs. =over =item Param C An array of the vendor-OS-IDs you are interested in. =item Param C 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 Returns the names of all plugins that have been installed into the given vendor-OS. =over =item Param C The id of the vendor-OS whose plugins you are interested in =item Param C [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 Fetches and returns information about all exports that match the given filter. =over =item Param C A hash-ref containing the filter criteria that shall be applied - default is no filtering. See L for more info. =item Param C 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 Fetches and returns information the exports with the given IDs. =over =item Param C An array of the export-IDs you are interested in. =item Param C 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 Fetches the IDs of all exports that make use of the vendor-OS with the given ID. =over =item Param C 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 Fetches the global info element specified by the given ID. =over =item Param C 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 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 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 Fetches and returns information the systems with the given IDs. =over =item Param C An array of the system-IDs you are interested in. =item Param C 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 Fetches the IDs of all systems that make use of the export with the given ID. =over =item Param C 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 Fetches the IDs of all systems that are used by the client with the given ID. =over =item Param C 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 Fetches the IDs of all systems that are part of the group with the given ID. =over =item Param C 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 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 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 Fetches and returns information the clients with the given IDs. =over =item Param C An array of the client-IDs you are interested in. =item Param C 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 Fetches the IDs of all clients that make use of the system with the given ID. =over =item Param C 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 Fetches the IDs of all clients that are part of the group with the given ID. =over =item Param C 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 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 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 Fetches and returns information the groups with the given IDs. =over =item Param C An array of the group-IDs you are interested in. =item Param C 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 Fetches the IDs of all groups that contain the system with the given ID. =over =item Param C 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 Fetches the IDs of all groups that contain the client with the given ID. =over =item Param C 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 Adds one or more vendor-OS to the database. =over =item Param C 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 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 Removes one or more vendor-OS from the database. =over =item Param C 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 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 Changes the data of one or more vendor-OS. =over =item Param C An array-ref containing the IDs of the vendor-OSes that shall be changed. =item Param C 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 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 Adds a freshly installed plugin to a vendor-OS. =over =item Param C The id of the vendor-OS the given plugin has been installed into =item Param C The name of the plugin that has been installed =item Return Value The ID of the new reference entry, C 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 Removes a uninstalled plugin for a vendor-OS. =over =item Param C The id of the vendor-OS the given plugin has been uninstalled from =item Param C The name of the plugin that has been uninstalled =item Return Value 1 if it worked, C 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 Adds one or more export to the database. =over =item Param C 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 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 Removes one or more export from the database. =over =item Param C 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 if not. =back =cut sub removeExport { my $self = shift; my $exportIDs = _aref(shift); return $self->{'meta-db'}->removeExport($exportIDs); } =item C Changes the data of one or more export. =over =item Param C An array-ref containing the IDs of the exports that shall be changed. =item Param C 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 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 Increments the global counter of the given name and returns the *old* value. =over =item Param C 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 Sets the global info element specified by the given ID to the given value. =over =item Param C The ID specifying the global info you'd like to change. =item Param C 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 Adds one or more systems to the database. =over =item Param C 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 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 Removes one or more systems from the database. =over =item Param C 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 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 Changes the data of one or more systems. =over =item Param C An array-ref containing the IDs of the systems that shall be changed. =item Param C 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 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 # #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 # #The ID of the system whose attribute shall be changed. # #=item Param C # #The name of the attribute to change. # #=item Param C # #The new value for the attribute. # #=item Return Value # #C<1> if the attribute could be set, C 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 Specifies all clients that should offer the given system for booting. =over =item Param C The ID of the system whose clients you'd like to specify. =item Param C 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 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 Add one or more clients to the set that should offer the given system for booting. =over =item Param C The ID of the system that you wish to add the clients to. =item Param C 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 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 Removes the connection between the given clients and the given system. =over =item Param C The ID of the system you'd like to remove groups from. =item Param C 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 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 Specifies all groups that should offer the given system for booting. =over =item Param C The ID of the system whose groups you'd like to specify. =item Param C 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 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 Add one or more groups to the set that should offer the given system for booting. =over =item Param C The ID of the system that you wish to add the groups to. =item Param C 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 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 Removes the connection between the given groups and the given system. =over =item Param C The ID of the system you'd like to remove groups from. =item Param C 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 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 Adds one or more clients to the database. =over =item Param C 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 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 Removes one or more clients from the database. =over =item Param C 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 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 Changes the data of one or more clients. =over =item Param C An array-ref containing the IDs of the clients that shall be changed. =item Param C 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 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 # #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 # #The ID of the client whose attribute shall be changed. # #=item Param C # #The name of the attribute to change. # #=item Param C # #The new value for the attribute. # #=item Return Value # #C<1> if the attribute could be set, C 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 Specifies all systems that should be offered for booting by the given client. =over =item Param C The ID of the client whose systems you'd like to specify. =item Param C 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 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 Adds some systems to the set that should be offered for booting by the given client. =over =item Param C The ID of the client to which you'd like to add systems to. =item Param C 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 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 Removes some systems from the set that should be offered for booting by the given client. =over =item Param C The ID of the client to which you'd like to remove systems from. =item Param C 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 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 Specifies all groups that the given client shall be part of. =over =item Param C The ID of the client whose groups you'd like to specify. =item Param C 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 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 Adds the given client to the given groups. =over =item Param C The ID of the client that you'd like to add to the given groups. =item Param C 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 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 Removes the given client from the given groups. =over =item Param C The ID of the client that you'd like to remove from the given groups. =item Param C 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 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 Adds one or more groups to the database. =over =item Param C 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 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 Removes one or more groups from the database. =over =item Param C 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 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 # #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 # #The ID of the group whose attribute shall be changed. # #=item Param C # #The name of the attribute to change. # #=item Param C # #The new value for the attribute. # #=item Return Value # #C<1> if the attribute could be set, C 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 Changes the data of one or more groups. =over =item Param C An array-ref containing the IDs of the groups that shall be changed. =item Param C 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 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 Specifies all clients that should be part of the given group. =over =item Param C The ID of the group whose clients you'd like to specify. =item Param C 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 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 Add some clients to the given group. =over =item Param C The ID of the group to which you'd like to add clients. =item Param C 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 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 Remove some clients from the given group. =over =item Param C The ID of the group from which you'd like to remove clients. =item Param C 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 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 Specifies all systems that should be offered for booting by the given group. =over =item Param C The ID of the group whose systems you'd like to specify. =item Param C 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 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 Adds some systems to the set that should be offered for booting by the given group. =over =item Param C The ID of the group to which you'd like to add systems. =item Param C 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 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 Removes some systems from the set that should be offered for booting by the given group. =over =item Param C The ID of the group from which you'd like to remove systems. =item Param C 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 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 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 '<<>>' } $self->fetchClientByFilter(); $self->removeClient(\@clientIDs); my @sysIDs = map { $_->{id} } grep { $_->{name} ne '<<>>' } $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 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 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 => '<<>>'}); mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); # finally push the attributes specified for the default client (these # overrule anything else) my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); pushAttributes($system, $defaultClient, $originInfo, 'default-client'); return 1; } =item C merges default and group configurations into the given client hash. =over =item Param C 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 => '<<>>'}); mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); return 1; } =item C 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 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 => '<<>>'}); push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); return _unique(@systemIDs); } =item C 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 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 => '<<>>'}); 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 => '<<>>'}); push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); return _unique(@clientIDs); } =item C Returns aggregated information about the kernel and initialramfs this system is using. =over =item Param C 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 Copies all attributes from source that are unset in target over (source extends target). =over =item Param C The hash to be used as copy target. =item Param C 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 Copies all attributes that are set in source into the target (source overrules target). =over =item Param C The hash to be used as copy target. =item Param C 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 Returns the given system's name as an external ID - worked into a state that is usable as a filename. =over =item Param C 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 '<<>>'; my $name = $system->{name}; $name =~ tr[/][_]; return $name; } =item C Returns the given client's MAC as an external ID - worked into a state that is usable as a filename. =over =item Param C 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 '<<>>'; my $mac = lc($client->{mac}); # PXE seems to expect MACs being all lowercase $mac =~ tr[:][-]; return "01-$mac"; } =item C Returns the given client's name as an external ID - worked into a state that is usable as a filename. =over =item Param C 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 '<<>>'; my $name = $client->{name}; $name =~ tr[/][_]; return $name; } =item C Returns the given variable as a placeholder - surrounded by '@@@' markers. =over =item Param C 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;