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