From a0ce0340d0f95514008cfac751fe58748bbadd88 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Thu, 20 Mar 2008 00:04:16 +0000 Subject: * Switched indent used in Perl-code and settings files from tabs to 4 spaces. May need some manual corrections here and there, but should basically be ok. git-svn-id: http://svn.openslx.org/svn/openslx/openslx/trunk@1658 95ad53e4-c205-0410-b2fa-d234c58c8868 --- config-db/OpenSLX/AttributeRoster.pm | 768 ++++----- config-db/OpenSLX/ConfigDB.pm | 1466 ++++++++--------- config-db/OpenSLX/ConfigExport/DHCP/ISC.pm | 20 +- config-db/OpenSLX/DBSchema.pm | 1292 +++++++-------- config-db/OpenSLX/MetaDB/Base.pm | 20 +- config-db/OpenSLX/MetaDB/DBI.pm | 1978 +++++++++++------------ config-db/OpenSLX/MetaDB/SQLite.pm | 138 +- config-db/OpenSLX/MetaDB/mysql.pm | 234 +-- config-db/devel-tools/test-config-db.pl | 174 +- config-db/devel-tools/test-config-demuxer.pl | 202 +-- config-db/slxconfig | 2246 +++++++++++++------------- config-db/slxconfig-demuxer | 1184 +++++++------- config-db/t/01-basics.t | 6 +- config-db/t/10-vendor-os.t | 166 +- config-db/t/11-export.t | 160 +- config-db/t/12-system.t | 304 ++-- config-db/t/13-client.t | 298 ++-- config-db/t/14-group.t | 282 ++-- config-db/t/15-global_info.t | 18 +- config-db/t/20-client_system_ref.t | 166 +- config-db/t/21-group_system_ref.t | 154 +- config-db/t/22-group_client_ref.t | 146 +- config-db/t/25-attributes.t | 1044 ++++++------ config-db/t/29-transaction.t | 2 +- config-db/t/run-all-tests.pl | 4 +- 25 files changed, 6236 insertions(+), 6236 deletions(-) (limited to 'config-db') diff --git a/config-db/OpenSLX/AttributeRoster.pm b/config-db/OpenSLX/AttributeRoster.pm index a44da03b..c37421c8 100644 --- a/config-db/OpenSLX/AttributeRoster.pm +++ b/config-db/OpenSLX/AttributeRoster.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # AttributeRoster.pm -# - provides information about all available attributes +# - provides information about all available attributes # ----------------------------------------------------------------------------- package OpenSLX::AttributeRoster; @@ -32,344 +32,344 @@ my %AttributeInfo; # 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 => '', - }, - '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', - }, - 'dm_allow_shutdown' => { - 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 => 'user', - }, - 'hw_graphic' => { - 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 => '', - }, - 'hw_monitor' => { - 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 => '', - }, - 'hw_mouse' => { - 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 => '', - }, - 'netbios_workgroup' => { - 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 => 'slx-network', - }, - 'nis_domain' => { - 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 => '', - }, - 'nis_servers' => { - 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 => '', - }, - '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 => undef, - content_descr => undef, - default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', - }, - 'sane_scanner' => { - 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 => '', - }, - '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 => '', - }, - 'slxgrp' => { - 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_alsasound' => { - 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_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_printer' => { - 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_samba' => { - 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 => 'may', - }, - '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', - }, - 'start_syslogd' => { - 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_x' => { - 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_xdmcp' => { - 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 => 'kdm', - }, - 'tex_enable' => { - 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', - }, - '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', - }, - 'tvout' => { - 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', - }, - 'vmware' => { - 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', - }, - ); - - # and add all plugin attributes, too - OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); + 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 => '', + }, + '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', + }, + 'dm_allow_shutdown' => { + 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 => 'user', + }, + 'hw_graphic' => { + 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 => '', + }, + 'hw_monitor' => { + 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 => '', + }, + 'hw_mouse' => { + 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 => '', + }, + 'netbios_workgroup' => { + 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 => 'slx-network', + }, + 'nis_domain' => { + 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 => '', + }, + 'nis_servers' => { + 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 => '', + }, + '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 => undef, + content_descr => undef, + default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + }, + 'sane_scanner' => { + 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 => '', + }, + '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 => '', + }, + 'slxgrp' => { + 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_alsasound' => { + 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_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_printer' => { + 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_samba' => { + 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 => 'may', + }, + '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', + }, + 'start_syslogd' => { + 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_x' => { + 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_xdmcp' => { + 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 => 'kdm', + }, + 'tex_enable' => { + 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', + }, + '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', + }, + 'tvout' => { + 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', + }, + 'vmware' => { + 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', + }, + ); + + # and add all plugin attributes, too + OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); } =item C @@ -388,33 +388,33 @@ An hash-ref with info about all known attributes. 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; + 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 @@ -433,16 +433,16 @@ An array of attribute names. sub getStage3Attrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { - $AttributeInfo{$_}->{applies_to_systems} - || $AttributeInfo{$_}->{applies_to_client} - } - keys %AttributeInfo + return + grep { + $AttributeInfo{$_}->{applies_to_systems} + || $AttributeInfo{$_}->{applies_to_client} + } + keys %AttributeInfo } =item C @@ -461,13 +461,13 @@ An array of attribute names. sub getSystemAttrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { $AttributeInfo{$_}->{"applies_to_systems"} } - keys %AttributeInfo + return + grep { $AttributeInfo{$_}->{"applies_to_systems"} } + keys %AttributeInfo } =item C @@ -486,13 +486,13 @@ An array of attribute names. sub getClientAttrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { $AttributeInfo{$_}->{"applies_to_clients"} } - keys %AttributeInfo + return + grep { $AttributeInfo{$_}->{"applies_to_clients"} } + keys %AttributeInfo } 1; diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm index 8382f066..324a3cf2 100644 --- a/config-db/OpenSLX/ConfigDB.pm +++ b/config-db/OpenSLX/ConfigDB.pm @@ -111,13 +111,13 @@ Returns an object representing a database handle to the config database. sub new { - my $class = shift; + my $class = shift; - my $self = { - 'db-schema' => OpenSLX::DBSchema->new, - }; + my $self = { + 'db-schema' => OpenSLX::DBSchema->new, + }; - return bless $self, $class; + return bless $self, $class; } =item C @@ -145,49 +145,49 @@ The precise name of the database that should be connected (defaults to 'openslx' =cut -sub connect ## no critic (ProhibitBuiltinHomonyms) +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 $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 $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.' - ); - } + 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-type'} = $dbType; + $self->{'meta-db'} = $metaDB; - $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self); + $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self); - return 1; + return 1; } =item C @@ -198,11 +198,11 @@ Tears down the connection to the database and cleans up. sub disconnect { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->disconnect(); + $self->{'meta-db'}->disconnect(); - return 1; + return 1; } =item C @@ -214,11 +214,11 @@ changes apply as a whole or not at all. sub startTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->startTransaction(); + $self->{'meta-db'}->startTransaction(); - return 1; + return 1; } =item C @@ -230,11 +230,11 @@ will be applied to the database. sub commitTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->commitTransaction(); + $self->{'meta-db'}->commitTransaction(); - return 1; + return 1; } =item C @@ -246,11 +246,11 @@ will be undone. sub rollbackTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->rollbackTransaction(); + $self->{'meta-db'}->rollbackTransaction(); - return 1; + return 1; } =back @@ -281,10 +281,10 @@ An array of column names. sub getColumnsOfTable { - my $self = shift; - my $tableName = shift; + my $self = shift; + my $tableName = shift; - return $self->{'db-schema'}->getColumnsOfTable($tableName); + return $self->{'db-schema'}->getColumnsOfTable($tableName); } =item C @@ -313,14 +313,14 @@ An array of hash-refs containing the resulting data rows. sub fetchVendorOSByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - my @vendorOS - = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); + my @vendorOS + = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); - return wantarray() ? @vendorOS : shift @vendorOS; + return wantarray() ? @vendorOS : shift @vendorOS; } =item C @@ -347,13 +347,13 @@ An array of hash-refs containing the resulting data rows. sub fetchVendorOSByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); + my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); - return wantarray() ? @vendorOS : shift @vendorOS; + return wantarray() ? @vendorOS : shift @vendorOS; } =item C @@ -381,11 +381,11 @@ An array with the plugin names. sub fetchInstalledPlugins { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); + $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); } =item C @@ -414,13 +414,13 @@ An array of hash-refs containing the resulting data rows. sub fetchExportByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); + my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); - return wantarray() ? @exports : shift @exports; + return wantarray() ? @exports : shift @exports; } =item C @@ -447,13 +447,13 @@ An array of hash-refs containing the resulting data rows. sub fetchExportByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); + my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); - return wantarray() ? @exports : shift @exports; + return wantarray() ? @exports : shift @exports; } =item C @@ -476,10 +476,10 @@ An array of system-IDs. sub fetchExportIDsOfVendorOS { - my $self = shift; - my $vendorOSID = shift; + my $self = shift; + my $vendorOSID = shift; - return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); + return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); } =item C @@ -502,10 +502,10 @@ The value of the requested global info. sub fetchGlobalInfo { - my $self = shift; - my $id = shift; + my $self = shift; + my $id = shift; - return $self->{'meta-db'}->fetchGlobalInfo($id); + return $self->{'meta-db'}->fetchGlobalInfo($id); } =item C @@ -539,25 +539,25 @@ An array of hash-refs containing the resulting data rows. sub fetchSystemByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @systems = $self->{'meta-db'}->fetchSystemByFilter( - $filter, $resultCols, $attrFilter - ); + 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}); - } - } + # 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; + return wantarray() ? @systems : shift @systems; } =item C @@ -584,22 +584,22 @@ An array of hash-refs containing the resulting data rows. sub fetchSystemByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + 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}); - } - } + 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; + return wantarray() ? @systems : shift @systems; } =item C @@ -622,10 +622,10 @@ An array of system-IDs. sub fetchSystemIDsOfExport { - my $self = shift; - my $exportID = shift; + my $self = shift; + my $exportID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); + return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); } =item C @@ -649,10 +649,10 @@ An array of system-IDs. sub fetchSystemIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); } =item C @@ -676,10 +676,10 @@ An array of system-IDs. sub fetchSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); } =item C @@ -708,25 +708,25 @@ An array of hash-refs containing the resulting data rows. sub fetchClientByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @clients = $self->{'meta-db'}->fetchClientByFilter( - $filter, $resultCols, $attrFilter - ); + 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}); - } - } + # 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; + return wantarray() ? @clients : shift @clients; } =item C @@ -753,22 +753,22 @@ An array of hash-refs containing the resulting data rows. sub fetchClientByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); + 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}); - } - } + # 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; + return wantarray() ? @clients : shift @clients; } =item C @@ -792,10 +792,10 @@ An array of client-IDs. sub fetchClientIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); } =item C @@ -819,10 +819,10 @@ An array of client-IDs. sub fetchClientIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); } =item C @@ -851,25 +851,25 @@ An array of hash-refs containing the resulting data rows. sub fetchGroupByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @groups = $self->{'meta-db'}->fetchGroupByFilter( - $filter, $resultCols, $attrFilter - ); + 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}); - } - } + # 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; + return wantarray() ? @groups : shift @groups; } =item C @@ -896,22 +896,22 @@ An array of hash-refs containing the resulting data rows. sub fetchGroupByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); + 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}); - } - } + # 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; + return wantarray() ? @groups : shift @groups; } =item C @@ -935,10 +935,10 @@ An array of client-IDs. sub fetchGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); } =item C @@ -962,10 +962,10 @@ An array of client-IDs. sub fetchGroupIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); } =back @@ -994,13 +994,13 @@ The IDs of the new vendor-OS(es), C if the creation failed. sub addVendorOS { - my $self = shift; - my $valRows = _aref(shift); + my $self = shift; + my $valRows = _aref(shift); - _checkCols($valRows, 'vendor_os', 'name'); + _checkCols($valRows, 'vendor_os', 'name'); - my @IDs = $self->{'meta-db'}->addVendorOS($valRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addVendorOS($valRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1023,19 +1023,19 @@ C<1> if the vendorOS(es) could be removed, C if not. sub removeVendorOS { - my $self = shift; - my $vendorOSIDs = _aref(shift); + 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); + # 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 @@ -1062,11 +1062,11 @@ C<1> if the vendorOS(es) could be changed, C if not. sub changeVendorOS { - my $self = shift; - my $vendorOSIDs = _aref(shift); - my $valRows = _aref(shift); + my $self = shift; + my $vendorOSIDs = _aref(shift); + my $valRows = _aref(shift); - return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); + return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); } =item C @@ -1093,17 +1093,17 @@ The ID of the new reference entry, C if the creation failed. sub addInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $pluginAttrs = shift || {}; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $pluginAttrs = shift || {}; - # make sure the attributes of this plugin are available via default system - $self->{'db-schema'}->synchronizeAttributesWithDefaultSystem($self); + # make sure the attributes of this plugin are available via default system + $self->{'db-schema'}->synchronizeAttributesWithDefaultSystem($self); - return $self->{'meta-db'}->addInstalledPlugin( - $vendorOSID, $pluginName, $pluginAttrs - ); + return $self->{'meta-db'}->addInstalledPlugin( + $vendorOSID, $pluginName, $pluginAttrs + ); } =item C @@ -1130,11 +1130,11 @@ The name of the plugin that has been uninstalled sub removeInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); + return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); } =item C @@ -1157,13 +1157,13 @@ The IDs of the new export(s), C if the creation failed. sub addExport { - my $self = shift; - my $valRows = _aref(shift); + my $self = shift; + my $valRows = _aref(shift); - _checkCols($valRows, 'export', qw(name vendor_os_id type)); + _checkCols($valRows, 'export', qw(name vendor_os_id type)); - my @IDs = $self->{'meta-db'}->addExport($valRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addExport($valRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1186,10 +1186,10 @@ C<1> if the export(s) could be removed, C if not. sub removeExport { - my $self = shift; - my $exportIDs = _aref(shift); + my $self = shift; + my $exportIDs = _aref(shift); - return $self->{'meta-db'}->removeExport($exportIDs); + return $self->{'meta-db'}->removeExport($exportIDs); } =item C @@ -1216,11 +1216,11 @@ C<1> if the export(s) could be changed, C if not. sub changeExport { - my $self = shift; - my $exportIDs = _aref(shift); - my $valRows = _aref(shift); + my $self = shift; + my $exportIDs = _aref(shift); + my $valRows = _aref(shift); - return $self->{'meta-db'}->changeExport($exportIDs, $valRows); + return $self->{'meta-db'}->changeExport($exportIDs, $valRows); } =item C @@ -1243,17 +1243,17 @@ The value the global counter had before it was incremented. sub incrementGlobalCounter { - my $self = shift; - my $counterName = shift; + 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(); + $self->startTransaction(); + my $value = $self->fetchGlobalInfo($counterName); + return unless defined $value; + my $newValue = $value + 1; + $self->changeGlobalInfo($counterName, $newValue); + $self->commitTransaction(); - return $value; + return $value; } =item C @@ -1280,13 +1280,13 @@ The value the global counter had before it was incremented. sub changeGlobalInfo { - my $self = shift; - my $id = shift; - my $value = shift; + my $self = shift; + my $id = shift; + my $value = shift; - return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); + return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); - return $self->{'meta-db'}->changeGlobalInfo($id, $value); + return $self->{'meta-db'}->changeGlobalInfo($id, $value); } =item C @@ -1309,31 +1309,31 @@ The IDs of the new system(s), C if the creation failed. sub addSystem { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'system', qw(name export_id)); + _checkCols($inValRows, 'system', qw(name export_id)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + 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}; - } - } + 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]; + my @IDs = $self->{'meta-db'}->addSystem($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1356,15 +1356,15 @@ C<1> if the system(s) could be removed, C if not. sub removeSystem { - my $self = shift; - my $systemIDs = _aref(shift); + my $self = shift; + my $systemIDs = _aref(shift); - foreach my $system (@$systemIDs) { - $self->setGroupIDsOfSystem($system); - $self->setClientIDsOfSystem($system); - } + foreach my $system (@$systemIDs) { + $self->setGroupIDsOfSystem($system); + $self->setClientIDsOfSystem($system); + } - return $self->{'meta-db'}->removeSystem($systemIDs); + return $self->{'meta-db'}->removeSystem($systemIDs); } =item C @@ -1391,13 +1391,13 @@ C<1> if the system(s) could be changed, C if not. sub changeSystem { - my $self = shift; - my $systemIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $systemIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); } #=item C @@ -1429,12 +1429,12 @@ sub changeSystem # #sub setSystemAttr #{ -# my $self = shift; -# my $systemID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $systemID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); +# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); #} =item C @@ -1462,18 +1462,18 @@ C<1> if the system/client references could be set, C if not. sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $clientIDs = _aref(shift); + 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; + # associating a client to the default system makes no sense + return 0 if $systemID == 0; - my @uniqueClientIDs = _unique(@$clientIDs); + my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfSystem( - $systemID, \@uniqueClientIDs - ); + return $self->{'meta-db'}->setClientIDsOfSystem( + $systemID, \@uniqueClientIDs + ); } =item C @@ -1501,14 +1501,14 @@ C<1> if the system/client references could be set, C if not. sub addClientIDsToSystem { - my $self = shift; - my $systemID = shift; - my $newClientIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $newClientIDs = _aref(shift); - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - push @clientIDs, @$newClientIDs; + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + push @clientIDs, @$newClientIDs; - return $self->setClientIDsOfSystem($systemID, \@clientIDs); + return $self->setClientIDsOfSystem($systemID, \@clientIDs); } =item C @@ -1536,17 +1536,17 @@ C<1> if the system/client references could be set, C if not. sub removeClientIDsFromSystem { - my $self = shift; - my $systemID = shift; - my $removedClientIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $removedClientIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - return $self->setClientIDsOfSystem($systemID, \@clientIDs); + return $self->setClientIDsOfSystem($systemID, \@clientIDs); } =item C @@ -1574,16 +1574,16 @@ C<1> if the system/group references could be set, C if not. sub setGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $groupIDs = _aref(shift); + 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; + # associating a group to the default system makes no sense + return 0 if $systemID == 0; - my @uniqueGroupIDs = _unique(@$groupIDs); + my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); } =item C @@ -1611,14 +1611,14 @@ C<1> if the system/group references could be set, C if not. sub addGroupIDsToSystem { - my $self = shift; - my $systemID = shift; - my $newGroupIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $newGroupIDs = _aref(shift); - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - push @groupIDs, @$newGroupIDs; + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + push @groupIDs, @$newGroupIDs; - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); } =item C @@ -1646,17 +1646,17 @@ C<1> if the system/group references could be set, C if not. sub removeGroupIDsFromSystem { - my $self = shift; - my $systemID = shift; - my $toBeRemovedGroupIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $toBeRemovedGroupIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); } =item C @@ -1679,21 +1679,21 @@ The IDs of the new client(s), C if the creation failed. sub addClient { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'client', qw(name mac)); + _checkCols($inValRows, 'client', qw(name mac)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - foreach my $valRow (@$valRows) { - if (!$valRow->{boot_type}) { - $valRow->{boot_type} = 'pxe'; - } - } + foreach my $valRow (@$valRows) { + if (!$valRow->{boot_type}) { + $valRow->{boot_type} = 'pxe'; + } + } - my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1716,15 +1716,15 @@ C<1> if the client(s) could be removed, C if not. sub removeClient { - my $self = shift; - my $clientIDs = _aref(shift); + my $self = shift; + my $clientIDs = _aref(shift); - foreach my $client (@$clientIDs) { - $self->setGroupIDsOfClient($client); - $self->setSystemIDsOfClient($client); - } + foreach my $client (@$clientIDs) { + $self->setGroupIDsOfClient($client); + $self->setSystemIDsOfClient($client); + } - return $self->{'meta-db'}->removeClient($clientIDs); + return $self->{'meta-db'}->removeClient($clientIDs); } =item C @@ -1751,13 +1751,13 @@ C<1> if the client(s) could be changed, C if not. sub changeClient { - my $self = shift; - my $clientIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $clientIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); } #=item C @@ -1789,12 +1789,12 @@ sub changeClient # #sub setClientAttr #{ -# my $self = shift; -# my $clientID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $clientID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); +# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); #} =item C @@ -1822,16 +1822,16 @@ C<1> if the client/system references could be set, C if not. sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; - my $systemIDs = _aref(shift); + 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); + # 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 - ); + return $self->{'meta-db'}->setSystemIDsOfClient( + $clientID, \@uniqueSystemIDs + ); } =item C @@ -1859,14 +1859,14 @@ C<1> if the client/system references could be set, C if not. sub addSystemIDsToClient { - my $self = shift; - my $clientID = shift; - my $newSystemIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $newSystemIDs = _aref(shift); - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - push @systemIDs, @$newSystemIDs; + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + push @systemIDs, @$newSystemIDs; - return $self->setSystemIDsOfClient($clientID, \@systemIDs); + return $self->setSystemIDsOfClient($clientID, \@systemIDs); } =item C @@ -1894,17 +1894,17 @@ C<1> if the client/system references could be set, C if not. sub removeSystemIDsFromClient { - my $self = shift; - my $clientID = shift; - my $removedSystemIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $removedSystemIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - return $self->setSystemIDsOfClient($clientID, \@systemIDs); + return $self->setSystemIDsOfClient($clientID, \@systemIDs); } =item C @@ -1931,13 +1931,13 @@ C<1> if the client/group references could be set, C if not. sub setGroupIDsOfClient { - my $self = shift; - my $clientID = shift; - my $groupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $groupIDs = _aref(shift); - my @uniqueGroupIDs = _unique(@$groupIDs); + my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); } =item C @@ -1965,14 +1965,14 @@ C<1> if the client/group references could be set, C if not. sub addGroupIDsToClient { - my $self = shift; - my $clientID = shift; - my $newGroupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $newGroupIDs = _aref(shift); - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - push @groupIDs, @$newGroupIDs; + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + push @groupIDs, @$newGroupIDs; - return $self->setGroupIDsOfClient($clientID, \@groupIDs); + return $self->setGroupIDsOfClient($clientID, \@groupIDs); } =item C @@ -2000,17 +2000,17 @@ C<1> if the client/group references could be set, C if not. sub removeGroupIDsFromClient { - my $self = shift; - my $clientID = shift; - my $toBeRemovedGroupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $toBeRemovedGroupIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - return $self->setGroupIDsOfClient($clientID, \@groupIDs); + return $self->setGroupIDsOfClient($clientID, \@groupIDs); } =item C @@ -2033,20 +2033,20 @@ The IDs of the new group(s), C if the creation failed. sub addGroup { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'group', qw(name)); + _checkCols($inValRows, 'group', qw(name)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + 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]; + 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 @@ -2069,15 +2069,15 @@ C<1> if the group(s) could be removed, C if not. sub removeGroup { - my $self = shift; - my $groupIDs = _aref(shift); + my $self = shift; + my $groupIDs = _aref(shift); - foreach my $group (@$groupIDs) { - $self->setSystemIDsOfGroup($group, []); - $self->setClientIDsOfGroup($group, []); - } + foreach my $group (@$groupIDs) { + $self->setSystemIDsOfGroup($group, []); + $self->setClientIDsOfGroup($group, []); + } - return $self->{'meta-db'}->removeGroup($groupIDs); + return $self->{'meta-db'}->removeGroup($groupIDs); } #=item C @@ -2109,12 +2109,12 @@ sub removeGroup # #sub setGroupAttr #{ -# my $self = shift; -# my $groupID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $groupID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); +# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); #} =item C @@ -2141,13 +2141,13 @@ C<1> if the group(s) could be changed, C if not. sub changeGroup { - my $self = shift; - my $groupIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $groupIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); } =item C @@ -2174,13 +2174,13 @@ C<1> if the group/client references could be set, C if not. sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $clientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $clientIDs = _aref(shift); - my @uniqueClientIDs = _unique(@$clientIDs); + my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); + return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); } =item C @@ -2207,14 +2207,14 @@ C<1> if the group/client references could be set, C if not. sub addClientIDsToGroup { - my $self = shift; - my $groupID = shift; - my $newClientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $newClientIDs = _aref(shift); - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - push @clientIDs, @$newClientIDs; + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + push @clientIDs, @$newClientIDs; - return $self->setClientIDsOfGroup($groupID, \@clientIDs); + return $self->setClientIDsOfGroup($groupID, \@clientIDs); } =item C @@ -2241,17 +2241,17 @@ C<1> if the group/client references could be set, C if not. sub removeClientIDsFromGroup { - my $self = shift; - my $groupID = shift; - my $removedClientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $removedClientIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - return $self->setClientIDsOfGroup($groupID, \@clientIDs); + return $self->setClientIDsOfGroup($groupID, \@clientIDs); } =item C @@ -2279,14 +2279,14 @@ C<1> if the group/system references could be set, C if not. sub setSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $systemIDs = _aref(shift); + 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); + # 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); + return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); } =item C @@ -2313,14 +2313,14 @@ C<1> if the group/system references could be set, C if not. sub addSystemIDsToGroup { - my $self = shift; - my $groupID = shift; - my $newSystemIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $newSystemIDs = _aref(shift); - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - push @systemIDs, @$newSystemIDs; + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + push @systemIDs, @$newSystemIDs; - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); } =item C @@ -2347,17 +2347,17 @@ C<1> if the group/system references could be set, C if not. sub removeSystemIDsFromGroup { - my $self = shift; - my $groupID = shift; - my $removedSystemIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $removedSystemIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); } =item C @@ -2375,27 +2375,27 @@ none =cut sub emptyDatabase -{ # clears all user-data from the database - my $self = shift; +{ # clears all user-data from the database + my $self = shift; - my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); - $self->removeGroup(\@groupIDs); + my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); + $self->removeGroup(\@groupIDs); - my @clientIDs = map { $_->{id} } - grep { $_->{name} ne '<<>>' } $self->fetchClientByFilter(); - $self->removeClient(\@clientIDs); + my @clientIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchClientByFilter(); + $self->removeClient(\@clientIDs); - my @sysIDs = map { $_->{id} } - grep { $_->{name} ne '<<>>' } $self->fetchSystemByFilter(); - $self->removeSystem(\@sysIDs); + my @sysIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchSystemByFilter(); + $self->removeSystem(\@sysIDs); - my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); - $self->removeExport(\@exportIDs); + my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); + $self->removeExport(\@exportIDs); - my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); - $self->removeVendorOS(\@vendorOSIDs); + my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); + $self->removeVendorOS(\@vendorOSIDs); - return 1; + return 1; } =back @@ -2425,36 +2425,36 @@ none sub mergeDefaultAttributesIntoSystem { - my $self = shift; - my $system = shift; - my $installedPlugins = shift; - my $originInfo = shift; + my $self = shift; + my $system = shift; + my $installedPlugins = shift; + my $originInfo = shift; - # first look into default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); - mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); + # first look into default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); - # push any attributes found in the plugins that are installed into - # the vendor-OS: - if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { - for my $plugin (@$installedPlugins) { - pushAttributes($system, $plugin, $originInfo, 'vendor-OS'); - } + # push any attributes found in the plugins that are installed into + # the vendor-OS: + if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { + for my $plugin (@$installedPlugins) { + pushAttributes($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}; - } - } + # 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}; + } + } - # finally push the attributes specified for the system itself - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - pushAttributes($system, $defaultClient, $originInfo, 'default-client'); + # finally push the attributes specified for the system itself + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + pushAttributes($system, $defaultClient, $originInfo, 'default-client'); - return 1; + return 1; } =item C @@ -2477,34 +2477,34 @@ none sub mergeDefaultAndGroupAttributesIntoClient { - my $self = shift; - my $client = shift; - my $originInfo = shift; - - # step over all groups this client belongs to - # (ordered by priority from highest to lowest): - my @groupIDs = _unique( - $self->fetchGroupIDsOfClient(0), - $self->fetchGroupIDsOfClient($client->{id}) - ); - my @groups - = sort { $a->{priority} <=> $b->{priority} } - $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # merge configuration from this group into the current client: - vlog( - 3, - _tr('merging from group %d:%s...', $group->{id}, $group->{name}) - ); - mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); - } - - # merge configuration from default client: - vlog(3, _tr('merging from default client...')); - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); - - return 1; + my $self = shift; + my $client = shift; + my $originInfo = shift; + + # step over all groups this client belongs to + # (ordered by priority from highest to lowest): + my @groupIDs = _unique( + $self->fetchGroupIDsOfClient(0), + $self->fetchGroupIDsOfClient($client->{id}) + ); + my @groups + = sort { $a->{priority} <=> $b->{priority} } + $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # merge configuration from this group into the current client: + vlog( + 3, + _tr('merging from group %d:%s...', $group->{id}, $group->{name}) + ); + mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); + } + + # merge configuration from default client: + vlog(3, _tr('merging from default client...')); + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); + + return 1; } =item C @@ -2528,25 +2528,25 @@ A list of unqiue system-IDs. sub aggregatedSystemIDsOfClient { - my $self = shift; - my $client = shift; + my $self = shift; + my $client = shift; - # add all systems directly linked to client: - my @systemIDs = $self->fetchSystemIDsOfClient($client->{id}); + # 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}); - } + # step over all groups this client belongs to: + my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all systems that the client inherits from the current group: + push @systemIDs, $self->fetchSystemIDsOfGroup($group->{id}); + } - # add all systems inherited from default client - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); + # add all systems inherited from default client + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); - return _unique(@systemIDs); + return _unique(@systemIDs); } =item C @@ -2570,36 +2570,36 @@ A list of unqiue client-IDs. sub aggregatedClientIDsOfSystem { - my $self = shift; - my $system = shift; + my $self = shift; + my $system = shift; - # add all clients directly linked to system: - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); + # add all clients directly linked to system: + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); - if (grep { $_ == $defaultClient->{id}; } @clientIDs) { - # add *all* client-IDs if the system is being referenced by - # the default client, as that means that all clients should offer - # this system for booting: - push( - @clientIDs, - map { $_->{id} } $self->fetchClientByFilter(undef, 'id') - ); - } + 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}); - } + # step over all groups this system belongs to: + my @groupIDs = $self->fetchGroupIDsOfSystem($system->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all clients that the system inherits from the current group: + push @clientIDs, $self->fetchClientIDsOfGroup($group->{id}); + } - # add all clients inherited from default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); - push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); + # add all clients inherited from default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); - return _unique(@clientIDs); + return _unique(@clientIDs); } =item C @@ -2624,65 +2624,65 @@ this system, as well as the specific kernel-file and export-URI being used. sub aggregatedSystemFileInfoFor { - my $self = shift; - my $system = shift; - - my $info = dclone($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}, $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; + my $self = shift; + my $system = shift; + + my $info = dclone($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}, $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 @@ -2715,32 +2715,32 @@ none sub mergeAttributes { - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{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; - } - } - } + 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; + return 1; } =item C @@ -2767,28 +2767,28 @@ none sub pushAttributes { - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{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; - } - } - } + 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; + return 1; } =item C @@ -2812,14 +2812,14 @@ The external ID (name) of the given system. sub externalIDForSystem { - my $system = shift; + my $system = shift; - return "default" if $system->{name} eq '<<>>'; + return "default" if $system->{name} eq '<<>>'; - my $name = $system->{name}; - $name =~ tr[/][_]; + my $name = $system->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C @@ -2843,15 +2843,15 @@ The external ID (MAC) of the given client. sub externalIDForClient { - my $client = shift; + my $client = shift; - return "default" if $client->{name} eq '<<>>'; + return "default" if $client->{name} eq '<<>>'; - my $mac = lc($client->{mac}); - # PXE seems to expect MACs being all lowercase - $mac =~ tr[:][-]; + my $mac = lc($client->{mac}); + # PXE seems to expect MACs being all lowercase + $mac =~ tr[:][-]; - return "01-$mac"; + return "01-$mac"; } =item C @@ -2875,14 +2875,14 @@ The external name of the given client. sub externalConfigNameForClient { - my $client = shift; + my $client = shift; - return "default" if $client->{name} eq '<<>>'; + return "default" if $client->{name} eq '<<>>'; - my $name = $client->{name}; - $name =~ tr[/][_]; + my $name = $client->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C @@ -2905,59 +2905,59 @@ The given variable as a placeholder string. sub generatePlaceholderFor { - my $varName = shift; + my $varName = shift; - return '@@@' . $varName . '@@@'; + return '@@@' . $varName . '@@@'; } ################################################################################ ### private stuff ################################################################################ sub _aref -{ # transparently converts the given reference to an array-ref - my $ref = shift; +{ # transparently converts the given reference to an array-ref + my $ref = shift; - return [] unless defined $ref; - $ref = [$ref] unless ref($ref) eq 'ARRAY'; + return [] unless defined $ref; + $ref = [$ref] unless ref($ref) eq 'ARRAY'; - return $ref; + return $ref; } sub _unique -{ # return given array filtered to unique elements - my %seenIDs; - return grep { !$seenIDs{$_}++; } @_; +{ # return given array filtered to unique elements + my %seenIDs; + return grep { !$seenIDs{$_}++; } @_; } sub _checkCols { - my $valRows = shift; - my $table = shift; - my @colNames = @_; + 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}; - } - } + foreach my $valRow (@$valRows) { + foreach my $col (@colNames) { + die "need to set '$col' for $table!" if !$valRow->{$col}; + } + } - return 1; + return 1; } sub _cloneAndUnhingeAttrs { - my $inValRows = shift; + my $inValRows = shift; - # clone data and unhinge attrs - my (@valRows, @attrValRows); - foreach my $inValRow (@$inValRows) { - push @attrValRows, $inValRow->{attrs}; - my $valRow = dclone($inValRow); - delete $valRow->{attrs}; - push @valRows, $valRow; - } + # clone data and unhinge attrs + my (@valRows, @attrValRows); + foreach my $inValRow (@$inValRows) { + push @attrValRows, $inValRow->{attrs}; + my $valRow = dclone($inValRow); + delete $valRow->{attrs}; + push @valRows, $valRow; + } - return (\@valRows, \@attrValRows); + return (\@valRows, \@attrValRows); } 1; diff --git a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm b/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm index e3dd0738..14b427c8 100644 --- a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm +++ b/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # ISC.pm -# - provides ISC-specific implementation of DHCP export. +# - provides ISC-specific implementation of DHCP export. # ----------------------------------------------------------------------------- package OpenSLX::ConfigExport::DHCP::ISC; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version ################################################################################ ### This class provides an ISC specific implementation for DHCP export. @@ -28,18 +28,18 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub execute { - my $self = shift; - my $clients = shift; + my $self = shift; + my $clients = shift; - vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); - foreach my $client (@$clients) { + 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 index 2be6dc7c..1195ddc1 100644 --- a/config-db/OpenSLX/DBSchema.pm +++ b/config-db/OpenSLX/DBSchema.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # DBSchema.pm -# - provides database schema of the OpenSLX config-db. +# - provides database schema of the OpenSLX config-db. # ----------------------------------------------------------------------------- package OpenSLX::DBSchema; @@ -21,220 +21,220 @@ 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) +### 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.29; 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 - 'boot_type:s.20', # type of remote boot procedure (PXE, ...) - 'unbootable:b', # unbootable clients simply won't boot - 'kernel_params:s.128', # client-specific kernel-args (e.g. console) - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default client - 'id' => 0, - 'name' => '<<>>', - 'comment' => 'internal client that holds default values', - 'unbootable' => 0, - }, - ], - }, - '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_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' => [ - 'schema_version:s.5', # schema-version currently implemented by DB - ], - 'vals' => [ - { - '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: - # -- - '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 - 'kernel_params:s.512', # kernel-param string for pxe - 'hidden:b', # hidden systems won't be offered for booting - 'description:s.512',# visible description (for PXE TEXT) - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default system - 'id' => 0, - 'name' => '<<>>', - 'hidden' => 1, - '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 - ], - }, - }, + '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 + 'boot_type:s.20', # type of remote boot procedure (PXE, ...) + 'unbootable:b', # unbootable clients simply won't boot + 'kernel_params:s.128', # client-specific kernel-args (e.g. console) + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default client + 'id' => 0, + 'name' => '<<>>', + 'comment' => 'internal client that holds default values', + 'unbootable' => 0, + }, + ], + }, + '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_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' => [ + 'schema_version:s.5', # schema-version currently implemented by DB + ], + 'vals' => [ + { + '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: + # -- + '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 + 'kernel_params:s.512', # kernel-param string for pxe + 'hidden:b', # hidden systems won't be offered for booting + 'description:s.512',# visible description (for PXE TEXT) + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default system + 'id' => 0, + 'name' => '<<>>', + 'hidden' => 1, + '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 + ], + }, + }, }; ################################################################################ @@ -244,97 +244,97 @@ my $DbSchema = { ################################################################################ sub new { - my $class = shift; + my $class = shift; - my $self = { - }; + my $self = { + }; - return bless $self, $class; + return bless $self, $class; } sub checkAndUpgradeDBSchemaIfNecessary { - my $self = shift; - my $configDB = shift; + my $self = shift; + my $configDB = shift; - my $metaDB = $configDB->{'meta-db'}; + 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'); - } + 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}); - $self->synchronizeAttributesWithDefaultSystem($configDB); - 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); - $self->synchronizeAttributesWithDefaultSystem($configDB); - vlog(1, _tr('upgrade done')); - } else { - vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); - } + 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}); + $self->synchronizeAttributesWithDefaultSystem($configDB); + 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); + $self->synchronizeAttributesWithDefaultSystem($configDB); + vlog(1, _tr('upgrade done')); + } else { + vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); + } - return 1; + return 1; } sub getColumnsOfTable { - my $self = shift; - my $tableName = shift; + my $self = shift; + my $tableName = shift; - return - map { (/^(\w+)\W/) ? $1 : $_; } - @{$DbSchema->{tables}->{$tableName}->{cols}}; + return + map { (/^(\w+)\W/) ? $1 : $_; } + @{$DbSchema->{tables}->{$tableName}->{cols}}; } sub synchronizeAttributesWithDefaultSystem { - my $self = shift; - my $configDB = shift; + my $self = shift; + my $configDB = shift; - my $defaultSystem = $configDB->fetchSystemByID(0); - return if !$defaultSystem; + my $defaultSystem = $configDB->fetchSystemByID(0); + return if !$defaultSystem; - # fetch all known attributes from attribute roster and merge these - # into the existing attributes of the default system - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - foreach my $attr (keys %$attrInfo) { - next if exists $defaultSystem->{attrs}->{$attr}; - $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; - } - - # remove unknown attributes from default system - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$defaultSystem->{attrs}}; - foreach my $unknownAttr (@unknownAttrs) { - delete $defaultSystem->{attrs}->{$unknownAttr}; - } - - # now write back the updated default system - return $configDB->changeSystem(0, $defaultSystem); + # fetch all known attributes from attribute roster and merge these + # into the existing attributes of the default system + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + foreach my $attr (keys %$attrInfo) { + next if exists $defaultSystem->{attrs}->{$attr}; + $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; + } + + # remove unknown attributes from default system + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$defaultSystem->{attrs}}; + foreach my $unknownAttr (@unknownAttrs) { + delete $defaultSystem->{attrs}->{$unknownAttr}; + } + + # now write back the updated default system + return $configDB->changeSystem(0, $defaultSystem); } ################################################################################ @@ -346,380 +346,380 @@ my %DbSchemaHistory; sub _schemaUpgradeDBFrom { - my $self = shift; - my $metaDB = shift; - my $currVersion = shift; + my $self = shift; + my $metaDB = shift; + my $currVersion = shift; - foreach my $version (sort { $a <=> $b } keys %DbSchemaHistory) { - next if $currVersion >= $version; + 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); - } - } + vlog(0, "upgrading schema version to $version"); + if ($DbSchemaHistory{$version}->($metaDB)) { + $metaDB->schemaSetDBVersion($version); + } + } - return 1; + 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_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_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_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; + 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_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_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_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)); - } - } + # 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 => '<<>>', - 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: - $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; - }, + 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 => '<<>>', + 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: + $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; + }, ); 1; diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm index 13ebe171..f1fbd0f5 100644 --- a/config-db/OpenSLX/MetaDB/Base.pm +++ b/config-db/OpenSLX/MetaDB/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX MetaDB API. +# - provides empty base of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -25,10 +25,10 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; + confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; } -sub connect ## no critic (ProhibitBuiltinHomonyms) +sub connect ## no critic (ProhibitBuiltinHomonyms) { } @@ -119,12 +119,12 @@ 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; +{ # 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 diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm index 1d706d8c..819d8350 100644 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # DBI.pm -# - provides DBI-based implementation of the OpenSLX MetaDB API. +# - provides DBI-based implementation of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::DBI; @@ -27,44 +27,44 @@ use OpenSLX::Utils; ################################################################################ sub new { - confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; + confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; } sub disconnect { - my $self = shift; + my $self = shift; - $self->{'dbh'}->disconnect; - $self->{'dbh'} = undef; - return; + $self->{'dbh'}->disconnect; + $self->{'dbh'} = undef; + return; } sub quote -{ # default implementation quotes any given values through the DBI - my $self = shift; +{ # default implementation quotes any given values through the DBI + my $self = shift; - return $self->{'dbh'}->quote(@_); + return $self->{'dbh'}->quote(@_); } sub startTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->begin_work(); + return $self->{'dbh'}->begin_work(); } sub commitTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->commit(); + return $self->{'dbh'}->commit(); } sub rollbackTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->rollback(); + return $self->{'dbh'}->rollback(); } ################################################################################ @@ -72,442 +72,442 @@ sub rollbackTransaction ################################################################################ sub _trim { - my $s = shift; - $s =~ s[^\s*(.*?)\s*$][$1]; - return $s; + 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 || ''; + 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; + 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; + 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; + 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); + $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; + 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); + $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]; + 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; + 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); + $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; + 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); + $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 $self = shift; + my $vendorOSID = shift; - my $sql = qq[ - SELECT id FROM export WHERE vendor_os_id = '$vendorOSID' - ]; - return $self->_doSelect($sql, 'id'); + 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; + 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'); + 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; + 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); + $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; + 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); + $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 $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; + 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 $self = shift; + my $exportID = shift; - my $sql = qq[ - SELECT id FROM system WHERE export_id = '$exportID' - ]; - return $self->_doSelect($sql, 'id'); + 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 $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'); + 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 $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'); + 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; + 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); + $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; + 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); + $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 $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; + 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 $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'); + 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 $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'); + 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; + 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); + $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; + 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); + $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 $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; + 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 $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'); + 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 $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'); + my $sql = qq[ + SELECT group_id FROM group_client_ref WHERE client_id = '$clientID' + ]; + return $self->_doSelect($sql, 'group_id'); } ################################################################################ @@ -515,611 +515,611 @@ sub fetchGroupIDsOfClient ################################################################################ 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 && !defined $valRow->{id}) { - # id has not been pre-specified, we need to fetch it from DB: - $valRow->{'id'} = $dbh->last_insert_id(undef, undef, $table, 'id'); - vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); - } - push @ids, $valRow->{'id'}; - } - return wantarray() ? @ids : shift @ids; + 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 && !defined $valRow->{id}) { + # id has not been pre-specified, we need to fetch it from DB: + $valRow->{'id'} = $dbh->last_insert_id(undef, undef, $table, 'id'); + vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); + } + push @ids, $valRow->{'id'}; + } + return wantarray() ? @ids : shift @ids; } sub _doDelete { - my $self = shift; - my $table = shift; - my $IDs = shift; - my $idCol = shift; - my $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; + 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; + 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; + 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; + 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; + my $self = shift; + my $valRows = shift; - return $self->_doInsert('vendor_os', $valRows); + return $self->_doInsert('vendor_os', $valRows); } sub removeVendorOS { - my $self = shift; - my $vendorOSIDs = shift; + my $self = shift; + my $vendorOSIDs = shift; - return $self->_doDelete('vendor_os', $vendorOSIDs); + return $self->_doDelete('vendor_os', $vendorOSIDs); } sub changeVendorOS { - my $self = shift; - my $vendorOSIDs = shift; - my $valRows = shift; + my $self = shift; + my $vendorOSIDs = shift; + my $valRows = shift; - return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); + return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); } sub addInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $pluginAttrs = 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; - for my $pluginAttrName (keys %$pluginAttrs) { - if (exists $installedPlugin->{attrs}->{$pluginAttrName}) { - my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName}; - my $currVal - = defined $attrInfo->{value} ? $attrInfo->{value} : '-'; - my $givenVal - = defined $pluginAttrs->{$pluginAttrName} - ? $pluginAttrs->{$pluginAttrName} - : '-'; - next if $currVal eq $givenVal; - return if ! $self->_doUpdate( - 'installed_plugin_attr', [ $attrInfo->{id} ], [ { - value => $pluginAttrs->{$pluginAttrName}, - } ] - ); - } - else { - return if ! $self->_doInsert('installed_plugin_attr', [ { - installed_plugin_id => $installedPlugin->{id}, - name => $pluginAttrName, - value => $pluginAttrs->{$pluginAttrName}, - } ] ); - } - } - return 1; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $pluginAttrs = 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; + for my $pluginAttrName (keys %$pluginAttrs) { + if (exists $installedPlugin->{attrs}->{$pluginAttrName}) { + my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName}; + my $currVal + = defined $attrInfo->{value} ? $attrInfo->{value} : '-'; + my $givenVal + = defined $pluginAttrs->{$pluginAttrName} + ? $pluginAttrs->{$pluginAttrName} + : '-'; + next if $currVal eq $givenVal; + return if ! $self->_doUpdate( + 'installed_plugin_attr', [ $attrInfo->{id} ], [ { + value => $pluginAttrs->{$pluginAttrName}, + } ] + ); + } + else { + return if ! $self->_doInsert('installed_plugin_attr', [ { + installed_plugin_id => $installedPlugin->{id}, + name => $pluginAttrName, + value => $pluginAttrs->{$pluginAttrName}, + } ] ); + } + } + return 1; } sub removeInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - return if !defined $vendorOSID || !$pluginName; + 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} ] ); + 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; + my $self = shift; + my $valRows = shift; - return $self->_doInsert('export', $valRows); + return $self->_doInsert('export', $valRows); } sub removeExport { - my $self = shift; - my $exportIDs = shift; + my $self = shift; + my $exportIDs = shift; - return $self->_doDelete('export', $exportIDs); + return $self->_doDelete('export', $exportIDs); } sub changeExport { - my $self = shift; - my $exportIDs = shift; - my $valRows = shift; + my $self = shift; + my $exportIDs = shift; + my $valRows = shift; - return $self->_doUpdate('export', $exportIDs, $valRows); + return $self->_doUpdate('export', $exportIDs, $valRows); } sub changeGlobalInfo { - my $self = shift; - my $id = shift; - my $value = shift; + my $self = shift; + my $id = shift; + my $value = shift; - return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); + return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); } sub addSystem { - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the systems to get the IDs ... - my @systemIDs = $self->_doInsert('system', $valRows); + # ... 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); - } + # ... 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; + return @systemIDs; } sub removeSystem { - my $self = shift; - my $systemIDs = shift; + my $self = shift; + my $systemIDs = shift; - return $self->_doDelete('system', $systemIDs); + return $self->_doDelete('system', $systemIDs); } sub changeSystem { - my $self = shift; - my $systemIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + 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); - } + # 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); + # finally update all systems in one go + return $self->_doUpdate('system', $systemIDs, $valRows); } sub setSystemAttrs { - my $self = shift; - my $systemID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('system_attr', [ $systemID ], 'system_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - system_id => $systemID, - name => $_, - value => $attrs->{$_}, - } - } - grep { - # Write undefined attributes for the default system, 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"). - $systemID == 0 || defined $attrs->{$_} - } - keys %$attrs; - $self->_doInsert('system_attr', \@attrData); - return 1; + my $self = shift; + my $systemID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('system_attr', [ $systemID ], 'system_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + system_id => $systemID, + name => $_, + value => $attrs->{$_}, + } + } + grep { + # Write undefined attributes for the default system, 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"). + $systemID == 0 || defined $attrs->{$_} + } + keys %$attrs; + $self->_doInsert('system_attr', \@attrData); + return 1; } sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $clientIDs = shift; + 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 - ); + 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 $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 - ); + 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; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the clients to get the IDs ... - my @clientIDs = $self->_doInsert('client', $valRows); + # ... 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); - } + # ... 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; + return @clientIDs; } sub removeAttributeByName { - my $self = shift; - my $attrName = shift; + 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'); + 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; + my $self = shift; + my $clientIDs = shift; - return $self->_doDelete('client', $clientIDs); + return $self->_doDelete('client', $clientIDs); } sub changeClient { - my $self = shift; - my $clientIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + 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); - } + # 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); + # finally update all systems in one go + return $self->_doUpdate('client', $clientIDs, $valRows); } sub setClientAttrs { - my $self = shift; - my $clientID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('client_attr', [ $clientID ], 'client_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - client_id => $clientID, - name => $_, - value => $attrs->{$_}, - } - } - grep { defined $attrs->{$_} } - keys %$attrs; - $self->_doInsert('client_attr', \@attrData); - return 1; + my $self = shift; + my $clientID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('client_attr', [ $clientID ], 'client_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + client_id => $clientID, + name => $_, + value => $attrs->{$_}, + } + } + grep { defined $attrs->{$_} } + keys %$attrs; + $self->_doInsert('client_attr', \@attrData); + return 1; } sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; - my $systemIDs = shift; + 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 - ); + 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 $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 - ); + 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; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the groups to get the IDs ... - my @groupIDs = $self->_doInsert('groups', $valRows); + # ... 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); - } + # ... 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; + return @groupIDs; } sub removeGroup { - my $self = shift; - my $groupIDs = shift; + my $self = shift; + my $groupIDs = shift; - return $self->_doDelete('groups', $groupIDs); + return $self->_doDelete('groups', $groupIDs); } sub changeGroup { - my $self = shift; - my $groupIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + 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); - } + # 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); + # finally update all groups in one go + return $self->_doUpdate('groups', $groupIDs, $valRows); } sub setGroupAttrs { - my $self = shift; - my $groupID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('group_attr', [ $groupID ], 'group_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - group_id => $groupID, - name => $_, - value => $attrs->{$_}, - } - } - grep { defined $attrs->{$_} } - keys %$attrs; - $self->_doInsert('group_attr', \@attrData); - return 1; + my $self = shift; + my $groupID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('group_attr', [ $groupID ], 'group_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + group_id => $groupID, + name => $_, + value => $attrs->{$_}, + } + } + grep { defined $attrs->{$_} } + keys %$attrs; + $self->_doInsert('group_attr', \@attrData); + return 1; } sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $clientIDs = shift; + 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 - ); + 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 $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 - ); + my @currSystems = $self->fetchSystemIDsOfGroup($groupID); + return $self->_updateRefTable( + 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id', + \@currSystems + ); } ################################################################################ @@ -1127,274 +1127,274 @@ sub setSystemIDsOfGroup ################################################################################ sub _convertColDescrsToDBNativeString { - my $self = shift; - my $colDescrs = shift; + 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; + 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; + 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; + 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; + my $self = shift; + my $colDescrs = shift; - return join ', ', $self->_convertColDescrsToColNames($colDescrs); + return join ', ', $self->_convertColDescrsToColNames($colDescrs); } sub schemaFetchDBVersion { - my $self = shift; + 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}; + 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; + 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); + $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'") + or croak _tr('Unable to set DB-schema version to %s!', $dbVersion); - return 1; + 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); - } +{ # 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) { - my $ignoreIDs = ($colDescrString !~ m[\bid\b]); - # don't care about IDs if there's no 'id' column in this table - $self->_doInsert($table, $initialVals, $ignoreIDs); - } - return; + 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) { + my $ignoreIDs = ($colDescrString !~ m[\bid\b]); + # don't care about IDs if there's no 'id' column in this table + $self->_doInsert($table, $initialVals, $ignoreIDs); + } + return; } sub schemaDropTable { - my $self = shift; - my $table = shift; - my $isSubCmd = shift; + 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; + 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 RENAME TO ' 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; + # 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 RENAME TO ' 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 ADD COLUMN ' 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; + # 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
ADD COLUMN ' 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
DROP COLUMN ' 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; + # 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
DROP COLUMN ' 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
CHANGE COLUMN ' 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; + # 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
CHANGE COLUMN ' 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; diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index c0725191..ce5c51f3 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SQLite.pm -# - provides SQLite-specific overrides of the OpenSLX MetaDB API. +# - provides SQLite-specific overrides of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::SQLite; @@ -30,102 +30,102 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub databaseExists { - my $self = shift; - - my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + my $self = shift; + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; print "$fullDBPath\n"; - return -e $fullDBPath; + 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; + 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) +sub connect ## no critic (ProhibitBuiltinHomonyms) { - my $self = shift; + 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, unicode => 1} - ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); - return 1; + 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, 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 $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; + 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 $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; + 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; + my $self = shift; - return "$openslxConfig{'private-path'}/db/sqlite"; + return "$openslxConfig{'private-path'}/db/sqlite"; } 1; diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm index 6b298bc8..0b6569dd 100644 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # mysql.pm -# - provides mysql-specific overrides of the OpenSLX MetaDB API. +# - provides mysql-specific overrides of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::mysql; @@ -31,146 +31,146 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } -sub connect ## no critic (ProhibitBuiltinHomonyms) +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) { + 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} - ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); - return 1; + } + + vlog(1, "trying to connect user '$dbUser' to mysql-database '$dbSpec'"); + $self->{'dbh'} = DBI->connect( + "dbi:mysql:$dbSpec", $dbUser, $dbPasswd, {PrintError => 0} + ) 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; + 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; + 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; + 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; + 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; + 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; diff --git a/config-db/devel-tools/test-config-db.pl b/config-db/devel-tools/test-config-db.pl index 8a572e28..825800c4 100755 --- a/config-db/devel-tools/test-config-db.pl +++ b/config-db/devel-tools/test-config-db.pl @@ -13,7 +13,7 @@ use strict; use FindBin; use lib "$FindBin::RealBin/../../lib"; use lib "$FindBin::RealBin/.."; - # development path to config-db stuff + # development path to config-db stuff print "THIS IS CURRENTLY BROKEN!!!\n"; exit 5; @@ -26,27 +26,27 @@ openslxInit(); my $openslxDB = connectConfigDB(); addVendorOS($openslxDB, { - 'name' => "suse-93-minimal", - 'descr' => "SuSE 9.3 minimale Installation", + 'name' => "suse-93-minimal", + 'descr' => "SuSE 9.3 minimale Installation", }); addVendorOS($openslxDB, { - 'name' => "suse-93-KDE", - 'descr' => "SuSE 9.3 grafische Installation mit KDE", + 'name' => "suse-93-KDE", + 'descr' => "SuSE 9.3 grafische Installation mit KDE", }); addVendorOS($openslxDB, { - 'name' => "debian-31", - 'descr' => "Debian 3.1 Default-Installation", + 'name' => "debian-31", + 'descr' => "Debian 3.1 Default-Installation", }); my @systems; foreach my $id (1..10) { - push @systems, { - 'name' => "name of $id", - 'descr' => "descr of $id", - 'vendor_os_id' => 1 + $id % 3, - }; + push @systems, { + 'name' => "name of $id", + 'descr' => "descr of $id", + 'vendor_os_id' => 1 + $id % 3, + }; } addSystem($openslxDB, \@systems); @@ -63,31 +63,31 @@ changeSystem($openslxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); my $metaDB = $openslxDB->{'meta-db'}; my $colDescrs = [ - 'id:pk', - 'name:s.30', - 'descr:s.1024', - 'counter:i', - 'hidden:b', - 'dropped1:b', - 'dropped2:b', + 'id:pk', + 'name:s.30', + 'descr:s.1024', + 'counter:i', + 'hidden:b', + 'dropped1:b', + 'dropped2:b', ]; my $initialVals = [ - { - 'name' => '123456789012345678901234567890xxx', - 'descr' => 'descr-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', - 'counter' => 34567, - 'hidden' => 1, - 'dropped1' => 0, - 'dropped2' => 1, - }, - { - 'name' => 'name', - 'descr' => q[from_äöüß#'"$...\to_here], - 'counter' => -1, - 'hidden' => 0, - 'dropped1' => 1, - 'dropped2' => 0, - }, + { + 'name' => '123456789012345678901234567890xxx', + 'descr' => 'descr-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', + 'counter' => 34567, + 'hidden' => 1, + 'dropped1' => 0, + 'dropped2' => 1, + }, + { + 'name' => 'name', + 'descr' => q[from_äöüß#'"$...\to_here], + 'counter' => -1, + 'hidden' => 0, + 'dropped1' => 1, + 'dropped2' => 0, + }, ]; @@ -98,15 +98,15 @@ $metaDB->schemaRenameTable('test', 'test2', $colDescrs); push @$colDescrs, 'added:s.20'; push @$colDescrs, 'added2:s.20'; $metaDB->schemaAddColumns('test2', - ['added:s.20', 'added2:b'], - [{'added' => 'added'}, {'added2' => '1'}], - $colDescrs); + ['added:s.20', 'added2:b'], + [{'added' => 'added'}, {'added2' => '1'}], + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $colDescrs = [grep {$_ !~ m[dropped]} @$colDescrs]; @@ -114,93 +114,93 @@ $metaDB->schemaDropColumns('test2', ['dropped1', 'dropped2'], $colDescrs); $colDescrs = [ - map { - if ($_ =~ m[counter]) { - "count:i"; - } elsif ($_ =~ m[descr]) { - "description:s.30"; - } else { - $_ - } - } @$colDescrs + map { + if ($_ =~ m[counter]) { + "count:i"; + } elsif ($_ =~ m[descr]) { + "description:s.30"; + } else { + $_ + } + } @$colDescrs ]; $metaDB->schemaChangeColumns('test2', - { 'counter' => 'count:i', - 'descr' => 'description:s.30' }, - $colDescrs); + { 'counter' => 'count:i', + 'descr' => 'description:s.30' }, + $colDescrs); @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $metaDB->schemaDropTable('test2'); my $clientG01ID = addClient($openslxDB, { - 'name' => "PC-G-01", - 'mac' => "00:14:85:80:00:35", - 'boot_type' => 'pxe', + 'name' => "PC-G-01", + 'mac' => "00:14:85:80:00:35", + 'boot_type' => 'pxe', }); my $clientG02ID = addClient($openslxDB, { - 'name' => "PC-G-02", - 'mac' => "00:14:85:80:00:36", - 'boot_type' => 'pxe', + 'name' => "PC-G-02", + 'mac' => "00:14:85:80:00:36", + 'boot_type' => 'pxe', }); my $clientG03ID = addClient($openslxDB, { - 'name' => "PC-G-03", - 'mac' => "00:14:85:80:00:37", - 'boot_type' => 'pxe', + 'name' => "PC-G-03", + 'mac' => "00:14:85:80:00:37", + 'boot_type' => 'pxe', }); my $clientG04ID = addClient($openslxDB, { - 'name' => "PC-G-04", - 'mac' => "00:14:85:80:00:38", - 'boot_type' => 'pxe', - 'unbootable' => 1, + 'name' => "PC-G-04", + 'mac' => "00:14:85:80:00:38", + 'boot_type' => 'pxe', + 'unbootable' => 1, }); my $clientF01ID = addClient($openslxDB, { - 'name' => "PC-F-01", - 'mac' => "00:14:85:80:00:31", - 'boot_type' => 'other', + 'name' => "PC-F-01", + 'mac' => "00:14:85:80:00:31", + 'boot_type' => 'other', }); my $clientF02ID = addClient($openslxDB, { - 'name' => "PC-F-02", - 'mac' => "00:14:85:80:00:32", - 'boot_type' => 'pxe', + 'name' => "PC-F-02", + 'mac' => "00:14:85:80:00:32", + 'boot_type' => 'pxe', }); my $clientF03ID = addClient($openslxDB, { - 'name' => "PC-F-03", - 'mac' => "00:14:85:80:00:33", - 'boot_type' => 'pxe', + 'name' => "PC-F-03", + 'mac' => "00:14:85:80:00:33", + 'boot_type' => 'pxe', }); -addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); +addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); my $group1ID = addGroup($openslxDB, { - 'name' => "Gell-PCs", - 'descr' => "Gell-Threemansion PCs from 2002", - 'attrHwMouse' => 'serial', + 'name' => "Gell-PCs", + 'descr' => "Gell-Threemansion PCs from 2002", + 'attrHwMouse' => 'serial', }); addClientIDsToGroup($openslxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); my $group2ID = addGroup($openslxDB, { - 'name' => "Teacher-PCs", - 'descr' => "all PCs sitting on teacher's desks", - 'attrHwMonitor' => '1600x1200', + 'name' => "Teacher-PCs", + 'descr' => "all PCs sitting on teacher's desks", + 'attrHwMonitor' => '1600x1200', }); addClientIDsToGroup($openslxDB, $group2ID, [$clientG01ID, $clientF01ID]); addSystemIDsToGroup($openslxDB, $group2ID, [2, 3]); my $group3ID = addGroup($openslxDB, { - 'name' => "PCs in room G", - 'descr' => "all PCs of room 234", + 'name' => "PCs in room G", + 'descr' => "all PCs of room 234", }); addClientIDsToGroup($openslxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); diff --git a/config-db/devel-tools/test-config-demuxer.pl b/config-db/devel-tools/test-config-demuxer.pl index 8c1da03c..e212343f 100755 --- a/config-db/devel-tools/test-config-demuxer.pl +++ b/config-db/devel-tools/test-config-demuxer.pl @@ -13,7 +13,7 @@ use strict; use FindBin; use lib "$FindBin::RealBin/../../lib"; use lib "$FindBin::RealBin/.."; - # development path to config-db stuff + # development path to config-db stuff print "THIS IS CURRENTLY BROKEN!!!\n"; exit 5; @@ -24,46 +24,46 @@ use OpenSLX::ConfigDB qw(:access :manipulation); openslxInit(); $openslxConfig{'db-name'} = 'openslx_testscript'; - # make sure to use a database of our own! + # make sure to use a database of our own! my $openslxDB = connectConfigDB(); emptyDatabase($openslxDB); addVendorOS($openslxDB,{ - 'name' => "suse-10-minimal", - 'comment' => "SuSE 10 minimale Installation", - 'path' => "suse-10.0", - # relative to /var/lib/openslx/stage1 + 'name' => "suse-10-minimal", + 'comment' => "SuSE 10 minimale Installation", + 'path' => "suse-10.0", + # relative to /var/lib/openslx/stage1 }); addVendorOS($openslxDB, { - 'name' => "suse-10-KDE", - 'comment' => "SuSE 10 grafische Installation mit KDE", - 'path' => "suse-10.0", + 'name' => "suse-10-KDE", + 'comment' => "SuSE 10 grafische Installation mit KDE", + 'path' => "suse-10.0", }); addVendorOS($openslxDB, { - 'name' => "debian-31", - 'comment' => "Debian 3.1 Default-Installation", + 'name' => "debian-31", + 'comment' => "Debian 3.1 Default-Installation", }); my @systems; foreach my $id (1..10) { - push @systems, { - 'name' => "name of $id", - 'label' => "label of $id", - 'comment' => "comment of $id", - 'vendor_os_id' => 1 + $id % 3, - 'ramfs_debug_level' => $id%2, - 'ramfs_use_glibc' => 0, - 'ramfs_use_busybox' => 0, - 'ramfs_nicmods' => ($id % 3) ? 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32' : '', - 'ramfs_fsmods' => ($id % 3)==2 ? 'nbd ext3 nfs reiserfs xfs' : '', - 'kernel' => "boot/vmlinuz-2.6.13-15-default", - 'kernel_params' => "splash=silent", - 'export_type' => 'nfs', - }; + push @systems, { + 'name' => "name of $id", + 'label' => "label of $id", + 'comment' => "comment of $id", + 'vendor_os_id' => 1 + $id % 3, + 'ramfs_debug_level' => $id%2, + 'ramfs_use_glibc' => 0, + 'ramfs_use_busybox' => 0, + 'ramfs_nicmods' => ($id % 3) ? 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32' : '', + 'ramfs_fsmods' => ($id % 3)==2 ? 'nbd ext3 nfs reiserfs xfs' : '', + 'kernel' => "boot/vmlinuz-2.6.13-15-default", + 'kernel_params' => "splash=silent", + 'export_type' => 'nfs', + }; } addSystem($openslxDB, \@systems); @@ -80,31 +80,31 @@ changeSystem($openslxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); my $metaDB = $openslxDB->{'meta-db'}; my $colDescrs = [ - 'id:pk', - 'name:s.30', - 'comment:s.1024', - 'counter:i', - 'hidden:b', - 'dropped1:b', - 'dropped2:b', + 'id:pk', + 'name:s.30', + 'comment:s.1024', + 'counter:i', + 'hidden:b', + 'dropped1:b', + 'dropped2:b', ]; my $initialVals = [ - { - 'name' => '123456789012345678901234567890xxx', - 'comment' => 'comment-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', - 'counter' => 34567, - 'hidden' => 1, - 'dropped1' => 0, - 'dropped2' => 1, - }, - { - 'name' => 'name', - 'comment' => q[from_äöüß#'"$...\to_here], - 'counter' => -1, - 'hidden' => 0, - 'dropped1' => 1, - 'dropped2' => 0, - }, + { + 'name' => '123456789012345678901234567890xxx', + 'comment' => 'comment-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', + 'counter' => 34567, + 'hidden' => 1, + 'dropped1' => 0, + 'dropped2' => 1, + }, + { + 'name' => 'name', + 'comment' => q[from_äöüß#'"$...\to_here], + 'counter' => -1, + 'hidden' => 0, + 'dropped1' => 1, + 'dropped2' => 0, + }, ]; @@ -115,15 +115,15 @@ $metaDB->schemaRenameTable('test', 'test2', $colDescrs); push @$colDescrs, 'added:s.20'; push @$colDescrs, 'added2:s.20'; $metaDB->schemaAddColumns('test2', - ['added:s.20', 'added2:b'], - [{'added' => 'added'}, {'added2' => '1'}], - $colDescrs); + ['added:s.20', 'added2:b'], + [{'added' => 'added'}, {'added2' => '1'}], + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $colDescrs = [grep {$_ !~ m[dropped]} @$colDescrs]; @@ -131,94 +131,94 @@ $metaDB->schemaDropColumns('test2', ['dropped1', 'dropped2'], $colDescrs); $colDescrs = [ - map { - if ($_ =~ m[counter]) { - "count:i"; - } elsif ($_ =~ m[comment]) { - "description:s.30"; - } else { - $_ - } - } @$colDescrs + map { + if ($_ =~ m[counter]) { + "count:i"; + } elsif ($_ =~ m[comment]) { + "description:s.30"; + } else { + $_ + } + } @$colDescrs ]; $metaDB->schemaChangeColumns('test2', - { 'counter' => 'count:i', - 'comment' => 'description:s.30' }, - $colDescrs); + { 'counter' => 'count:i', + 'comment' => 'description:s.30' }, + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $metaDB->schemaDropTable('test2'); my $clientG01ID = addClient($openslxDB, { - 'name' => "PC-G-01", - 'mac' => "00:50:56:0D:03:35", - 'boot_type' => 'pxe', + 'name' => "PC-G-01", + 'mac' => "00:50:56:0D:03:35", + 'boot_type' => 'pxe', }); my $clientG02ID = addClient($openslxDB, { - 'name' => "PC-G-02", - 'mac' => "00:50:56:0D:03:36", - 'boot_type' => 'pxe', - 'unbootable' => 1, + 'name' => "PC-G-02", + 'mac' => "00:50:56:0D:03:36", + 'boot_type' => 'pxe', + 'unbootable' => 1, }); my $clientG03ID = addClient($openslxDB, { - 'name' => "PC-G-03", - 'mac' => "00:50:56:0D:03:37", - 'boot_type' => 'pxe', + 'name' => "PC-G-03", + 'mac' => "00:50:56:0D:03:37", + 'boot_type' => 'pxe', }); my $clientG04ID = addClient($openslxDB, { - 'name' => "PC-G-04", - 'mac' => "00:50:56:0D:03:38", - 'boot_type' => 'pxe', - 'kernel_params' => 'console=ttyS0,19200', + 'name' => "PC-G-04", + 'mac' => "00:50:56:0D:03:38", + 'boot_type' => 'pxe', + 'kernel_params' => 'console=ttyS0,19200', }); my $clientF01ID = addClient($openslxDB, { - 'name' => "PC-F-01", - 'mac' => "00:50:56:0D:03:31", - 'boot_type' => 'other', + 'name' => "PC-F-01", + 'mac' => "00:50:56:0D:03:31", + 'boot_type' => 'other', }); my $clientF02ID = addClient($openslxDB, { - 'name' => "PC-F-02", - 'mac' => "00:50:56:0D:03:32", - 'boot_type' => 'pxe', + 'name' => "PC-F-02", + 'mac' => "00:50:56:0D:03:32", + 'boot_type' => 'pxe', }); my $clientF03ID = addClient($openslxDB, { - 'name' => "PC-F-03", - 'mac' => "00:50:56:0D:03:33", - 'boot_type' => 'pxe', + 'name' => "PC-F-03", + 'mac' => "00:50:56:0D:03:33", + 'boot_type' => 'pxe', }); -addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); +addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); my $group1ID = addGroup($openslxDB, { - 'name' => "Gell-PCs", - 'comment' => "Gell-Threemansion PCs from 2002", - 'attr_hw_mouse' => 'serial', + 'name' => "Gell-PCs", + 'comment' => "Gell-Threemansion PCs from 2002", + 'attr_hw_mouse' => 'serial', }); addClientIDsToGroup($openslxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); my $group2ID = addGroup($openslxDB, { - 'name' => "Teacher-PCs", - 'comment' => "all PCs sitting on teacher's desks", - 'attr_hw_monitor' => '1600x1200', + 'name' => "Teacher-PCs", + 'comment' => "all PCs sitting on teacher's desks", + 'attr_hw_monitor' => '1600x1200', }); addClientIDsToGroup($openslxDB, $group2ID, [$clientG01ID, $clientF01ID]); addSystemIDsToGroup($openslxDB, $group2ID, [2, 3]); my $group3ID = addGroup($openslxDB, { - 'name' => "PCs in room G", - 'comment' => "all PCs of room 234", + 'name' => "PCs in room G", + 'comment' => "all PCs of room 234", }); addClientIDsToGroup($openslxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); diff --git a/config-db/slxconfig b/config-db/slxconfig index 8900a3c1..8453b6b9 100755 --- a/config-db/slxconfig +++ b/config-db/slxconfig @@ -17,7 +17,7 @@ my $abstract = q[ slxconfig This script can be used to display or change the OpenSLX configuration database. You can create systems that use a specific vendor-OS - and you can create clients for these systems, too. + and you can create clients for these systems, too. ]; use Getopt::Long qw(:config pass_through); @@ -44,28 +44,28 @@ use OpenSLX::Utils; my %option; GetOptions( - 'help|?' => \$option{helpReq}, - 'inherited' => \$option{inherited}, - 'man' => \$option{manReq}, - 'verbose' => \$option{verbose}, - 'version' => \$option{versionReq}, + 'help|?' => \$option{helpReq}, + 'inherited' => \$option{inherited}, + 'man' => \$option{manReq}, + 'verbose' => \$option{verbose}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } # if the user requested to see inherited attributes, we activate verbose mode, # too, such that we actually show attributes if ($option{inherited}) { - $option{verbose} = 1; + $option{verbose} = 1; } openslxInit(); @@ -75,1309 +75,1309 @@ $openslxDB->connect(); my $action = shift @ARGV || ''; if ($action =~ m[^add-c]i) { - addClientToConfigDB(@ARGV); + addClientToConfigDB(@ARGV); } elsif ($action =~ m[^add-g]i) { - addGroupToConfigDB(@ARGV); + addGroupToConfigDB(@ARGV); } elsif ($action =~ m[^add-s]i) { - addSystemToConfigDB(@ARGV); + addSystemToConfigDB(@ARGV); } elsif ($action =~ m[^change-v]i) { - changeVendorOSInConfigDB(@ARGV); + changeVendorOSInConfigDB(@ARGV); } elsif ($action =~ m[^change-e]i) { - changeExportInConfigDB(@ARGV); + changeExportInConfigDB(@ARGV); } elsif ($action =~ m[^change-g]i) { - changeGroupInConfigDB(@ARGV); + changeGroupInConfigDB(@ARGV); } elsif ($action =~ m[^change-s]i) { - changeSystemInConfigDB(@ARGV); + changeSystemInConfigDB(@ARGV); } elsif ($action =~ m[^change-c]i) { - changeClientInConfigDB(@ARGV); + changeClientInConfigDB(@ARGV); } elsif ($action =~ m[^list-a]) { - print @ARGV - ? _tr("List of known attributes for scope '%s':\n", $ARGV[0]) - : _tr("List of known attributes:\n"); - listAttributes(@ARGV); + print @ARGV + ? _tr("List of known attributes for scope '%s':\n", $ARGV[0]) + : _tr("List of known attributes:\n"); + listAttributes(@ARGV); } elsif ($action =~ m[^list-c]) { - print _tr("List of clients:\n"); - listClients(@ARGV); + print _tr("List of clients:\n"); + listClients(@ARGV); } elsif ($action =~ m[^list-e]) { - print _tr("List of exports:\n"); - listExports(@ARGV); + print _tr("List of exports:\n"); + listExports(@ARGV); } elsif ($action =~ m[^list-g]) { - print _tr("List of groups:\n"); - listGroups(@ARGV); + print _tr("List of groups:\n"); + listGroups(@ARGV); } elsif ($action =~ m[^list-s]) { - print _tr("List of systems:\n"); - listSystems(@ARGV); + print _tr("List of systems:\n"); + listSystems(@ARGV); } elsif ($action =~ m[^list-v]) { - print _tr("List of vendor-OSes:\n"); - listVendorOSes(@ARGV); + print _tr("List of vendor-OSes:\n"); + listVendorOSes(@ARGV); } elsif ($action =~ m[^search-c]) { - print _tr("Matching clients:\n"); - searchClients(@ARGV); + print _tr("Matching clients:\n"); + searchClients(@ARGV); } elsif ($action =~ m[^search-e]) { - print _tr("Matching exports:\n"); - searchExports(@ARGV); + print _tr("Matching exports:\n"); + searchExports(@ARGV); } elsif ($action =~ m[^search-g]) { - print _tr("Matching groups:\n"); - searchGroups(@ARGV); + print _tr("Matching groups:\n"); + searchGroups(@ARGV); } elsif ($action =~ m[^search-s]) { - print _tr("Matching systems:\n"); - searchSystems(@ARGV); + print _tr("Matching systems:\n"); + searchSystems(@ARGV); } elsif ($action =~ m[^search-v]) { - print _tr("Matching vendor-OSes:\n"); - searchVendorOSes(@ARGV); + print _tr("Matching vendor-OSes:\n"); + searchVendorOSes(@ARGV); } elsif ($action =~ m[^remove-c]i) { - removeClientFromConfigDB(@ARGV); + removeClientFromConfigDB(@ARGV); } elsif ($action =~ m[^remove-g]i) { - removeGroupFromConfigDB(@ARGV); + removeGroupFromConfigDB(@ARGV); } elsif ($action =~ m[^remove-s]i) { - removeSystemFromConfigDB(@ARGV); + removeSystemFromConfigDB(@ARGV); } else { - vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); - You need to specify exactly one of these actions: - add-client - add-group - add-system - change-client - change-export - change-group - change-system - change-vendor-os - list-attributes - list-client - list-export - list-group - list-system - list-vendor-os - remove-client - remove-group - remove-system - search-client - search-export - search-group - search-system - search-vendor-os - Try '%s --help' for more info. - END-OF-HERE + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one of these actions: + add-client + add-group + add-system + change-client + change-export + change-group + change-system + change-vendor-os + list-attributes + list-client + list-export + list-group + list-system + list-vendor-os + remove-client + remove-group + remove-system + search-client + search-export + search-group + search-system + search-vendor-os + Try '%s --help' for more info. + END-OF-HERE } $openslxDB->disconnect(); sub parseKeyValueArgs { - my $allowedKeys = shift; - my $table = shift; - - my %dataHash; - while (my $param = shift) { - if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { - die _tr( - "value specification %s has unknown format, expected =\n", - $param - ); - } - my $key = lc($1); - my $value = $2; - if (!grep { $_ eq $key } @$allowedKeys) { - die _tr("unknown key '%s' specified for %s\n", $key, $table); - } - - # replace escaped newlines and tab chars by the respective real thing - $value =~ s{\\n}{\n}gms; - $value =~ s{\\t}{\t}gms; - - # accept '-' as placeholder for undefined - if ($value eq '-') { - $value = undef; - } - - $dataHash{$key} = $value; - } - - return \%dataHash; + my $allowedKeys = shift; + my $table = shift; + + my %dataHash; + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + if (!grep { $_ eq $key } @$allowedKeys) { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + $dataHash{$key} = $value; + } + + return \%dataHash; } sub parseKeyValueArgsWithAttrs { - my $allowedKeys = shift; - my $allowedAttrKeys = shift; - my $table = shift; - - my (%dataHash, %attrHash); - while (my $param = shift) { - if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { - die _tr( - "value specification %s has unknown format, expected =\n", - $param - ); - } - my $key = lc($1); - my $value = $2; - - # replace escaped newlines and tab chars by the respective real thing - $value =~ s{\\n}{\n}gms; - $value =~ s{\\t}{\t}gms; - - # accept '-' as placeholder for undefined - if ($value eq '-') { - $value = undef; - } - - if (grep { $_ eq $key } @$allowedKeys) { - $dataHash{$key} = $value; - } elsif (grep { $_ eq $key } @$allowedAttrKeys) { - $attrHash{$key} = $value; - } else { - die _tr("unknown key '%s' specified for %s\n", $key, $table); - } - } - - if (wantarray) { - return (\%dataHash, \%attrHash); - } - else { - if (%attrHash) { - $dataHash{attrs} = \%attrHash; - } - return \%dataHash; - } + my $allowedKeys = shift; + my $allowedAttrKeys = shift; + my $table = shift; + + my (%dataHash, %attrHash); + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + if (grep { $_ eq $key } @$allowedKeys) { + $dataHash{$key} = $value; + } elsif (grep { $_ eq $key } @$allowedAttrKeys) { + $attrHash{$key} = $value; + } else { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + } + + if (wantarray) { + return (\%dataHash, \%attrHash); + } + else { + if (%attrHash) { + $dataHash{attrs} = \%attrHash; + } + return \%dataHash; + } } sub mergeNonExistingAttributes { - my $target = shift; - my $source = shift; + my $target = shift; + my $source = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; - foreach my $key (keys %$sourceAttrs) { - next if exists $targetAttrs->{$key}; - $targetAttrs->{$key} = $sourceAttrs->{$key}; - } + foreach my $key (keys %$sourceAttrs) { + next if exists $targetAttrs->{$key}; + $targetAttrs->{$key} = $sourceAttrs->{$key}; + } - return 1; + return 1; } sub dumpElements { - my $objName = shift; - my $nameClause = shift || sub { "\t$_->{name}\n" }; - - if ($option{verbose}) { - my $ind = ' ' x 4; - foreach my $elem (@_) { - print "$objName '$elem->{name}':\n"; - my $spcLen = max map { length($_) } keys %$elem; - print join( - '', - map { - my $elemVal = defined $elem->{$_} ? $elem->{$_} : '-'; - if (ref($elemVal) eq 'HASH') { - my $spcLen - = max(map { length($_) } keys %$elemVal) || 0; - my $spc = ' ' x $spcLen; - my $subLines = join( - "\n", - map { - my $spc = ' ' x $spcLen; - my $val - = defined $elemVal->{$_} - ? $elemVal->{$_} - : ''; - $val =~ s[\n][\n$ind$spc ]g; - "$ind$_" . substr($spc, length($_)) . " = $val"; - } - sort { - # drop [] construct (origin) from key for - # sorting purposes - (my $aa = $a) =~ s{^\s*\[.+\]\s*}{}; - (my $bb = $b) =~ s{^\s*\[.+\]\s*}{}; - return $aa cmp $bb; - } keys %$elemVal - ); - $subLines ||= "$ind"; - " $_:\n$subLines\n"; - } elsif (ref($elemVal) eq 'ARRAY') { - my $subLines - = join( "\n", map { "$ind$_" } sort @$elemVal); - $subLines ||= "$ind"; - " $_:\n$subLines\n"; - } else { - my $spc = ' ' x $spcLen; - $elemVal =~ s[\n][\n$ind$spc ]g; - "$ind$_" . substr($spc, length($_)) . " = $elemVal\n"; - } - } - sort { - my $refCmp = ref($elem->{$a}) cmp ref($elem->{$b}); - return $refCmp ? $refCmp : $a cmp $b; - } - grep { - $_ ne 'name'; - } - keys %$elem - ); - } - } - else { - print join('', sort map { $nameClause->($_); } @_); - } - - return 1; + my $objName = shift; + my $nameClause = shift || sub { "\t$_->{name}\n" }; + + if ($option{verbose}) { + my $ind = ' ' x 4; + foreach my $elem (@_) { + print "$objName '$elem->{name}':\n"; + my $spcLen = max map { length($_) } keys %$elem; + print join( + '', + map { + my $elemVal = defined $elem->{$_} ? $elem->{$_} : '-'; + if (ref($elemVal) eq 'HASH') { + my $spcLen + = max(map { length($_) } keys %$elemVal) || 0; + my $spc = ' ' x $spcLen; + my $subLines = join( + "\n", + map { + my $spc = ' ' x $spcLen; + my $val + = defined $elemVal->{$_} + ? $elemVal->{$_} + : ''; + $val =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $val"; + } + sort { + # drop [] construct (origin) from key for + # sorting purposes + (my $aa = $a) =~ s{^\s*\[.+\]\s*}{}; + (my $bb = $b) =~ s{^\s*\[.+\]\s*}{}; + return $aa cmp $bb; + } keys %$elemVal + ); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } elsif (ref($elemVal) eq 'ARRAY') { + my $subLines + = join( "\n", map { "$ind$_" } sort @$elemVal); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } else { + my $spc = ' ' x $spcLen; + $elemVal =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $elemVal\n"; + } + } + sort { + my $refCmp = ref($elem->{$a}) cmp ref($elem->{$b}); + return $refCmp ? $refCmp : $a cmp $b; + } + grep { + $_ ne 'name'; + } + keys %$elem + ); + } + } + else { + print join('', sort map { $nameClause->($_); } @_); + } + + return 1; } sub listAttributes { - my $scope = shift; - - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo( { scope => $scope } ); - dumpElements( - 'attribute', undef, - map { - my $attr = dclone($attrInfo->{$_}); - $attr->{name} = $_; - delete $attr->{content_regex}; # no use for display purposes - $attr; - } - sort keys %$attrInfo - ); - - return 1; + my $scope = shift; + + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo( { scope => $scope } ); + dumpElements( + 'attribute', undef, + map { + my $attr = dclone($attrInfo->{$_}); + $attr->{name} = $_; + delete $attr->{content_regex}; # no use for display purposes + $attr; + } + sort keys %$attrInfo + ); + + return 1; } sub listClients { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'client', undef, - _expandClients( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByFilter(\%nameSpec) - ) - ); + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listGroups { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'group', undef, - _expandGroups( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchGroupByFilter(\%nameSpec) - ) - ); + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listExports { - my $name = _cleanName(shift); - - my %nameSpec; - - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } - - dumpElements( - 'export', - sub { - "\t$_->{name}" - . substr(' ' x 30, length($_->{name})) - . "($_->{type})\n"; - }, - map { - my $vendorOS = - $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); - if (defined $vendorOS) { - $_->{vendor_os_id} .= " ($vendorOS->{name})"; - } - $_; - } - sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } - $openslxDB->fetchExportByFilter(\%nameSpec) - ); - - return 1; + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter(\%nameSpec) + ); + + return 1; } sub listSystems { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'system', undef, - _expandSystems( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByFilter(\%nameSpec) - ) - ); + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listVendorOSes { - my $name = _cleanName(shift); - - my %nameSpec; - - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } - - dumpElements('vendor-OS', undef, - map { - my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); - $_->{plugins} - = @plugins - ? join(',', sort map { $_->{plugin_name} } @plugins) - : ''; - $_; - } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchVendorOSByFilter(\%nameSpec)); - - return 1; + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements('vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + $_->{plugins} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter(\%nameSpec)); + + return 1; } sub searchClients { - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my ($clientData, $clientAttrs) = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$clientData; - - dumpElements( - 'client', undef, - _expandClients( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByFilter($clientData, undef, $clientAttrs) - ) - ); - - return 1; + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($clientData, $clientAttrs) = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$clientData; + + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter($clientData, undef, $clientAttrs) + ) + ); + + return 1; } sub searchGroups { - my @groupKeys = $openslxDB->getColumnsOfTable('groups'); - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my ($groupData, $groupAttrs) = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$groupData; - - dumpElements( - 'group', undef, - _expandGroups( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchGroupByFilter($groupData, undef, $groupAttrs) - ) - ); - - return 1; + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($groupData, $groupAttrs) = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$groupData; + + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter($groupData, undef, $groupAttrs) + ) + ); + + return 1; } sub searchExports { - my @exportKeys = $openslxDB->getColumnsOfTable('export'); - my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$exportData; - - dumpElements( - 'export', - sub { - "\t$_->{name}" - . substr(' ' x 30, length($_->{name})) - . "($_->{type})\n"; - }, - map { - my $vendorOS = - $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); - if (defined $vendorOS) { - $_->{vendor_os_id} .= " ($vendorOS->{name})"; - } - $_; - } - sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } - $openslxDB->fetchExportByFilter($exportData) - ); - - return 1; + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$exportData; + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter($exportData) + ); + + return 1; } sub searchSystems { - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my ($systemData, $systemAttrs) = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$systemData; - - dumpElements( - 'system', undef, - _expandSystems( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByFilter($systemData, undef, $systemAttrs) - ) - ); - - return 1; + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my ($systemData, $systemAttrs) = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$systemData; + + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter($systemData, undef, $systemAttrs) + ) + ); + + return 1; } sub searchVendorOSes { - my @vendorOSKeys = $openslxDB->getColumnsOfTable('vendor_os'); - my $vendorOSData = parseKeyValueArgs(\@vendorOSKeys, 'vendor_os', @_); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$vendorOSData; - - dumpElements( - 'vendor-OS', undef, - map { - my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); - $_->{plugins} - = @plugins - ? join(',', sort map { $_->{plugin_name} } @plugins) - : ''; - $_; - } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchVendorOSByFilter($vendorOSData) - ); - - return 1; + my @vendorOSKeys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@vendorOSKeys, 'vendor_os', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$vendorOSData; + + dumpElements( + 'vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + $_->{plugins} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter($vendorOSData) + ); + + return 1; } sub changeVendorOSInConfigDB { - my $vendorOSName = _cleanName(shift || ''); + my $vendorOSName = _cleanName(shift || ''); - if (!length($vendorOSName)) { - die _tr( - "you have to specify the name for the vendor-OS you'd like to change!\n" - ); - } + if (!length($vendorOSName)) { + die _tr( + "you have to specify the name for the vendor-OS you'd like to change!\n" + ); + } - my @keys = $openslxDB->getColumnsOfTable('vendor_os'); - my $vendorOSData = parseKeyValueArgs(\@keys, 'vendor_os', @_); + my @keys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@keys, 'vendor_os', @_); - my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); - if (!defined $vendorOS) { - die _tr("the vendor-OS '%s' doesn't exists in the DB, giving up!\n", - $vendorOSName); - } + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (!defined $vendorOS) { + die _tr("the vendor-OS '%s' doesn't exists in the DB, giving up!\n", + $vendorOSName); + } - $openslxDB->changeVendorOS($vendorOS->{id}, [$vendorOSData]); - vlog( - 0, _tr("vendor-OS '%s' has been successfully changed\n", $vendorOSName) - ); + $openslxDB->changeVendorOS($vendorOS->{id}, [$vendorOSData]); + vlog( + 0, _tr("vendor-OS '%s' has been successfully changed\n", $vendorOSName) + ); - listVendorOSes("id=$vendorOS->{id}") if $option{verbose}; + listVendorOSes("id=$vendorOS->{id}") if $option{verbose}; - return 1; + return 1; } sub changeExportInConfigDB { - my $exportName = _cleanName(shift || ''); + my $exportName = _cleanName(shift || ''); - if (!length($exportName)) { - die _tr( - "you have to specify the name for the export you'd like to change!\n" - ); - } + if (!length($exportName)) { + die _tr( + "you have to specify the name for the export you'd like to change!\n" + ); + } - my @exportKeys = $openslxDB->getColumnsOfTable('export'); - my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); - if (!defined $export) { - die _tr("the export '%s' doesn't exists in the DB, giving up!\n", - $exportName); - } + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("the export '%s' doesn't exists in the DB, giving up!\n", + $exportName); + } - $openslxDB->changeExport($export->{id}, [$exportData]); - vlog(0, _tr("export '%s' has been successfully changed\n", $exportName)); + $openslxDB->changeExport($export->{id}, [$exportData]); + vlog(0, _tr("export '%s' has been successfully changed\n", $exportName)); - listExports("id=$export->{id}") if $option{verbose}; + listExports("id=$export->{id}") if $option{verbose}; - return 1; + return 1; } sub addClientToConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr("you have to specify the name for the new client\n"); - } - - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - push @clientKeys, 'systems'; - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $clientData = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - $clientData->{name} = $clientName; - - my @systemIDs; - if (exists $clientData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split '\s*,\s*', $clientData->{systems}; - delete $clientData->{systems}; - } - - if (!$clientData->{mac}) { - die _tr("you have to specify the MAC for the new client\n"); - } - if ($clientData->{mac} !~ - m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) - { - die _tr( - "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" - ); - } - - if ($openslxDB->fetchClientByFilter({'name' => $clientName})) { - die _tr("the client '%s' already exists in the DB, giving up!\n", - $clientName); - } - if ($openslxDB->fetchClientByFilter({'mac' => $clientData->{mac}})) { - die _tr( - "a client with the MAC '%s' already exists in the DB, giving up!\n", - $clientData->{mac} - ); - } - my $clientID = $openslxDB->addClient([$clientData]); - vlog( - 0, - _tr( - "client '%s' has been successfully added to DB (ID=%s)\n", - $clientName, $clientID - ) - ); - if (@systemIDs) { - $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); - } - if ($option{verbose}) { - listClients("id=$clientID"); - } - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr("you have to specify the name for the new client\n"); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + $clientData->{name} = $clientName; + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $clientData->{systems}; + delete $clientData->{systems}; + } + + if (!$clientData->{mac}) { + die _tr("you have to specify the MAC for the new client\n"); + } + if ($clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + if ($openslxDB->fetchClientByFilter({'name' => $clientName})) { + die _tr("the client '%s' already exists in the DB, giving up!\n", + $clientName); + } + if ($openslxDB->fetchClientByFilter({'mac' => $clientData->{mac}})) { + die _tr( + "a client with the MAC '%s' already exists in the DB, giving up!\n", + $clientData->{mac} + ); + } + my $clientID = $openslxDB->addClient([$clientData]); + vlog( + 0, + _tr( + "client '%s' has been successfully added to DB (ID=%s)\n", + $clientName, $clientID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); + } + if ($option{verbose}) { + listClients("id=$clientID"); + } + + return 1; } sub addGroupToConfigDB { - my $groupName = _cleanName(shift || ''); - if (!length($groupName)) { - die _tr("you have to specify the name for the new group\n"); - } - - my @groupKeys = $openslxDB->getColumnsOfTable('groups'); - push @groupKeys, 'systems', 'clients'; - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $groupData = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - $groupData->{name} = $groupName; - - my @systemIDs; - if (exists $groupData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split '\s*,\s*', $groupData->{systems}; - delete $groupData->{systems}; - } - my @clientIDs; - if (exists $groupData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split '\s*,\s*', $groupData->{clients}; - delete $groupData->{clients}; - } - - if (!defined $groupData->{priority} || !length($groupData->{priority})) { - $groupData->{priority} = 50; - vlog(0, _tr("priority of new group has been set to default (50).")); - } - - if ($openslxDB->fetchGroupByFilter({'name' => $groupName})) { - die _tr("the group '%s' already exists in the DB, giving up!\n", - $groupName); - } - my $groupID = $openslxDB->addGroup([$groupData]); - vlog( - 0, - _tr( - "group '%s' has been successfully added to DB (ID=%s)\n", - $groupName, $groupID - ) - ); - if (@systemIDs) { - $openslxDB->addSystemIDsToGroup($groupID, \@systemIDs); - } - if (@clientIDs) { - $openslxDB->addClientIDsToGroup($groupID, \@clientIDs); - } - listGroups("id=$groupID") if $option{verbose}; - - return 1; + my $groupName = _cleanName(shift || ''); + if (!length($groupName)) { + die _tr("you have to specify the name for the new group\n"); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + push @groupKeys, 'systems', 'clients'; + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + $groupData->{name} = $groupName; + + my @systemIDs; + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $groupData->{systems}; + delete $groupData->{systems}; + } + my @clientIDs; + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $groupData->{clients}; + delete $groupData->{clients}; + } + + if (!defined $groupData->{priority} || !length($groupData->{priority})) { + $groupData->{priority} = 50; + vlog(0, _tr("priority of new group has been set to default (50).")); + } + + if ($openslxDB->fetchGroupByFilter({'name' => $groupName})) { + die _tr("the group '%s' already exists in the DB, giving up!\n", + $groupName); + } + my $groupID = $openslxDB->addGroup([$groupData]); + vlog( + 0, + _tr( + "group '%s' has been successfully added to DB (ID=%s)\n", + $groupName, $groupID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToGroup($groupID, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->addClientIDsToGroup($groupID, \@clientIDs); + } + listGroups("id=$groupID") if $option{verbose}; + + return 1; } sub addSystemToConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr("you have to specify the name of the new system!\n"); - } - - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - push @systemKeys, 'clients', 'export'; - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my $systemData = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - $systemData->{name} = $systemName; - $systemData->{attrs} ||= {}; - - my $exportName = $systemData->{export} || ''; - delete $systemData->{export}; - if (!length($exportName)) { - $exportName = $systemName; - - # try falling back to given system name - } - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); - if (!defined $export) { - die _tr("export '%s' could not be found in DB, giving up!\n", - $exportName); - } - $systemData->{export_id} = $export->{id}; - - my @clientIDs; - if (exists $systemData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split '\s*,\s*', $systemData->{clients}; - delete $systemData->{clients}; - } - else { - # no clients given, so we add this system to the default client, - # which will make this system bootable by *all* clients (unless - # they are configured otherwise). - my $defaultClient = - $openslxDB->fetchClientByFilter({'name' => '<<>>'}); - push @clientIDs, $defaultClient->{id}; - } - - if ($openslxDB->fetchSystemByFilter({'name' => $systemName})) { - die _tr("the system '%s' already exists in the DB, giving up!\n", - $systemName); - } - - # activate kdm and X if system is based on kde: - if ($systemName =~ m[\bkde\b]) { - $systemData->{attrs}->{start_xdmcp} = 'kdm' - unless exists $systemData->{attrs}->{start_xdmcp}; - $systemData->{attrs}->{start_x} = 'yes' - unless exists $systemData->{attrs}->{start_x}; - } - # activate gdm and X if system is based on GNOME: - if ($systemName =~ m[\bgnome\b]) { - $systemData->{attrs}->{start_xdmcp} = 'gdm' - unless exists $systemData->{attrs}->{start_xdmcp}; - $systemData->{attrs}->{start_x} = 'yes' - unless exists $systemData->{attrs}->{start_x}; - } - - my $systemConfigPath = - "$openslxConfig{'private-path'}/config/$systemName/default"; - if (!-e $systemConfigPath) { - # create the default (empty) config folders for this system: - createConfigFolderForSystem($systemName); - } - - my $systemID = $openslxDB->addSystem([$systemData]); - vlog( - 0, - _tr( - "system '%s' has been successfully added to DB (ID=%s)\n", - $systemName, $systemID - ) - ); - if (@clientIDs) { - $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); - } - listSystems("id=$systemID") if $option{verbose}; - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr("you have to specify the name of the new system!\n"); + } + + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'export'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + $systemData->{name} = $systemName; + $systemData->{attrs} ||= {}; + + my $exportName = $systemData->{export} || ''; + delete $systemData->{export}; + if (!length($exportName)) { + $exportName = $systemName; + + # try falling back to given system name + } + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("export '%s' could not be found in DB, giving up!\n", + $exportName); + } + $systemData->{export_id} = $export->{id}; + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $systemData->{clients}; + delete $systemData->{clients}; + } + else { + # no clients given, so we add this system to the default client, + # which will make this system bootable by *all* clients (unless + # they are configured otherwise). + my $defaultClient = + $openslxDB->fetchClientByFilter({'name' => '<<>>'}); + push @clientIDs, $defaultClient->{id}; + } + + if ($openslxDB->fetchSystemByFilter({'name' => $systemName})) { + die _tr("the system '%s' already exists in the DB, giving up!\n", + $systemName); + } + + # activate kdm and X if system is based on kde: + if ($systemName =~ m[\bkde\b]) { + $systemData->{attrs}->{start_xdmcp} = 'kdm' + unless exists $systemData->{attrs}->{start_xdmcp}; + $systemData->{attrs}->{start_x} = 'yes' + unless exists $systemData->{attrs}->{start_x}; + } + # activate gdm and X if system is based on GNOME: + if ($systemName =~ m[\bgnome\b]) { + $systemData->{attrs}->{start_xdmcp} = 'gdm' + unless exists $systemData->{attrs}->{start_xdmcp}; + $systemData->{attrs}->{start_x} = 'yes' + unless exists $systemData->{attrs}->{start_x}; + } + + my $systemConfigPath = + "$openslxConfig{'private-path'}/config/$systemName/default"; + if (!-e $systemConfigPath) { + # create the default (empty) config folders for this system: + createConfigFolderForSystem($systemName); + } + + my $systemID = $openslxDB->addSystem([$systemData]); + vlog( + 0, + _tr( + "system '%s' has been successfully added to DB (ID=%s)\n", + $systemName, $systemID + ) + ); + if (@clientIDs) { + $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); + } + listSystems("id=$systemID") if $option{verbose}; + + return 1; } sub changeClientInConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr( - "you have to specify the name of the client you'd like to change!\n" - ); - } - - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - push @clientKeys, 'systems', 'add-systems', 'remove-systems'; - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $clientData = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - - my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("the client '%s' doesn't exists in the DB, giving up!\n", - $clientName); - } - - mergeNonExistingAttributes($clientData, $client); - - my @systemIDs; - if (exists $clientData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $clientData->{systems}; - delete $clientData->{systems}; - } - if (exists $clientData->{'add-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); - push @systemIDs, map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $clientData->{'add-systems'}; - delete $clientData->{'add-systems'}; - } - if (exists $clientData->{'remove-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); - foreach my $sysName (split ",", $clientData->{'remove-systems'}) { - my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $sysName); - } - @systemIDs = grep { $_ != $system->{id} } @systemIDs; - } - delete $clientData->{'remove-systems'}; - } - - if ($clientData->{name} && $client->{name} eq '<<>>') { - die _tr( - "you can't rename the default client - no changes were made!\n"); - } - - if ( $clientData->{mac} - && $clientData->{mac} !~ - m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) - { - die _tr( - "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" - ); - } - - $openslxDB->changeClient($client->{id}, [$clientData]); - vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); - if (@systemIDs) { - $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); - } - listClients("id=$client->{id}") if $option{verbose}; - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to change!\n" + ); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems', 'add-systems', 'remove-systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + + mergeNonExistingAttributes($clientData, $client); + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{systems}; + delete $clientData->{systems}; + } + if (exists $clientData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{'add-systems'}; + delete $clientData->{'add-systems'}; + } + if (exists $clientData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + foreach my $sysName (split ",", $clientData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $clientData->{'remove-systems'}; + } + + if ($clientData->{name} && $client->{name} eq '<<>>') { + die _tr( + "you can't rename the default client - no changes were made!\n"); + } + + if ( $clientData->{mac} + && $clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + $openslxDB->changeClient($client->{id}, [$clientData]); + vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); + } + listClients("id=$client->{id}") if $option{verbose}; + + return 1; } sub changeGroupInConfigDB { - my $groupName = _cleanName(shift || ''); - - if (!length($groupName)) { - die _tr( - "you have to specify the name of the group you'd like to change!\n" - ); - } - - my @groupKeys = $openslxDB->getColumnsOfTable('group'); - push @groupKeys, qw( - systems add-systems remove-systems clients add-clients remove-clients - ); - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $groupData = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - - my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); - if (!defined $group) { - die _tr("the group '%s' doesn't exists in the DB, giving up!\n", - $groupName); - } - - mergeNonExistingAttributes($groupData, $group); - - my (@systemIDs, @clientIDs); - if (exists $groupData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $groupData->{systems}; - delete $groupData->{systems}; - } - if (exists $groupData->{'add-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); - push @systemIDs, map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $groupData->{'add-systems'}; - delete $groupData->{'add-systems'}; - } - if (exists $groupData->{'remove-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); - foreach my $sysName (split ',', $groupData->{'remove-systems'}) { - my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $sysName); - } - @systemIDs = grep { $_ != $system->{id} } @systemIDs; - } - delete $groupData->{'remove-systems'}; - } - if (exists $groupData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split ",", $groupData->{clients}; - delete $groupData->{clients}; - } - if (exists $groupData->{'add-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); - push @clientIDs, map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $_); - } - $client->{id}; - } - split ",", $groupData->{'add-clients'}; - delete $groupData->{'add-clients'}; - } - if (exists $groupData->{'remove-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); - foreach my $clientName (split ",", $groupData->{'remove-clients'}) { - my $client = - $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $clientName); - } - @clientIDs = grep { $_ != $client->{id} } @clientIDs; - } - delete $groupData->{'remove-clients'}; - } - - if (defined $groupData->{priority} && $groupData->{priority} !~ m{^\d+$}) { - die _tr("unknown priority-format given, expected an integer!\n"); - } - - $openslxDB->changeGroup($group->{id}, [$groupData]); - vlog(0, _tr("group '%s' has been successfully changed\n", $groupName)); - if (@systemIDs) { - $openslxDB->setSystemIDsOfGroup($group->{id}, \@systemIDs); - } - if (@clientIDs) { - $openslxDB->setClientIDsOfGroup($group->{id}, \@clientIDs); - } - listGroups("id=$group->{id}") if $option{verbose}; - - return 1; + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to change!\n" + ); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('group'); + push @groupKeys, qw( + systems add-systems remove-systems clients add-clients remove-clients + ); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + + mergeNonExistingAttributes($groupData, $group); + + my (@systemIDs, @clientIDs); + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{systems}; + delete $groupData->{systems}; + } + if (exists $groupData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{'add-systems'}; + delete $groupData->{'add-systems'}; + } + if (exists $groupData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + foreach my $sysName (split ',', $groupData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $groupData->{'remove-systems'}; + } + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{clients}; + delete $groupData->{clients}; + } + if (exists $groupData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{'add-clients'}; + delete $groupData->{'add-clients'}; + } + if (exists $groupData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + foreach my $clientName (split ",", $groupData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $groupData->{'remove-clients'}; + } + + if (defined $groupData->{priority} && $groupData->{priority} !~ m{^\d+$}) { + die _tr("unknown priority-format given, expected an integer!\n"); + } + + $openslxDB->changeGroup($group->{id}, [$groupData]); + vlog(0, _tr("group '%s' has been successfully changed\n", $groupName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfGroup($group->{id}, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->setClientIDsOfGroup($group->{id}, \@clientIDs); + } + listGroups("id=$group->{id}") if $option{verbose}; + + return 1; } sub changeSystemInConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr( - "you have to specify the name of the system you'd like to change!\n" - ); - } - - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - push @systemKeys, 'clients', 'add-clients', 'remove-clients'; - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my $systemData = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - - my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); - if (!defined $system) { - die _tr("the system '%s' doesn't exists in the DB, giving up!\n", - $systemName); - } - - mergeNonExistingAttributes($systemData, $system); - - my @clientIDs; - if (exists $systemData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split ",", $systemData->{clients}; - delete $systemData->{clients}; - } - if (exists $systemData->{'add-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); - push @clientIDs, map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $_); - } - $client->{id}; - } - split ",", $systemData->{'add-clients'}; - delete $systemData->{'add-clients'}; - } - if (exists $systemData->{'remove-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); - foreach my $clientName (split ",", $systemData->{'remove-clients'}) { - my $client = - $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $clientName); - } - @clientIDs = grep { $_ != $client->{id} } @clientIDs; - } - delete $systemData->{'remove-clients'}; - } - if ($systemData->{name} && $system->{name} eq '<<>>') { - die _tr( - "you can't rename the default system - no changes were made!\n"); - } - - $openslxDB->changeSystem($system->{id}, $systemData); - vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); - if (@clientIDs) { - $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); - } - listSystems("id=$system->{id}")if $option{verbose}; - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to change!\n" + ); + } + + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'add-clients', 'remove-clients'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + + mergeNonExistingAttributes($systemData, $system); + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{clients}; + delete $systemData->{clients}; + } + if (exists $systemData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{'add-clients'}; + delete $systemData->{'add-clients'}; + } + if (exists $systemData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + foreach my $clientName (split ",", $systemData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $systemData->{'remove-clients'}; + } + if ($systemData->{name} && $system->{name} eq '<<>>') { + die _tr( + "you can't rename the default system - no changes were made!\n"); + } + + $openslxDB->changeSystem($system->{id}, $systemData); + vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); + if (@clientIDs) { + $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); + } + listSystems("id=$system->{id}")if $option{verbose}; + + return 1; } sub removeClientFromConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr( - "you have to specify the name of the client you'd like to remove!\n" - ); - } - - my $clientData = parseKeyValueArgs(['name'], 'client', @_); - - my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("the client '%s' doesn't exists in the DB, giving up!\n", - $clientName); - } - if ($client->{name} eq '<<>>') { - die _tr("you can't remove the default client!\n"); - } - $openslxDB->removeClient($client->{id}); - vlog(0, - _tr("client '%s' has been successfully removed from DB\n", $clientName) - ); - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to remove!\n" + ); + } + + my $clientData = parseKeyValueArgs(['name'], 'client', @_); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + if ($client->{name} eq '<<>>') { + die _tr("you can't remove the default client!\n"); + } + $openslxDB->removeClient($client->{id}); + vlog(0, + _tr("client '%s' has been successfully removed from DB\n", $clientName) + ); + + return 1; } sub removeGroupFromConfigDB { - my $groupName = _cleanName(shift || ''); - - if (!length($groupName)) { - die _tr( - "you have to specify the name of the group you'd like to remove!\n" - ); - } - - my $groupData = parseKeyValueArgs(['name'], 'group', @_); - - my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); - if (!defined $group) { - die _tr("the group '%s' doesn't exists in the DB, giving up!\n", - $groupName); - } - $openslxDB->removeGroup($group->{id}); - vlog(0, - _tr("group '%s' has been successfully removed from DB\n", $groupName) - ); - - return 1; + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to remove!\n" + ); + } + + my $groupData = parseKeyValueArgs(['name'], 'group', @_); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + $openslxDB->removeGroup($group->{id}); + vlog(0, + _tr("group '%s' has been successfully removed from DB\n", $groupName) + ); + + return 1; } sub removeSystemFromConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr( - "you have to specify the name of the system you'd like to remove!\n" - ); - } - - my $systemData = parseKeyValueArgs(['name'], 'system', @_); - - my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); - if (!defined $system) { - die _tr("the system '%s' doesn't exists in the DB, giving up!\n", - $systemName); - } - if ($system->{name} eq '<<>>') { - die _tr("you can't remove the default system!\n"); - } - $openslxDB->removeSystem($system->{id}); - vlog(0, - _tr("system '%s' has been successfully removed from DB\n", $systemName) - ); - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to remove!\n" + ); + } + + my $systemData = parseKeyValueArgs(['name'], 'system', @_); + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + if ($system->{name} eq '<<>>') { + die _tr("you can't remove the default system!\n"); + } + $openslxDB->removeSystem($system->{id}); + vlog(0, + _tr("system '%s' has been successfully removed from DB\n", $systemName) + ); + + return 1; } sub _expandClients -{ # expands info for given clients - return - map { - my @sysIDs = $openslxDB->fetchSystemIDsOfClient($_->{id}); - $_->{systems} - = join "\n", - map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByID(\@sysIDs, 'name'); - if ($option{inherited}) { - my $mergedClient = dclone($_); - my $originInfo = {}; - $openslxDB->mergeDefaultAndGroupAttributesIntoClient( - $mergedClient, $originInfo - ); - my $mergedAttrs = $mergedClient->{attrs} || {}; - $_->{attrs} = {}; - foreach my $attr (keys %$mergedAttrs) { - my $origin = $originInfo->{$attr}; - my $enhancedName = $origin ? "[$origin] $attr" : $attr; - $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; - } - } - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given clients + return + map { + my @sysIDs = $openslxDB->fetchSystemIDsOfClient($_->{id}); + $_->{systems} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@sysIDs, 'name'); + if ($option{inherited}) { + my $mergedClient = dclone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAndGroupAttributesIntoClient( + $mergedClient, $originInfo + ); + my $mergedAttrs = $mergedClient->{attrs} || {}; + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _expandGroups -{ # expands info for given groups - return - map { - my @systemIDs = $openslxDB->fetchSystemIDsOfGroup($_->{id}); - $_->{systems} - = join "\n", map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByID(\@systemIDs, 'name'); - my @clientIDs = $openslxDB->fetchClientIDsOfGroup($_->{id}); - $_->{clients} - = join "\n", map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByID(\@clientIDs, 'name'); - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given groups + return + map { + my @systemIDs = $openslxDB->fetchSystemIDsOfGroup($_->{id}); + $_->{systems} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@systemIDs, 'name'); + my @clientIDs = $openslxDB->fetchClientIDsOfGroup($_->{id}); + $_->{clients} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _expandSystems -{ # expands info for given systems - return - map { - my @clientIDs = $openslxDB->fetchClientIDsOfSystem($_->{id}); - $_->{clients} - = join "\n", - map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByID(\@clientIDs, 'name'); - my @activePlugins; - my $export = $openslxDB->fetchExportByID($_->{export_id}); - if (defined $export) { - $_->{export_id} - = "$export->{id} ($export->{name})"; - - # fetch detailed info about active plugins - my @installedPlugins = $openslxDB->fetchInstalledPlugins( - $export->{vendor_os_id} - ); - my $mergedSystem = dclone($_); - my $originInfo = {}; - $openslxDB->mergeDefaultAttributesIntoSystem( - $mergedSystem, \@installedPlugins, $originInfo - ); - my $mergedAttrs = $mergedSystem->{attrs} || {}; - foreach my $plugin (@installedPlugins) { - next if !$mergedAttrs->{"$plugin->{plugin_name}::active"}; - push @activePlugins, $plugin; - } - if ($option{inherited}) { - $_->{attrs} = {}; - foreach my $attr (keys %$mergedAttrs) { - my $origin = $originInfo->{$attr}; - my $enhancedName = $origin ? "[$origin] $attr" : $attr; - $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; - } - } - } - $_->{PLUGINS} = [ sort map { $_->{plugin_name} } @activePlugins ]; - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given systems + return + map { + my @clientIDs = $openslxDB->fetchClientIDsOfSystem($_->{id}); + $_->{clients} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + my @activePlugins; + my $export = $openslxDB->fetchExportByID($_->{export_id}); + if (defined $export) { + $_->{export_id} + = "$export->{id} ($export->{name})"; + + # fetch detailed info about active plugins + my @installedPlugins = $openslxDB->fetchInstalledPlugins( + $export->{vendor_os_id} + ); + my $mergedSystem = dclone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAttributesIntoSystem( + $mergedSystem, \@installedPlugins, $originInfo + ); + my $mergedAttrs = $mergedSystem->{attrs} || {}; + foreach my $plugin (@installedPlugins) { + next if !$mergedAttrs->{"$plugin->{plugin_name}::active"}; + push @activePlugins, $plugin; + } + if ($option{inherited}) { + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + } + $_->{PLUGINS} = [ sort map { $_->{plugin_name} } @activePlugins ]; + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _cleanName -{ # removes 'name=""' constructs from the name, as it is rather tempting - # for the user to type that ... (and we'd like to play along with DWIM) - my $name = shift; +{ # removes 'name=""' constructs from the name, as it is rather tempting + # for the user to type that ... (and we'd like to play along with DWIM) + my $name = shift; - return unless defined $name; + return unless defined $name; - if ($name =~ m[^name=(.+)$]) { - return $1; - } + if ($name =~ m[^name=(.+)$]) { + return $1; + } - return $name; + return $name; } =head1 NAME diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer index 03d2ca2e..f6592b88 100755 --- a/config-db/slxconfig-demuxer +++ b/config-db/slxconfig-demuxer @@ -11,7 +11,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # slxconfig-demuxer -# - OpenSLX configuration demultiplexer +# - OpenSLX configuration demultiplexer # ----------------------------------------------------------------------------- use strict; use warnings; @@ -54,54 +54,54 @@ use OpenSLX::MakeInitRamFS::Engine; use OpenSLX::Utils; my $pxeDefaultTemplate = unshiftHereDoc(<<'End-of-Here'); - NOESCAPE 0 - PROMPT 0 - TIMEOUT 10 - DEFAULT menu.c32 - IMPLICIT 1 - ALLOWOPTIONS 1 - MENU TITLE Was möchten Sie tun (Auswahl mittels Cursortasten)? - MENU MASTER PASSWD secret + NOESCAPE 0 + PROMPT 0 + TIMEOUT 10 + DEFAULT menu.c32 + IMPLICIT 1 + ALLOWOPTIONS 1 + MENU TITLE Was möchten Sie tun (Auswahl mittels Cursortasten)? + MENU MASTER PASSWD secret End-of-Here utf8::decode($pxeDefaultTemplate); my ( - $systemConfCount, - # number of system configurations written - $systemErrCount, - # number of systems that had errors - $clientSystemConfCount, - # number of (system-specific) client configurations written - $initramfsCount, - # number of initramfs that were created - @targetSystems, - # systems to create initramfs for, defaults to all systems - %option, - # cmdline option hash + $systemConfCount, + # number of system configurations written + $systemErrCount, + # number of systems that had errors + $clientSystemConfCount, + # number of (system-specific) client configurations written + $initramfsCount, + # number of initramfs that were created + @targetSystems, + # systems to create initramfs for, defaults to all systems + %option, + # cmdline option hash ); if ($> != 0) { - die _tr("Sorry, this script can only be executed by the superuser!\n"); + die _tr("Sorry, this script can only be executed by the superuser!\n"); } GetOptions( - 'dhcp-export-type=s' => \$option{dhcpType}, - 'dry-run' => \$option{dryRun}, - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'version' => \$option{versionReq}, + 'dhcp-export-type=s' => \$option{dhcpType}, + 'dry-run' => \$option{dryRun}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - slxsystem('slxversion'); - exit 1; + slxsystem('slxversion'); + exit 1; } my ($sec, $min, $hour, $day, $mon, $year) = (localtime); @@ -118,12 +118,12 @@ $openslxDB->connect(); my $clientConfigPath = "$openslxConfig{'private-path'}/config"; # make sure that the default config folders exist: if (createConfigFolderForDefaultSystem()) { - # this path should have been generated by earlier stage (slxsettings), so - # we indicate that there is some kind of problem: - warn _tr( - "Completed client-config-folder '%s', since at least some parts of it didn't exist!", - $clientConfigPath - ); + # this path should have been generated by earlier stage (slxsettings), so + # we indicate that there is some kind of problem: + warn _tr( + "Completed client-config-folder '%s', since at least some parts of it didn't exist!", + $clientConfigPath + ); } chomp(my $slxVersion = qx{slxversion}); @@ -133,55 +133,55 @@ my $haveLock = lockScript($lockFile); END { - unlockScript($lockFile) if $haveLock; + unlockScript($lockFile) if $haveLock; } my $tempPath = "$openslxConfig{'temp-path'}/slxconfig-demuxer"; if (!$option{dryRun}) { - rmtree($tempPath); - mkpath($tempPath); - if (!-d $tempPath) { - die _tr("Unable to create or access temp-path '%s'!", $tempPath); - } + rmtree($tempPath); + mkpath($tempPath); + if (!-d $tempPath) { + die _tr("Unable to create or access temp-path '%s'!", $tempPath); + } } my $tftpbootPath = "$openslxConfig{'public-path'}/tftpboot"; my $tftpbuildPath = "$openslxConfig{'public-path'}/tftpboot.new"; if (!$option{dryRun}) { - mkpath([$tftpbootPath]); - rmtree("$tftpbuildPath/pxelinux.cfg"); - mkpath(["$tftpbuildPath/client-config", "$tftpbuildPath/pxelinux.cfg"]); + mkpath([$tftpbootPath]); + rmtree("$tftpbuildPath/pxelinux.cfg"); + mkpath(["$tftpbuildPath/client-config", "$tftpbuildPath/pxelinux.cfg"]); } my $rsyncDeleteClause; my @demuxableSystems - = grep { $_->{name} ne '<<>>' } $openslxDB->fetchSystemByFilter(); + = grep { $_->{name} ne '<<>>' } $openslxDB->fetchSystemByFilter(); if (@ARGV) { - # create initramfs only for systems given on cmdline - for my $systemName (@ARGV) { - if ($systemName eq '<<>>') { - warn _tr( - 'The default-system can not be demuxed - it will be skipped.' - ); - next; - } - my $system = first { $_->{name} eq $systemName } @demuxableSystems; - if (!$system) { - warn _tr( - 'The system "%s" is unknown and will be ignored.', $systemName - ); - next; - } - push @targetSystems, $system; - } - $rsyncDeleteClause = ''; + # create initramfs only for systems given on cmdline + for my $systemName (@ARGV) { + if ($systemName eq '<<>>') { + warn _tr( + 'The default-system can not be demuxed - it will be skipped.' + ); + next; + } + my $system = first { $_->{name} eq $systemName } @demuxableSystems; + if (!$system) { + warn _tr( + 'The system "%s" is unknown and will be ignored.', $systemName + ); + next; + } + push @targetSystems, $system; + } + $rsyncDeleteClause = ''; } else { - # create initramfs for all systems - @targetSystems = @demuxableSystems; - # let rsync delete old files - $rsyncDeleteClause = '--delete'; + # create initramfs for all systems + @targetSystems = @demuxableSystems; + # let rsync delete old files + $rsyncDeleteClause = '--delete'; } writeConfigurations(); @@ -189,22 +189,22 @@ writeConfigurations(); my $wr = $option{dryRun} ? 'would have written' : 'wrote'; my $errCount = $systemErrCount ? $systemErrCount : 'no'; print "\n", unshiftHereDoc(<<"End-of-Here"); - $wr $systemConfCount system- and $clientSystemConfCount client-specific configurations to $tftpbootPath/client-config - $initramfsCount initramfs were created - $errCount system(s) had errors + $wr $systemConfCount system- and $clientSystemConfCount client-specific configurations to $tftpbootPath/client-config + $initramfsCount initramfs were created + $errCount system(s) had errors End-of-Here $openslxDB->disconnect(); if (!$option{dryRun}) { - rmtree([$tempPath]); - my $rsyncCmd = "rsync -a $rsyncDeleteClause --delay-updates $tftpbuildPath/ $tftpbootPath/"; - slxsystem($rsyncCmd) == 0 - or die _tr( - "unable to rsync files from '%s' to '%s'! (%s)", - $tftpbuildPath, $tftpbootPath, $! - ); - rmtree([$tftpbuildPath]); + rmtree([$tempPath]); + my $rsyncCmd = "rsync -a $rsyncDeleteClause --delay-updates $tftpbuildPath/ $tftpbootPath/"; + slxsystem($rsyncCmd) == 0 + or die _tr( + "unable to rsync files from '%s' to '%s'! (%s)", + $tftpbuildPath, $tftpbootPath, $! + ); + rmtree([$tftpbuildPath]); } exit; @@ -214,181 +214,181 @@ exit; ################################################################################ sub lockScript { - my $lockFile = shift; - - return if $option{dryRun}; - - # use a lock-file to singularize execution of this script: - if (-e $lockFile) { - my $ctime = (stat($lockFile))[10]; - my $now = time(); - if ($now - $ctime > 15 * 60) { - # existing lock file is older than 15 minutes, wipe it: - unlink $lockFile; - } - } - if (!sysopen(LOCKFILE, $lockFile, O_RDWR | O_CREAT | O_EXCL)) { - if ($! == 13) { - die _tr(qq[Unable to create lock-file <%s>, exiting!\n], $lockFile); - } else { - die _tr( - qq[Lock-file <%s> exists, script is already running. + my $lockFile = shift; + + return if $option{dryRun}; + + # use a lock-file to singularize execution of this script: + if (-e $lockFile) { + my $ctime = (stat($lockFile))[10]; + my $now = time(); + if ($now - $ctime > 15 * 60) { + # existing lock file is older than 15 minutes, wipe it: + unlink $lockFile; + } + } + if (!sysopen(LOCKFILE, $lockFile, O_RDWR | O_CREAT | O_EXCL)) { + if ($! == 13) { + die _tr(qq[Unable to create lock-file <%s>, exiting!\n], $lockFile); + } else { + die _tr( + qq[Lock-file <%s> exists, script is already running. Please remove the logfile and try again if you are sure that no one else is executing this script.\n], $lockFile - ); - } - } - return 1; + ); + } + } + return 1; } sub unlockScript { - my $lockFile = shift; + my $lockFile = shift; - return if $option{dryRun}; + return if $option{dryRun}; - close(LOCKFILE); - unlink $lockFile; + close(LOCKFILE); + unlink $lockFile; - return; + return; } sub folderContainsFiles { - my $folder = shift; - - return 0 unless -d $folder; - - my $result = 0; - my $wanted = sub { - if ($result) { - # skip anything else if we have found a file already - $File::Find::prune = 1; - } - $result = 1 if -f; - }; - find({wanted => $wanted, follow_fast => 1}, $folder); - vlog(2, "result for folderContainsFiles($folder): $result\n"); - return $result; + my $folder = shift; + + return 0 unless -d $folder; + + my $result = 0; + my $wanted = sub { + if ($result) { + # skip anything else if we have found a file already + $File::Find::prune = 1; + } + $result = 1 if -f; + }; + find({wanted => $wanted, follow_fast => 1}, $folder); + vlog(2, "result for folderContainsFiles($folder): $result\n"); + return $result; } sub digestAttributes -{ # returns a digest-string for the given attribute hash, in order to - # facilitate comparing different attribute hashes. - my $object = shift; - - my $attrs = $object->{attrs} || {}; - my $attrsAsString - = join ';', - map { "$_=$attrs->{$_}" } - sort - grep { defined $attrs->{$_} } - keys %$attrs; - - vlog(3, "Attribute-string: $attrsAsString"); - return md5_hex($attrsAsString); +{ # returns a digest-string for the given attribute hash, in order to + # facilitate comparing different attribute hashes. + my $object = shift; + + my $attrs = $object->{attrs} || {}; + my $attrsAsString + = join ';', + map { "$_=$attrs->{$_}" } + sort + grep { defined $attrs->{$_} } + keys %$attrs; + + vlog(3, "Attribute-string: $attrsAsString"); + return md5_hex($attrsAsString); } sub writeAttributesToFile { - my $object = shift; - my $fileName = shift; - - return if $option{dryRun}; - - my $content = "# attributes set by slxconfig-demuxer:\n"; - my $attrs = $object->{attrs} || {}; - # filter out any plugin-specific attributes (we only want to handle - # the attributes relevant to the core here) - my @attrs = sort grep { index($_, '::') == -1 } keys %$attrs; - foreach my $attr (@attrs) { - my $attrVal = $attrs->{$attr}; - next if !defined $attrVal; - $content .= qq[$attr="$attrVal"\n]; - } - # Overwrite attribute file even if it exists, to make sure that our users - # will never again try to fiddle with machine-setup directly the - # file-system. From now on the DB is the keeper of that info. - spitFile($fileName, $content); - if ($openslxConfig{'verbose-level'} > 2) { - vlog(0, "--- START OF $fileName ---"); - vlog(0, $content); - vlog(0, "--- END OF $fileName --- "); - } - return; + my $object = shift; + my $fileName = shift; + + return if $option{dryRun}; + + my $content = "# attributes set by slxconfig-demuxer:\n"; + my $attrs = $object->{attrs} || {}; + # filter out any plugin-specific attributes (we only want to handle + # the attributes relevant to the core here) + my @attrs = sort grep { index($_, '::') == -1 } keys %$attrs; + foreach my $attr (@attrs) { + my $attrVal = $attrs->{$attr}; + next if !defined $attrVal; + $content .= qq[$attr="$attrVal"\n]; + } + # Overwrite attribute file even if it exists, to make sure that our users + # will never again try to fiddle with machine-setup directly the + # file-system. From now on the DB is the keeper of that info. + spitFile($fileName, $content); + if ($openslxConfig{'verbose-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + return; } sub writeSlxConfigToFile { - my $slxConf = shift; - my $fileName = shift; + my $slxConf = shift; + my $fileName = shift; - return if $option{dryRun}; + return if $option{dryRun}; - my $content = ''; - foreach my $key (sort keys %$slxConf) { - $content .= qq[$key="$slxConf->{$key}"\n]; - } - spitFile($fileName, $content); - return; + my $content = ''; + foreach my $key (sort keys %$slxConf) { + $content .= qq[$key="$slxConf->{$key}"\n]; + } + spitFile($fileName, $content); + return; } sub copyExternalSystemConfig { # copies local configuration extensions of given system from private # config folder (var/lib/openslx/config/...) into a temporary folder - my $systemName = shift; - my $targetPath = shift; - my $clientName = shift; # optional - - if ($targetPath !~ m[$tempPath]) { - # bail if target-path isn't within temp folder, as we do not dare - # executing 'rm -rf' in that case! - die _tr("system-error: illegal target-path <%s>!", $targetPath); - } - return if $option{dryRun}; - - slxsystem("rm -rf $targetPath"); - mkpath $targetPath; - - # first copy default files ... - my $defaultConfigPath = "$clientConfigPath/default"; - vlog(2, "checking $defaultConfigPath for default config..."); - if (-d $defaultConfigPath) { - slxsystem("cp -a $defaultConfigPath/* $targetPath"); - } - # ... now pour system-specific configuration on top (if any): - my $systemSpecConfigPath = "$clientConfigPath/$systemName/default"; - vlog(2, "checking $systemSpecConfigPath for system config..."); - if (folderContainsFiles($systemSpecConfigPath)) { - slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); - } - if (defined $clientName) { - # client has been given, so we finally pour client-specific - # configuration on top (if any): - my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; - vlog(2, "checking $clientSpecConfigPath for client config..."); - if (folderContainsFiles($clientSpecConfigPath)) { - slxsystem("cp -a $clientSpecConfigPath/* $targetPath"); - } - } - return; + my $systemName = shift; + my $targetPath = shift; + my $clientName = shift; # optional + + if ($targetPath !~ m[$tempPath]) { + # bail if target-path isn't within temp folder, as we do not dare + # executing 'rm -rf' in that case! + die _tr("system-error: illegal target-path <%s>!", $targetPath); + } + return if $option{dryRun}; + + slxsystem("rm -rf $targetPath"); + mkpath $targetPath; + + # first copy default files ... + my $defaultConfigPath = "$clientConfigPath/default"; + vlog(2, "checking $defaultConfigPath for default config..."); + if (-d $defaultConfigPath) { + slxsystem("cp -a $defaultConfigPath/* $targetPath"); + } + # ... now pour system-specific configuration on top (if any): + my $systemSpecConfigPath = "$clientConfigPath/$systemName/default"; + vlog(2, "checking $systemSpecConfigPath for system config..."); + if (folderContainsFiles($systemSpecConfigPath)) { + slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); + } + if (defined $clientName) { + # client has been given, so we finally pour client-specific + # configuration on top (if any): + my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; + vlog(2, "checking $clientSpecConfigPath for client config..."); + if (folderContainsFiles($clientSpecConfigPath)) { + slxsystem("cp -a $clientSpecConfigPath/* $targetPath"); + } + } + return; } sub createTarOfPath { - my $buildPath = shift; - my $tarName = shift; - my $destinationPath = shift; - - my $tarFile = "$destinationPath/$tarName"; - vlog(1, _tr('creating tar %s', $tarFile)); - return if $option{dryRun}; - - mkpath $destinationPath; - my $tarCmd = "cd $buildPath && tar czf $tarFile *"; - if (slxsystem("$tarCmd") != 0) { - die _tr("unable to execute shell-command:\n\t%s \n\t(%s)", $tarCmd, $!); - } + my $buildPath = shift; + my $tarName = shift; + my $destinationPath = shift; + + my $tarFile = "$destinationPath/$tarName"; + vlog(1, _tr('creating tar %s', $tarFile)); + return if $option{dryRun}; + + mkpath $destinationPath; + my $tarCmd = "cd $buildPath && tar czf $tarFile *"; + if (slxsystem("$tarCmd") != 0) { + die _tr("unable to execute shell-command:\n\t%s \n\t(%s)", $tarCmd, $!); + } } ################################################################################ @@ -396,408 +396,408 @@ sub createTarOfPath ################################################################################ sub writePXEMenus { - my @infos = @_; - - my $pxePath = "$tftpbuildPath"; - my $pxeConfigPath = "$tftpbuildPath/pxelinux.cfg"; - - if (!-e "$pxePath/pxelinux.0") { - my $pxelinux0Path = - "$openslxConfig{'base-path'}/share/tftpboot/pxelinux.0"; - slxsystem(qq[cp -p "$pxelinux0Path" $pxePath/]) unless $option{dryRun}; - } - if (!-e "$pxePath/menu.c32") { - my $menuc32Path = "$openslxConfig{'base-path'}/share/tftpboot/menu.c32"; - slxsystem(qq[cp -p "$menuc32Path" $pxePath/]) unless $option{dryRun}; - } - if (!-e "$pxePath/vesamenu.c32") { - my $vesamenuc32Path = - "$openslxConfig{'base-path'}/share/tftpboot/vesamenu.c32"; - slxsystem(qq[cp -p "$vesamenuc32Path" $pxePath/]) unless $option{dryRun}; - } - - # fetch PXE-template, if any - my $pxeTemplate = - "# generated by slxconfig-demuxer (on $callDate at $callTime)\n"; - my $pxeTemplateFile = "$openslxConfig{'config-path'}/PXE-template"; - if (-e $pxeTemplateFile) { - $pxeTemplate .= slurpFile($pxeTemplateFile); - } else { - $pxeTemplate .= $pxeDefaultTemplate; - } - - # now append (and thus override) the PXE-template with the settings of the - # selected PXE-theme, if any - my $pxeTheme = $openslxConfig{'pxe-theme'}; - if (defined $pxeTheme) { - my $pxeThemeConfig - = "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/theme.conf"; - if (-e $pxeThemeConfig) { - $pxeTemplate .= slurpFile($pxeThemeConfig); - } - } - - # fetch info about margin and replace the corresponding placeholders - my $margin = $openslxConfig{'pxe-theme-menu-margin'} || 0; - my $marginAsText = ' ' x $margin; - $pxeTemplate =~ s{\@\@\@MENU_MARGIN\@\@\@}{$margin}g; - my $separatorLine = '-' x (78 - 4 - 2 * $margin); - $pxeTemplate =~ s{\@\@\@SEPARATOR_LINE\@\@\@}{$separatorLine}g; - - # pick out the last background picture and copy it over - my $pic; - while ($pxeTemplate =~ m{^\s*MENU BACKGROUND (\S+?)\s*$}gims) { - chomp($pic = $1); - } - if (defined $pic) { - my $pxeBackground - = defined $pxeTheme - ? "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/$pic" - : $pic; - if (-e $pxeBackground) { - slxsystem(qq[cp "$pxeBackground" $pxePath/]) unless $option{dryRun}; - } - } - - my @clients = $openslxDB->fetchClientByFilter(); - foreach my $client (@clients) { - my $pxeConfig = $pxeTemplate; - my $externalClientID = externalIDForClient($client); - my $pxeFile = "$pxeConfigPath/$externalClientID"; - my $clientAppend = $client->{kernel_params} || ''; - vlog(1, _tr("writing PXE-file %s", $pxeFile)); - next if $option{dryRun}; - my %systemIDs; - @systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = (); - my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos; - # now @systemInfos holds all infos relevant to this client - my $slxLabels = ''; - foreach my $info (@systemInfos) { - my $extID = $info->{'vendor-os'}->{name}; - my $kernelName = basename($info->{'kernel-file'}); - my $append = $info->{kernel_params}; - $append .= " initrd=$extID/$info->{'initramfs-name'}"; - $append .= " $clientAppend"; - $slxLabels .= "LABEL openslx-$info->{'external-id'}\n"; - my $label = $info->{label} || ''; - if (!length($label) || $label eq $info->{name}) { - if ($info->{name} =~ m{^(.+)::(.+)$}) { - my $system = $1; - my $exportType = $2; - $label = $system . ' ' x (40-length($system)) . $exportType; - } else { - $label = $info->{name}; - } - } - $slxLabels .= "\tMENU LABEL ^$label\n"; - $slxLabels .= "\tKERNEL $extID/$kernelName\n"; - $slxLabels .= "\tAPPEND $append\n"; - $slxLabels .= "\tIPAPPEND 1\n"; - my $helpText = $info->{description} || ''; - if (length($helpText)) { - # make sure that text matches the given margin - $helpText =~ s{^}{$marginAsText}gms; - $slxLabels .= "\tTEXT HELP\n$helpText\n\tENDTEXT\n"; - } - } - # now add the slx-labels (inline or appended) and write the config file - if (!($pxeConfig =~ s{\@\@\@SLX_LABELS\@\@\@}{$slxLabels})) { - $pxeConfig .= $slxLabels; - } - - # PXE uses 'cp850' (codepage 850) but our string is in utf-8, we have - # to convert in order to avoid showing gibberish on the client side... - spitFile($pxeFile, $pxeConfig, { 'io-layer' => 'encoding(cp850)' } ); - } - return; + my @infos = @_; + + my $pxePath = "$tftpbuildPath"; + my $pxeConfigPath = "$tftpbuildPath/pxelinux.cfg"; + + if (!-e "$pxePath/pxelinux.0") { + my $pxelinux0Path = + "$openslxConfig{'base-path'}/share/tftpboot/pxelinux.0"; + slxsystem(qq[cp -p "$pxelinux0Path" $pxePath/]) unless $option{dryRun}; + } + if (!-e "$pxePath/menu.c32") { + my $menuc32Path = "$openslxConfig{'base-path'}/share/tftpboot/menu.c32"; + slxsystem(qq[cp -p "$menuc32Path" $pxePath/]) unless $option{dryRun}; + } + if (!-e "$pxePath/vesamenu.c32") { + my $vesamenuc32Path = + "$openslxConfig{'base-path'}/share/tftpboot/vesamenu.c32"; + slxsystem(qq[cp -p "$vesamenuc32Path" $pxePath/]) unless $option{dryRun}; + } + + # fetch PXE-template, if any + my $pxeTemplate = + "# generated by slxconfig-demuxer (on $callDate at $callTime)\n"; + my $pxeTemplateFile = "$openslxConfig{'config-path'}/PXE-template"; + if (-e $pxeTemplateFile) { + $pxeTemplate .= slurpFile($pxeTemplateFile); + } else { + $pxeTemplate .= $pxeDefaultTemplate; + } + + # now append (and thus override) the PXE-template with the settings of the + # selected PXE-theme, if any + my $pxeTheme = $openslxConfig{'pxe-theme'}; + if (defined $pxeTheme) { + my $pxeThemeConfig + = "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/theme.conf"; + if (-e $pxeThemeConfig) { + $pxeTemplate .= slurpFile($pxeThemeConfig); + } + } + + # fetch info about margin and replace the corresponding placeholders + my $margin = $openslxConfig{'pxe-theme-menu-margin'} || 0; + my $marginAsText = ' ' x $margin; + $pxeTemplate =~ s{\@\@\@MENU_MARGIN\@\@\@}{$margin}g; + my $separatorLine = '-' x (78 - 4 - 2 * $margin); + $pxeTemplate =~ s{\@\@\@SEPARATOR_LINE\@\@\@}{$separatorLine}g; + + # pick out the last background picture and copy it over + my $pic; + while ($pxeTemplate =~ m{^\s*MENU BACKGROUND (\S+?)\s*$}gims) { + chomp($pic = $1); + } + if (defined $pic) { + my $pxeBackground + = defined $pxeTheme + ? "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/$pic" + : $pic; + if (-e $pxeBackground) { + slxsystem(qq[cp "$pxeBackground" $pxePath/]) unless $option{dryRun}; + } + } + + my @clients = $openslxDB->fetchClientByFilter(); + foreach my $client (@clients) { + my $pxeConfig = $pxeTemplate; + my $externalClientID = externalIDForClient($client); + my $pxeFile = "$pxeConfigPath/$externalClientID"; + my $clientAppend = $client->{kernel_params} || ''; + vlog(1, _tr("writing PXE-file %s", $pxeFile)); + next if $option{dryRun}; + my %systemIDs; + @systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = (); + my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos; + # now @systemInfos holds all infos relevant to this client + my $slxLabels = ''; + foreach my $info (@systemInfos) { + my $extID = $info->{'vendor-os'}->{name}; + my $kernelName = basename($info->{'kernel-file'}); + my $append = $info->{kernel_params}; + $append .= " initrd=$extID/$info->{'initramfs-name'}"; + $append .= " $clientAppend"; + $slxLabels .= "LABEL openslx-$info->{'external-id'}\n"; + my $label = $info->{label} || ''; + if (!length($label) || $label eq $info->{name}) { + if ($info->{name} =~ m{^(.+)::(.+)$}) { + my $system = $1; + my $exportType = $2; + $label = $system . ' ' x (40-length($system)) . $exportType; + } else { + $label = $info->{name}; + } + } + $slxLabels .= "\tMENU LABEL ^$label\n"; + $slxLabels .= "\tKERNEL $extID/$kernelName\n"; + $slxLabels .= "\tAPPEND $append\n"; + $slxLabels .= "\tIPAPPEND 1\n"; + my $helpText = $info->{description} || ''; + if (length($helpText)) { + # make sure that text matches the given margin + $helpText =~ s{^}{$marginAsText}gms; + $slxLabels .= "\tTEXT HELP\n$helpText\n\tENDTEXT\n"; + } + } + # now add the slx-labels (inline or appended) and write the config file + if (!($pxeConfig =~ s{\@\@\@SLX_LABELS\@\@\@}{$slxLabels})) { + $pxeConfig .= $slxLabels; + } + + # PXE uses 'cp850' (codepage 850) but our string is in utf-8, we have + # to convert in order to avoid showing gibberish on the client side... + spitFile($pxeFile, $pxeConfig, { 'io-layer' => 'encoding(cp850)' } ); + } + return; } sub makeInitRamFS { - my $info = shift; - my $pxeVendorOSPath = shift; - - vlog(1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath)); - - my $vendorOS = $info->{'vendor-os'}; - my $kernelFile = basename(followLink($info->{'kernel-file'})); - - my $attrs = dclone($info->{attrs} || {}); - - my $params = { - 'attrs' => $attrs, - 'export-name' => $info->{export}->{name}, - 'export-uri' => $info->{'export-uri'}, - 'initramfs' => "$pxeVendorOSPath/$info->{'initramfs-name'}", - 'kernel-params' => [ split ' ', ($info->{kernel_params} || '') ], - 'kernel-version' => $kernelFile =~ m[-(.+)$] ? $1 : '', - 'plugins' => $info->{'active-plugins'}, - 'root-path' - => "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}", - 'slx-version' => $slxVersion, - 'system-name' => $info->{name}, - }; - - # TODO: make debug-level an explicit attribute, it's used in many places! - my $kernelParams = $info->{kernel_params} || ''; - if ($kernelParams =~ m{debug(?:=(\d+))?}) { - my $debugLevel = defined $1 ? $1 : '1'; - $params->{'debug-level'} = $debugLevel; - } - - my $makeInitRamFSEngine = OpenSLX::MakeInitRamFS::Engine->new($params); - $makeInitRamFSEngine->execute($option{dryRun}); - - # copy back kernel-params, as they might have been changed (by plugins) - $info->{kernel_params} = join ' ', $makeInitRamFSEngine->kernelParams(); - - return; + my $info = shift; + my $pxeVendorOSPath = shift; + + vlog(1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath)); + + my $vendorOS = $info->{'vendor-os'}; + my $kernelFile = basename(followLink($info->{'kernel-file'})); + + my $attrs = dclone($info->{attrs} || {}); + + my $params = { + 'attrs' => $attrs, + 'export-name' => $info->{export}->{name}, + 'export-uri' => $info->{'export-uri'}, + 'initramfs' => "$pxeVendorOSPath/$info->{'initramfs-name'}", + 'kernel-params' => [ split ' ', ($info->{kernel_params} || '') ], + 'kernel-version' => $kernelFile =~ m[-(.+)$] ? $1 : '', + 'plugins' => $info->{'active-plugins'}, + 'root-path' + => "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}", + 'slx-version' => $slxVersion, + 'system-name' => $info->{name}, + }; + + # TODO: make debug-level an explicit attribute, it's used in many places! + my $kernelParams = $info->{kernel_params} || ''; + if ($kernelParams =~ m{debug(?:=(\d+))?}) { + my $debugLevel = defined $1 ? $1 : '1'; + $params->{'debug-level'} = $debugLevel; + } + + my $makeInitRamFSEngine = OpenSLX::MakeInitRamFS::Engine->new($params); + $makeInitRamFSEngine->execute($option{dryRun}); + + # copy back kernel-params, as they might have been changed (by plugins) + $info->{kernel_params} = join ' ', $makeInitRamFSEngine->kernelParams(); + + return; } sub writeSystemPXEFiles { - my $info = shift; + my $info = shift; - vlog(0, _tr('copying kernel and creating initramfs')); + vlog(0, _tr('copying kernel and creating initramfs')); - my $kernelFile = $info->{'kernel-file'}; - my $kernelName = basename($kernelFile); + my $kernelFile = $info->{'kernel-file'}; + my $kernelName = basename($kernelFile); - my $pxePath = "$tftpbuildPath"; - my $pxeVendorOSPath = "$pxePath/$info->{'vendor-os'}->{name}"; - mkpath $pxeVendorOSPath unless -e $pxeVendorOSPath || $option{dryRun}; + my $pxePath = "$tftpbuildPath"; + my $pxeVendorOSPath = "$pxePath/$info->{'vendor-os'}->{name}"; + mkpath $pxeVendorOSPath unless -e $pxeVendorOSPath || $option{dryRun}; - my $targetKernel = "$pxeVendorOSPath/$kernelName"; - if (!-e $targetKernel) { - vlog(1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel)); - slxsystem(qq[cp -p "$kernelFile" "$targetKernel"]) unless $option{dryRun}; - } - makeInitRamFS($info, $pxeVendorOSPath); - $initramfsCount++; - return; + my $targetKernel = "$pxeVendorOSPath/$kernelName"; + if (!-e $targetKernel) { + vlog(1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel)); + slxsystem(qq[cp -p "$kernelFile" "$targetKernel"]) unless $option{dryRun}; + } + makeInitRamFS($info, $pxeVendorOSPath); + $initramfsCount++; + return; } sub writeDhcpConfig { - vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); - my $dhcpModule = "OpenSLX::ConfigExport::DHCP::$option{dhcpType}"; - if (!eval { require $dhcpModule } ) { - die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", - $dhcpModule, $@); - } - my $dhcpBackend = $dhcpModule->new(); - my @clients = $openslxDB->fetchClientByFilter(); - $dhcpBackend->execute(\@clients); - return; + vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); + my $dhcpModule = "OpenSLX::ConfigExport::DHCP::$option{dhcpType}"; + if (!eval { require $dhcpModule } ) { + die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", + $dhcpModule, $@); + } + my $dhcpBackend = $dhcpModule->new(); + my @clients = $openslxDB->fetchClientByFilter(); + $dhcpBackend->execute(\@clients); + return; } sub writeClientConfigurationsForSystem { - my $info = shift; - my $buildPath = shift; - my $attrFile = shift; - - my @clientIDs = $openslxDB->aggregatedClientIDsOfSystem($info); - my @clients = $openslxDB->fetchClientByID(\@clientIDs); - foreach my $client (@clients) { - next if $client->{name} eq '<<>>'; - # skip default client, as it doesn't need any config-tgz - - my $externalSystemID = externalIDForSystem($info); - my $externalClientName = externalConfigNameForClient($client); - my $clientConfigPath = - "$clientConfigPath/$externalSystemID/$externalClientName"; - - # merge configurations of client, it's groups, default client and - # system and write the resulting attributes to a configuration file: - $openslxDB->mergeDefaultAndGroupAttributesIntoClient($client); - mergeAttributes($client, $info); - - my $clientAttrDigest = digestAttributes($client); - vlog( - 2, - _tr( - "attribute-digest for client '%s' is '%s'", $client->{name}, - $clientAttrDigest - ) - ); - # export client-specific config only if attributes are different - # from system and/or a client-specific config-folder exists: - if ($clientAttrDigest ne $info->{'attr-digest'} - || -d $clientConfigPath) - { - vlog( - 1, - _tr( - "creating config-tgz for client %d:%s", $client->{id}, - $client->{name} - ) - ); - $clientSystemConfCount++; - - # merge default, system and client configuration files into - # the system configuration for the current client: - copyExternalSystemConfig( - $externalSystemID, $buildPath, $externalClientName - ); - - writeAttributesToFile($client, $attrFile); - - # create tar containing external system configuration - # and client attribute file, this time referring to the client - # via its external ID (the PXE-style MAC), as the TGZ needs to - # be accessed from the client-PC, which doesn't know about the - # name it is referred to in the openslx-config-DB: - my $externalClientID = externalIDForClient($client); - createTarOfPath( - $buildPath, "${externalClientID}.tgz", - "$tftpbuildPath/client-config/$info->{'external-id'}" - ); - } - } - return; + my $info = shift; + my $buildPath = shift; + my $attrFile = shift; + + my @clientIDs = $openslxDB->aggregatedClientIDsOfSystem($info); + my @clients = $openslxDB->fetchClientByID(\@clientIDs); + foreach my $client (@clients) { + next if $client->{name} eq '<<>>'; + # skip default client, as it doesn't need any config-tgz + + my $externalSystemID = externalIDForSystem($info); + my $externalClientName = externalConfigNameForClient($client); + my $clientConfigPath = + "$clientConfigPath/$externalSystemID/$externalClientName"; + + # merge configurations of client, it's groups, default client and + # system and write the resulting attributes to a configuration file: + $openslxDB->mergeDefaultAndGroupAttributesIntoClient($client); + mergeAttributes($client, $info); + + my $clientAttrDigest = digestAttributes($client); + vlog( + 2, + _tr( + "attribute-digest for client '%s' is '%s'", $client->{name}, + $clientAttrDigest + ) + ); + # export client-specific config only if attributes are different + # from system and/or a client-specific config-folder exists: + if ($clientAttrDigest ne $info->{'attr-digest'} + || -d $clientConfigPath) + { + vlog( + 1, + _tr( + "creating config-tgz for client %d:%s", $client->{id}, + $client->{name} + ) + ); + $clientSystemConfCount++; + + # merge default, system and client configuration files into + # the system configuration for the current client: + copyExternalSystemConfig( + $externalSystemID, $buildPath, $externalClientName + ); + + writeAttributesToFile($client, $attrFile); + + # create tar containing external system configuration + # and client attribute file, this time referring to the client + # via its external ID (the PXE-style MAC), as the TGZ needs to + # be accessed from the client-PC, which doesn't know about the + # name it is referred to in the openslx-config-DB: + my $externalClientID = externalIDForClient($client); + createTarOfPath( + $buildPath, "${externalClientID}.tgz", + "$tftpbuildPath/client-config/$info->{'external-id'}" + ); + } + } + return; } sub writePluginConfigurationsForSystem { - my $info = shift || confess 'need to pass in info-hash!'; - my $buildPath = shift || confess 'need to pass in build-path!'; - - my $pluginConfPath = "$buildPath/initramfs/plugin-conf"; - - my $attrs = $info->{attrs} || {}; - - my @activePlugins; - foreach my $pluginInfo (@{$info->{'installed-plugins'}}) { - my $pluginName = $pluginInfo->{plugin_name}; - vlog(2, _tr("checking configuration of plugin '%s'", $pluginName)); - - # skip inactive plugins - next unless $attrs->{"${pluginName}::active"}; - - push @activePlugins, $pluginName; - - next if $option{dryRun}; - - mkpath([ $pluginConfPath ]); - - vlog(2, _tr("writing configuration file for plugin '%s'", $pluginName)); - # write plugin configuration to a file: - my $content; - my @pluginAttrs = grep { $_ =~ m{^${pluginName}::} } keys %$attrs; - foreach my $attr (sort @pluginAttrs) { - my $attrVal = $attrs->{$attr}; - if (!defined $attrVal) { - $attrVal = ''; - } - my $attrName = substr($attr, index($attr, '::')+2); - $content .= qq[${pluginName}_$attrName="$attrVal"\n]; - } - my $fileName = "$pluginConfPath/${pluginName}.conf"; - spitFile($fileName, $content); - if ($openslxConfig{'verbose-level'} > 2) { - vlog(0, "--- START OF $fileName ---"); - vlog(0, $content); - vlog(0, "--- END OF $fileName --- "); - } - } - $info->{'active-plugins'} = \@activePlugins; - my $activePluginStr = @activePlugins ? join ',', @activePlugins : ''; - vlog(0, _tr("active plugins: %s", $activePluginStr)); - return; + my $info = shift || confess 'need to pass in info-hash!'; + my $buildPath = shift || confess 'need to pass in build-path!'; + + my $pluginConfPath = "$buildPath/initramfs/plugin-conf"; + + my $attrs = $info->{attrs} || {}; + + my @activePlugins; + foreach my $pluginInfo (@{$info->{'installed-plugins'}}) { + my $pluginName = $pluginInfo->{plugin_name}; + vlog(2, _tr("checking configuration of plugin '%s'", $pluginName)); + + # skip inactive plugins + next unless $attrs->{"${pluginName}::active"}; + + push @activePlugins, $pluginName; + + next if $option{dryRun}; + + mkpath([ $pluginConfPath ]); + + vlog(2, _tr("writing configuration file for plugin '%s'", $pluginName)); + # write plugin configuration to a file: + my $content; + my @pluginAttrs = grep { $_ =~ m{^${pluginName}::} } keys %$attrs; + foreach my $attr (sort @pluginAttrs) { + my $attrVal = $attrs->{$attr}; + if (!defined $attrVal) { + $attrVal = ''; + } + my $attrName = substr($attr, index($attr, '::')+2); + $content .= qq[${pluginName}_$attrName="$attrVal"\n]; + } + my $fileName = "$pluginConfPath/${pluginName}.conf"; + spitFile($fileName, $content); + if ($openslxConfig{'verbose-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + } + $info->{'active-plugins'} = \@activePlugins; + my $activePluginStr = @activePlugins ? join ',', @activePlugins : ''; + vlog(0, _tr("active plugins: %s", $activePluginStr)); + return; } sub writeSystemConfiguration { - my $info = shift; - my $isTargetSystem = shift; - - # if this is not a target system, we shall not write any configurations, - # but we simply incorporate inherited attributes - if (!$isTargetSystem) { - $openslxDB->mergeDefaultAttributesIntoSystem($info); - $info->{'initramfs-name'} = "initramfs-$info->{id}"; - return; - } - - # write configuration files for this system - my $buildPath = "$tempPath/build"; - copyExternalSystemConfig(externalIDForSystem($info), $buildPath); - - $openslxDB->mergeDefaultAttributesIntoSystem( - $info, $info->{'installed-plugins'} - ); - $info->{'attr-digest'} = digestAttributes($info); - vlog( - 2, - _tr( - "attribute-digest for system '%s' is '%s'", $info->{name}, - $info->{'attr-digest'} - ) - ); - my $attrFile = "$buildPath/initramfs/machine-setup"; - writeAttributesToFile($info, $attrFile); - - writePluginConfigurationsForSystem($info, $buildPath); - - my $systemPath = "$tftpbuildPath/client-config/$info->{'external-id'}"; - createTarOfPath($buildPath, "default.tgz", $systemPath); - - $info->{'initramfs-name'} = "initramfs-$info->{id}"; - writeSystemPXEFiles($info); - - writeClientConfigurationsForSystem($info, $buildPath, $attrFile); - - slxsystem("rm -rf $buildPath") unless $option{dryRun}; - - $systemConfCount++; - - return; + my $info = shift; + my $isTargetSystem = shift; + + # if this is not a target system, we shall not write any configurations, + # but we simply incorporate inherited attributes + if (!$isTargetSystem) { + $openslxDB->mergeDefaultAttributesIntoSystem($info); + $info->{'initramfs-name'} = "initramfs-$info->{id}"; + return; + } + + # write configuration files for this system + my $buildPath = "$tempPath/build"; + copyExternalSystemConfig(externalIDForSystem($info), $buildPath); + + $openslxDB->mergeDefaultAttributesIntoSystem( + $info, $info->{'installed-plugins'} + ); + $info->{'attr-digest'} = digestAttributes($info); + vlog( + 2, + _tr( + "attribute-digest for system '%s' is '%s'", $info->{name}, + $info->{'attr-digest'} + ) + ); + my $attrFile = "$buildPath/initramfs/machine-setup"; + writeAttributesToFile($info, $attrFile); + + writePluginConfigurationsForSystem($info, $buildPath); + + my $systemPath = "$tftpbuildPath/client-config/$info->{'external-id'}"; + createTarOfPath($buildPath, "default.tgz", $systemPath); + + $info->{'initramfs-name'} = "initramfs-$info->{id}"; + writeSystemPXEFiles($info); + + writeClientConfigurationsForSystem($info, $buildPath, $attrFile); + + slxsystem("rm -rf $buildPath") unless $option{dryRun}; + + $systemConfCount++; + + return; } sub writeConfigurations { - $initramfsCount = $systemConfCount = $systemErrCount - = $clientSystemConfCount = 0; - my @infos; - foreach my $system (@demuxableSystems) { - my $isTargetSystem - = first { $_->{name} eq $system->{name} } @targetSystems; - if ($isTargetSystem) { - vlog( - 0, - _tr("\ndemuxing system %d : %s", $system->{id}, $system->{name}) - ); - } - else { - vlog( - 0, - _tr( - "\nlinking demuxed system %d : %s into PXE menu", - $system->{id}, $system->{name} - ) - ); - } - - my $success = eval { - my $info = $openslxDB->aggregatedSystemFileInfoFor($system); - $info->{'external-id'} = externalIDForSystem($system); - - writeSystemConfiguration($info, $isTargetSystem); - - push @infos, $info; - 1; - }; - if (!$success) { - print STDERR $@; - $systemErrCount++; - } - } - writePXEMenus(@infos); - if (defined $option{dhcpType}) { - writeDhcpConfig(); - } - return; + $initramfsCount = $systemConfCount = $systemErrCount + = $clientSystemConfCount = 0; + my @infos; + foreach my $system (@demuxableSystems) { + my $isTargetSystem + = first { $_->{name} eq $system->{name} } @targetSystems; + if ($isTargetSystem) { + vlog( + 0, + _tr("\ndemuxing system %d : %s", $system->{id}, $system->{name}) + ); + } + else { + vlog( + 0, + _tr( + "\nlinking demuxed system %d : %s into PXE menu", + $system->{id}, $system->{name} + ) + ); + } + + my $success = eval { + my $info = $openslxDB->aggregatedSystemFileInfoFor($system); + $info->{'external-id'} = externalIDForSystem($system); + + writeSystemConfiguration($info, $isTargetSystem); + + push @infos, $info; + 1; + }; + if (!$success) { + print STDERR $@; + $systemErrCount++; + } + } + writePXEMenus(@infos); + if (defined $option{dhcpType}) { + writeDhcpConfig(); + } + return; } =head1 NAME diff --git a/config-db/t/01-basics.t b/config-db/t/01-basics.t index 903783c4..1fb7083b 100644 --- a/config-db/t/01-basics.t +++ b/config-db/t/01-basics.t @@ -13,9 +13,9 @@ ok(my $configDB = OpenSLX::ConfigDB->new, 'can create object'); isa_ok($configDB, 'OpenSLX::ConfigDB'); { - # create a second object - should work and yield different objects - ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); - cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); + # create a second object - should work and yield different objects + ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); + cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); } ok($configDB->connect(), 'connecting'); diff --git a/config-db/t/10-vendor-os.t b/config-db/t/10-vendor-os.t index ac16becf..a71ee4ac 100644 --- a/config-db/t/10-vendor-os.t +++ b/config-db/t/10-vendor-os.t @@ -12,46 +12,46 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $vendorOS = $configDB->fetchVendorOSByFilter, undef, - 'no vendor-OS yet (scalar context)' + my $vendorOS = $configDB->fetchVendorOSByFilter, undef, + 'no vendor-OS yet (scalar context)' ); my $wrongVendorOS = { - 'comment' => 'test', + 'comment' => 'test', }; ok( - ! eval { my $vendorOSID = $configDB->addVendorOS($wrongVendorOS); }, - 'trying to insert an unnamed vendor-OS should fail' + ! eval { my $vendorOSID = $configDB->addVendorOS($wrongVendorOS); }, + 'trying to insert an unnamed vendor-OS should fail' ); is( - my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, - 'no vendor-OS yet (array context)' + my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, + 'no vendor-OS yet (array context)' ); my $inVendorOS1 = { - 'name' => 'vos-1', - 'comment' => '', + 'name' => 'vos-1', + 'comment' => '', }; is( - my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, - 'first vendor-OS has ID 1' + my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, + 'first vendor-OS has ID 1' ); my $inVendorOS2 = { - 'name' => 'vos-2.0', - 'comment' => 'batch 2', + 'name' => 'vos-2.0', + 'comment' => 'batch 2', }; my $inVendorOS3 = { - 'name' => 'vos-3.0', - 'comment' => 'batch 2', - 'clone_source' => 'kiwi::test-vos', + 'name' => 'vos-3.0', + 'comment' => 'batch 2', + 'clone_source' => 'kiwi::test-vos', }; ok( - my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ - $inVendorOS2, $inVendorOS3 - ]), - 'add two more vendor-OSes' + my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ + $inVendorOS2, $inVendorOS3 + ]), + 'add two more vendor-OSes' ); is($vendorOS2ID, 2, 'vendor-OS 2 should have ID=2'); is($vendorOS3ID, 3, 'vendor-OS 3 should have ID=3'); @@ -65,8 +65,8 @@ is($vendorOS3->{clone_source}, 'kiwi::test-vos', 'vendor-OS 3 - clone_source'); # fetch vendor-OS 2 by a filter on id and check all values ok( - my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), - 'fetch vendor-OS 2 by filter on id' + my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), + 'fetch vendor-OS 2 by filter on id' ); is($vendorOS2->{id}, 2, 'vendor-OS 2 - id'); is($vendorOS2->{name}, 'vos-2.0', 'vendor-OS 2 - name'); @@ -75,8 +75,8 @@ is($vendorOS2->{clone_source}, undef, 'vendor-OS 2 - clone_source'); # fetch vendor-OS 1 by filter on name and check all values ok( - my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), - 'fetch vendor-OS 1 by filter on name' + my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), + 'fetch vendor-OS 1 by filter on name' ); is($vendorOS1->{id}, 1, 'vendor-OS 1 - id'); is($vendorOS1->{name}, 'vos-1', 'vendor-OS 1 - name'); @@ -85,9 +85,9 @@ is($vendorOS1->{clone_source}, undef, 'vendor-OS 1 - clone_source'); # fetch vendor-OSes 3 & 1 by id ok( - my @vendorOSes3And1 - = $configDB->fetchVendorOSByID([3, 1]), - 'fetch vendor-OSes 3 & 1 by id' + my @vendorOSes3And1 + = $configDB->fetchVendorOSByID([3, 1]), + 'fetch vendor-OSes 3 & 1 by id' ); is(@vendorOSes3And1, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 3 and 1 @@ -97,22 +97,22 @@ is($vendorOSes3And1[1]->{id}, 3, 'second id should be 3'); # fetching vendor-OSes by id without giving any should yield undef is( - $configDB->fetchVendorOSByID(), undef, - 'fetch vendor-OSes by id without giving any' + $configDB->fetchVendorOSByID(), undef, + 'fetch vendor-OSes by id without giving any' ); # fetching vendor-OSes by filter without giving any should yield all of them ok( - @vendorOSes = $configDB->fetchVendorOSByFilter(), - 'fetch vendor-OSes by filter without giving any' + @vendorOSes = $configDB->fetchVendorOSByFilter(), + 'fetch vendor-OSes by filter without giving any' ); is(@vendorOSes, 3, 'should have got all three vendor-OSes'); # fetch vendor-OSes 2 & 3 by filter on comment ok( - my @vendorOSes2And3 - = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), - 'fetch vendor-OSes 2 & 3 by filter on comment' + my @vendorOSes2And3 + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), + 'fetch vendor-OSes 2 & 3 by filter on comment' ); is(@vendorOSes2And3, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 2 and 3 @@ -122,9 +122,9 @@ is($vendorOSes2And3[1]->{id}, 3, 'second id should be 3'); # try to fetch with multi-column filter ok( - ($vendorOS2, $vendorOS3) - = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), - 'fetching vendor-OS with comment="batch 2" and id=2 should work' + ($vendorOS2, $vendorOS3) + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), + 'fetching vendor-OS with comment="batch 2" and id=2 should work' ); is($vendorOS2->{name}, 'vos-2.0', 'should have got vos-2.0'); is($vendorOS3, undef, 'should not get vos-3.0'); @@ -132,9 +132,9 @@ is($vendorOS3, undef, 'should not get vos-3.0'); # try to fetch multiple occurrences of the same vendor-OS, combined with # some unknown IDs ok( - my @vendorOSes1And3 - = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), - 'fetch a complex set of vendor-OSes by ID' + my @vendorOSes1And3 + = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of vendor-OSes by ID' ); is(@vendorOSes1And3, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 1 and 3 @@ -144,37 +144,37 @@ is($vendorOSes1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch a couple of non-existing vendor-OSes by id is( - $configDB->fetchVendorOSByID(-1), undef, - 'vendor-OS with id -1 should not exist' + $configDB->fetchVendorOSByID(-1), undef, + 'vendor-OS with id -1 should not exist' ); is( - $configDB->fetchVendorOSByID(0), undef, - 'vendor-OS with id 0 should not exist' + $configDB->fetchVendorOSByID(0), undef, + 'vendor-OS with id 0 should not exist' ); is( - $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown vendor-OS' + $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown vendor-OS' ); # try to fetch a couple of non-existing vendor-OSes by filter is( - $configDB->fetchVendorOSByFilter({ id => 0 }), undef, - 'fetching vendor-OS with id=0 by filter should fail' + $configDB->fetchVendorOSByFilter({ id => 0 }), undef, + 'fetching vendor-OS with id=0 by filter should fail' ); is( - $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, - 'fetching vendor-OS with name="vos-1.x" should fail' + $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, + 'fetching vendor-OS with name="vos-1.x" should fail' ); is( - $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, - 'fetching vendor-OS with comment="batch 2" and id=1 should fail' + $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, + 'fetching vendor-OS with comment="batch 2" and id=1 should fail' ); # rename vendor-OS 1 and then fetch it by its new name ok($configDB->changeVendorOS(1, { name => q{VOS-'1'} }), 'changing vendor-OS 1'); ok( - $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), - 'fetching renamed vendor-OS 1' + $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), + 'fetching renamed vendor-OS 1' ); is($vendorOS1->{id}, 1, 'really got vendor-OS number 1'); is($vendorOS1->{name}, q{VOS-'1'}, q{really got vendor-OS named "VOS-'1'"}); @@ -184,68 +184,68 @@ ok($configDB->changeVendorOS(1), 'changing nothing at all in vendor-OS 1'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeVendorOS(1, { id => 23 }), 'changing id should fail'); # test adding & removing of installed plugins is( - my @plugins = $configDB->fetchInstalledPlugins(3), - 0, 'there should be no installed plugins' + my @plugins = $configDB->fetchInstalledPlugins(3), + 0, 'there should be no installed plugins' ); ok($configDB->addInstalledPlugin(3, 'Example'), 'adding installed plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' ); is( - $configDB->addInstalledPlugin(3, 'Example'), 1, - 'adding plugin again should work (but do not harm, just update the attrs)' + $configDB->addInstalledPlugin(3, 'Example'), 1, + 'adding plugin again should work (but do not harm, just update the attrs)' ); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should still have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should still have 1 installed plugin' ); is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); ok($configDB->addInstalledPlugin(3, 'Test'), 'adding a second plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 2, - 'should have 2 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 2, + 'should have 2 installed plugin' ); ok( - !$configDB->removeInstalledPlugin(3, 'xxx'), - 'removing unknown plugin should fail' + !$configDB->removeInstalledPlugin(3, 'xxx'), + 'removing unknown plugin should fail' ); ok( - @plugins = $configDB->fetchInstalledPlugins(3, 'Example'), - 'fetching specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'Example'), + 'fetching specific plugin' ); is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); ok( - @plugins = $configDB->fetchInstalledPlugins(3, 'Test'), - 'fetching another specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'Test'), + 'fetching another specific plugin' ); is($plugins[0]->{plugin_name}, 'Test', 'should have got plugin "Test"'); is( - @plugins = $configDB->fetchInstalledPlugins(3, 'xxx'), 0, - 'fetching unknown specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'xxx'), 0, + 'fetching unknown specific plugin' ); ok($configDB->removeInstalledPlugin(3, 'Example'), 'removing installed plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' ); ok($configDB->removeInstalledPlugin(3, 'Test'), 'removing second plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 0, - 'should have no installed plugins' + @plugins = $configDB->fetchInstalledPlugins(3), + 0, + 'should have no installed plugins' ); # now remove a vendor-OS and check if that worked diff --git a/config-db/t/11-export.t b/config-db/t/11-export.t index 0cdc688c..3dd0ae6c 100644 --- a/config-db/t/11-export.t +++ b/config-db/t/11-export.t @@ -12,70 +12,70 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $export = $configDB->fetchExportByFilter, undef, - 'no export yet (scalar context)' + my $export = $configDB->fetchExportByFilter, undef, + 'no export yet (scalar context)' ); foreach my $requiredCol (qw(name vendor_os_id type)) { - my $wrongExport = { - 'name' => 'name', - 'vendor_os_id' => 1, - 'type ' => 'nfs', - 'comment' => 'has column missing', - }; - delete $wrongExport->{$requiredCol}; - ok( - ! eval { my $exportID = $configDB->addExport($wrongExport); }, - "inserting an export without '$requiredCol' column should fail" - ); + my $wrongExport = { + 'name' => 'name', + 'vendor_os_id' => 1, + 'type ' => 'nfs', + 'comment' => 'has column missing', + }; + delete $wrongExport->{$requiredCol}; + ok( + ! eval { my $exportID = $configDB->addExport($wrongExport); }, + "inserting an export without '$requiredCol' column should fail" + ); } is( - my @exports = $configDB->fetchExportByFilter, 0, - 'no export yet (array context)' + my @exports = $configDB->fetchExportByFilter, 0, + 'no export yet (array context)' ); is( - my @exportIDs = $configDB->fetchExportIDsOfVendorOS(1), 0, - 'vendor-OS 1 has no export IDs yet' + my @exportIDs = $configDB->fetchExportIDsOfVendorOS(1), 0, + 'vendor-OS 1 has no export IDs yet' ); is( - @exportIDs = $configDB->fetchExportIDsOfVendorOS(2), 0, - 'vendor-OS 2 has no export IDs yet' + @exportIDs = $configDB->fetchExportIDsOfVendorOS(2), 0, + 'vendor-OS 2 has no export IDs yet' ); my $inExport1 = { - 'name' => 'exp-1', - 'type' => 'nfs', - 'vendor_os_id' => 1, - 'comment' => '', + 'name' => 'exp-1', + 'type' => 'nfs', + 'vendor_os_id' => 1, + 'comment' => '', }; is( - my $export1ID = $configDB->addExport($inExport1), 1, - 'first export has ID 1' + my $export1ID = $configDB->addExport($inExport1), 1, + 'first export has ID 1' ); my $inExport2 = { - 'name' => 'exp-2.0', - 'type' => 'sqfs-nbd', - 'vendor_os_id' => 1, - 'comment' => undef, + 'name' => 'exp-2.0', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 1, + 'comment' => undef, }; my $fullExport = { - 'name' => 'exp-nr-3', - 'type' => 'sqfs-nbd', - 'vendor_os_id' => 2, - 'comment' => 'nuff said', - 'server_ip' => '192.168.212.243', - 'port' => '65432', - 'uri' => 'sqfs-nbd://somehost/somepath?param=val&yes=1', + 'name' => 'exp-nr-3', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 2, + 'comment' => 'nuff said', + 'server_ip' => '192.168.212.243', + 'port' => '65432', + 'uri' => 'sqfs-nbd://somehost/somepath?param=val&yes=1', }; ok( - my ($export2ID, $export3ID) = $configDB->addExport([ - $inExport2, $fullExport - ]), - 'add two more exports' + my ($export2ID, $export3ID) = $configDB->addExport([ + $inExport2, $fullExport + ]), + 'add two more exports' ); is($export2ID, 2, 'export 2 should have ID=2'); is($export3ID, 3, 'export 3 should have ID=3'); @@ -90,15 +90,15 @@ is($export3->{comment}, 'nuff said', 'export 3 - comment'); is($export3->{server_ip}, '192.168.212.243', 'export 3 - server_ip'); is($export3->{port}, '65432', 'export 3 - port'); is( - $export3->{uri}, - 'sqfs-nbd://somehost/somepath?param=val&yes=1', - 'export 3 - uri' + $export3->{uri}, + 'sqfs-nbd://somehost/somepath?param=val&yes=1', + 'export 3 - uri' ); # fetch export 2 by a filter on id and check all values ok( - my $export2 = $configDB->fetchExportByFilter({ id => 2 }), - 'fetch export 2 by filter on id' + my $export2 = $configDB->fetchExportByFilter({ id => 2 }), + 'fetch export 2 by filter on id' ); is($export2->{id}, 2, 'export 2 - id'); is($export2->{name}, 'exp-2.0', 'export 2 - name'); @@ -108,8 +108,8 @@ is($export2->{comment}, undef, 'export 2 - comment'); # fetch export 1 by filter on name and check all values ok( - my $export1 = $configDB->fetchExportByFilter({ name => 'exp-1' }), - 'fetch export 1 by filter on name' + my $export1 = $configDB->fetchExportByFilter({ name => 'exp-1' }), + 'fetch export 1 by filter on name' ); is($export1->{id}, 1, 'export 1 - id'); is($export1->{name}, 'exp-1', 'export 1 - name'); @@ -121,22 +121,22 @@ is($export1->{server_ip}, undef, 'export 1 - server_ip'); is($export1->{uri}, undef, 'export 1 - uri'); is( - @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(1)), - 2, 'vendor-OS 1 has two export IDs' + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(1)), + 2, 'vendor-OS 1 has two export IDs' ); is($exportIDs[0], 1, 'first export ID of vendor-OS 1 (1)'); is($exportIDs[1], 2, 'second export ID of vendor-OS 1 (2)'); is( - @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(2)), - 1, 'vendor-OS 2 has one export IDs' + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(2)), + 1, 'vendor-OS 2 has one export IDs' ); is($exportIDs[0], 3, 'first export ID of vendor-OS 2 (3)'); # fetch exports 3 & 1 by id ok( - my @exports3And1 = $configDB->fetchExportByID([3, 1]), - 'fetch exports 3 & 1 by id' + my @exports3And1 = $configDB->fetchExportByID([3, 1]), + 'fetch exports 3 & 1 by id' ); is(@exports3And1, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 3 and 1 @@ -146,21 +146,21 @@ is($exports3And1[1]->{id}, 3, 'second id should be 3'); # fetching exports by id without giving any should yield undef is( - $configDB->fetchExportByID(), undef, - 'fetch exports by id without giving any' + $configDB->fetchExportByID(), undef, + 'fetch exports by id without giving any' ); # fetching exports by filter without giving any should yield all of them ok( - @exports = $configDB->fetchExportByFilter(), - 'fetch exports by filter without giving any' + @exports = $configDB->fetchExportByFilter(), + 'fetch exports by filter without giving any' ); is(@exports, 3, 'should have got all three exports'); # fetch exports 1 & 2 by filter on vendor_os_id ok( - my @exports1And2 = $configDB->fetchExportByFilter({ vendor_os_id => '1' }), - 'fetch exports 1 & 2 by filter on vendor_os_id' + my @exports1And2 = $configDB->fetchExportByFilter({ vendor_os_id => '1' }), + 'fetch exports 1 & 2 by filter on vendor_os_id' ); is(@exports1And2, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 1 and 2 @@ -170,9 +170,9 @@ is($exports1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch with multi-column filter ok( - ($export2, $export3) - = $configDB->fetchExportByFilter({ vendor_os_id => '1', id => 2 }), - 'fetching export with vendor_os_id=1 and id=2 should work' + ($export2, $export3) + = $configDB->fetchExportByFilter({ vendor_os_id => '1', id => 2 }), + 'fetching export with vendor_os_id=1 and id=2 should work' ); is($export2->{name}, 'exp-2.0', 'should have got exp-2.0'); is($export3, undef, 'should not get exp-nr-3'); @@ -180,8 +180,8 @@ is($export3, undef, 'should not get exp-nr-3'); # try to fetch multiple occurrences of the same export, combined with # some unknown IDs ok( - my @exports1And3 = $configDB->fetchExportByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), - 'fetch a complex set of exports by ID' + my @exports1And3 = $configDB->fetchExportByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of exports by ID' ); is(@exports1And3, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 1 and 3 @@ -191,37 +191,37 @@ is($exports1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch a couple of non-existing exports by id is( - $configDB->fetchExportByID(-1), undef, - 'export with id -1 should not exist' + $configDB->fetchExportByID(-1), undef, + 'export with id -1 should not exist' ); is( - $configDB->fetchExportByID(0), undef, - 'export with id 0 should not exist' + $configDB->fetchExportByID(0), undef, + 'export with id 0 should not exist' ); is( - $configDB->fetchExportByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown export' + $configDB->fetchExportByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown export' ); # try to fetch a couple of non-existing exports by filter is( - $configDB->fetchExportByFilter({ id => 0 }), undef, - 'fetching export with id=0 by filter should fail' + $configDB->fetchExportByFilter({ id => 0 }), undef, + 'fetching export with id=0 by filter should fail' ); is( - $configDB->fetchExportByFilter({ name => 'exp-1.x' }), undef, - 'fetching export with name="exp-1.x" should fail' + $configDB->fetchExportByFilter({ name => 'exp-1.x' }), undef, + 'fetching export with name="exp-1.x" should fail' ); is( - $configDB->fetchExportByFilter({ vendor_os_id => '2', id => 1 }), undef, - 'fetching export with vendor_os_id=2 and id=1 should fail' + $configDB->fetchExportByFilter({ vendor_os_id => '2', id => 1 }), undef, + 'fetching export with vendor_os_id=2 and id=1 should fail' ); # rename export 1 and then fetch it by its new name ok($configDB->changeExport(1, { name => q{EXP-'1'} }), 'changing export 1'); ok( - $export1 = $configDB->fetchExportByFilter({ name => q{EXP-'1'} }), - 'fetching renamed export 1' + $export1 = $configDB->fetchExportByFilter({ name => q{EXP-'1'} }), + 'fetching renamed export 1' ); is($export1->{id}, 1, 'really got export number 1'); is($export1->{name}, q{EXP-'1'}, q{really got export named "EXP-'1'"}); @@ -231,8 +231,8 @@ ok($configDB->changeExport(1), 'changing nothing at all in export 1'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeExport(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeExport(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeExport(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/12-system.t b/config-db/t/12-system.t index 17a0c0dd..7ed740a9 100644 --- a/config-db/t/12-system.t +++ b/config-db/t/12-system.t @@ -12,99 +12,99 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); ok( - my $system = $configDB->fetchSystemByFilter, - 'one system [default] should exist (scalar context)' + my $system = $configDB->fetchSystemByFilter, + 'one system [default] should exist (scalar context)' ); foreach my $requiredCol (qw(name export_id)) { - my $wrongSystem = { - 'name' => 'name', - 'export_id' => 1, - 'comment' => 'has column missing', - }; - delete $wrongSystem->{$requiredCol}; - ok( - ! eval { my $systemID = $configDB->addSystem($wrongSystem); }, - "inserting a system without '$requiredCol' column should fail" - ); + my $wrongSystem = { + 'name' => 'name', + 'export_id' => 1, + 'comment' => 'has column missing', + }; + delete $wrongSystem->{$requiredCol}; + ok( + ! eval { my $systemID = $configDB->addSystem($wrongSystem); }, + "inserting a system without '$requiredCol' column should fail" + ); } is( - my @systems = $configDB->fetchSystemByFilter, 1, - 'still just one system [default] should exist (array context)' + my @systems = $configDB->fetchSystemByFilter, 1, + 'still just one system [default] should exist (array context)' ); my $inSystem1 = { - 'name' => 'sys-1', - 'export_id' => 1, - 'comment' => '', - 'attrs' => { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_nicmods' => 'e1000 forcedeth r8169', - 'start_sshd' => 'yes', - }, + 'name' => 'sys-1', + 'export_id' => 1, + 'comment' => '', + 'attrs' => { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'e1000 forcedeth r8169', + 'start_sshd' => 'yes', + }, }; is( - my $system1ID = $configDB->addSystem($inSystem1), 1, - 'first system has ID 1' + my $system1ID = $configDB->addSystem($inSystem1), 1, + 'first system has ID 1' ); my $inSystem2 = { - 'name' => 'sys-2.0', - 'kernel' => 'vmlinuz', - 'export_id' => 1, - 'comment' => undef, + 'name' => 'sys-2.0', + 'kernel' => 'vmlinuz', + 'export_id' => 1, + 'comment' => undef, }; my $fullSystem = { - 'name' => 'sys-nr-3', - 'kernel' => 'vmlinuz-2.6.22.13-0.3-default', - 'export_id' => 3, - 'comment' => 'nuff said', - 'label' => 'BlingBling System - really kuul!', - 'kernel_params' => 'debug=3 console=ttyS1', - 'hidden' => '1', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'ramfs_fsmods' => 'l', - 'ramfs_miscmods' => 'm', - 'ramfs_nicmods' => 'n', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'sys-nr-3', + 'kernel' => 'vmlinuz-2.6.22.13-0.3-default', + 'export_id' => 3, + 'comment' => 'nuff said', + 'label' => 'BlingBling System - really kuul!', + 'kernel_params' => 'debug=3 console=ttyS1', + 'hidden' => '1', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'ramfs_fsmods' => 'l', + 'ramfs_miscmods' => 'm', + 'ramfs_nicmods' => 'n', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($system2ID, $system3ID) = $configDB->addSystem([ - $inSystem2, $fullSystem - ]), - 'add two more systems' + my ($system2ID, $system3ID) = $configDB->addSystem([ + $inSystem2, $fullSystem + ]), + 'add two more systems' ); is($system2ID, 2, 'system 2 should have ID=2'); is($system3ID, 3, 'system 3 should have ID=3'); @@ -157,8 +157,8 @@ is(keys %{$system3->{attrs}}, 34, 'system 3 - attribu # fetch system 2 by a filter on id and check all values ok( - my $system2 = $configDB->fetchSystemByFilter({ id => 2 }), - 'fetch system 2 by filter on id' + my $system2 = $configDB->fetchSystemByFilter({ id => 2 }), + 'fetch system 2 by filter on id' ); is($system2->{id}, 2, 'system 2 - id'); is($system2->{name}, 'sys-2.0', 'system 2 - name'); @@ -169,8 +169,8 @@ is(keys %{$system2->{attrs}}, 0, 'system 2 - attribute count'); # fetch system 1 by filter on name and check all values ok( - my $system1 = $configDB->fetchSystemByFilter({ name => 'sys-1' }), - 'fetch system 1 by filter on name' + my $system1 = $configDB->fetchSystemByFilter({ name => 'sys-1' }), + 'fetch system 1 by filter on name' ); is($system1->{id}, 1, 'system 1 - id'); is($system1->{name}, 'sys-1', 'system 1 - name'); @@ -187,8 +187,8 @@ is($system1->{attrs}->{start_sshd}, 'yes', 'system 1 - att # fetch systems 3 & 1 by id ok( - my @systems3And1 = $configDB->fetchSystemByID([3, 1]), - 'fetch systems 3 & 1 by id' + my @systems3And1 = $configDB->fetchSystemByID([3, 1]), + 'fetch systems 3 & 1 by id' ); is(@systems3And1, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 3 and 1 @@ -198,21 +198,21 @@ is($systems3And1[1]->{id}, 3, 'second id should be 3'); # fetching systems by id without giving any should yield undef is( - $configDB->fetchSystemByID(), undef, - 'fetch systems by id without giving any' + $configDB->fetchSystemByID(), undef, + 'fetch systems by id without giving any' ); # fetching systems by filter without giving any should yield all of them ok( - @systems = $configDB->fetchSystemByFilter(), - 'fetch systems by filter without giving any' + @systems = $configDB->fetchSystemByFilter(), + 'fetch systems by filter without giving any' ); is(@systems, 4, 'should have got all four systems'); # fetch systems 1 & 2 by filter on export_id ok( - my @systems1And2 = $configDB->fetchSystemByFilter({ export_id => '1' }), - 'fetch systems 1 & 2 by filter on export_id' + my @systems1And2 = $configDB->fetchSystemByFilter({ export_id => '1' }), + 'fetch systems 1 & 2 by filter on export_id' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -222,8 +222,8 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # fetch systems 1 & 2 by filter on hidden being undef'd ok( - @systems1And2 = $configDB->fetchSystemByFilter({ hidden => undef }), - 'fetch systems 1 & 2 by filter on hidden being undefined' + @systems1And2 = $configDB->fetchSystemByFilter({ hidden => undef }), + 'fetch systems 1 & 2 by filter on hidden being undefined' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -233,9 +233,9 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch with multi-column filter ok( - ($system2, $system3) - = $configDB->fetchSystemByFilter({ export_id => '1', id => 2 }), - 'fetching system with export_id=1 and id=2 should work' + ($system2, $system3) + = $configDB->fetchSystemByFilter({ export_id => '1', id => 2 }), + 'fetching system with export_id=1 and id=2 should work' ); is($system2->{name}, 'sys-2.0', 'should have got sys-2.0'); is($system3, undef, 'should not get sys-nr-3'); @@ -243,8 +243,8 @@ is($system3, undef, 'should not get sys-nr-3'); # try to fetch multiple occurrences of the same system, combined with # some unknown IDs ok( - my @systems1And3 = $configDB->fetchSystemByID([ 1, 21, 4-1, 1, 3, 1, 1 ]), - 'fetch a complex set of systems by ID' + my @systems1And3 = $configDB->fetchSystemByID([ 1, 21, 4-1, 1, 3, 1, 1 ]), + 'fetch a complex set of systems by ID' ); is(@systems1And3, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 3 @@ -254,74 +254,74 @@ is($systems1And3[1]->{id}, 3, 'second id should be 3'); # filter systems by different attributes & values in combination ok( - my @system1Only = $configDB->fetchSystemByFilter( {}, undef, { - ramfs_nicmods => 'e1000 forcedeth r8169' - } ), - 'fetch system 1 by filter on attribute ramfs_nicmods' + my @system1Only = $configDB->fetchSystemByFilter( {}, undef, { + ramfs_nicmods => 'e1000 forcedeth r8169' + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); ok( - @system1Only = $configDB->fetchSystemByFilter( undef, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - 'fetch system 1 by filter on attribute ramfs_nicmods' + @system1Only = $configDB->fetchSystemByFilter( undef, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); ok( - @system1Only = $configDB->fetchSystemByFilter( { - export_id => 1, - hidden => undef, - }, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - 'fetch system 1 by multiple filter on values and attributes' + @system1Only = $configDB->fetchSystemByFilter( { + export_id => 1, + hidden => undef, + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by multiple filter on values and attributes' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchSystemByFilter( { - export_id => 2, - }, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - undef, - 'mismatch system 1 by filter with incorrect value' + $configDB->fetchSystemByFilter( { + export_id => 2, + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect value' ); is( - $configDB->fetchSystemByFilter( { - export_id => 1, - }, 'id', { - ramfs_nicmods => 'xxxx', - slxgrp => undef, - } ), - undef, - 'mismatch system 1 by filter with incorrect attribute value' + $configDB->fetchSystemByFilter( { + export_id => 1, + }, 'id', { + ramfs_nicmods => 'xxxx', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect attribute value' ); is( - $configDB->fetchSystemByFilter( { - name => 'sys-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch system 1 by filter with attribute not being empty' + $configDB->fetchSystemByFilter( { + name => 'sys-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch system 1 by filter with attribute not being empty' ); # fetch systems 1 & 2 by filter on attribute start_samba not existing ok( - @systems1And2 = $configDB->fetchSystemByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch systems 1 & 2 by filter on attribute start_samba not existing' + @systems1And2 = $configDB->fetchSystemByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch systems 1 & 2 by filter on attribute start_samba not existing' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -331,34 +331,34 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch a couple of non-existing systems by id is( - $configDB->fetchSystemByID(-1), undef, - 'system with id -1 should not exist' + $configDB->fetchSystemByID(-1), undef, + 'system with id -1 should not exist' ); ok($configDB->fetchSystemByID(0), 'system with id 0 should exist'); is( - $configDB->fetchSystemByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown system' + $configDB->fetchSystemByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown system' ); # try to fetch a couple of non-existing systems by filter is( - $configDB->fetchSystemByFilter({ id => 4 }), undef, - 'fetching system with id=4 by filter should fail' + $configDB->fetchSystemByFilter({ id => 4 }), undef, + 'fetching system with id=4 by filter should fail' ); is( - $configDB->fetchSystemByFilter({ name => 'sys-1.x' }), undef, - 'fetching system with name="sys-1.x" should fail' + $configDB->fetchSystemByFilter({ name => 'sys-1.x' }), undef, + 'fetching system with name="sys-1.x" should fail' ); is( - $configDB->fetchSystemByFilter({ export_id => '2', id => 1 }), undef, - 'fetching system with export_id=2 and id=1 should fail' + $configDB->fetchSystemByFilter({ export_id => '2', id => 1 }), undef, + 'fetching system with export_id=2 and id=1 should fail' ); # rename system 1 and then fetch it by its new name ok($configDB->changeSystem(1, { name => q{SYS-'1'} }), 'changing system 1'); ok( - $system1 = $configDB->fetchSystemByFilter({ name => q{SYS-'1'} }), - 'fetching renamed system 1' + $system1 = $configDB->fetchSystemByFilter({ name => q{SYS-'1'} }), + 'fetching renamed system 1' ); is($system1->{id}, 1, 'really got system number 1'); is($system1->{name}, q{SYS-'1'}, q{really got system named "SYS-'1'"}); @@ -395,8 +395,8 @@ ok(!exists $system1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeSystem(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeSystem(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeSystem(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/13-client.t b/config-db/t/13-client.t index 1c8ea99f..c9c77db9 100644 --- a/config-db/t/13-client.t +++ b/config-db/t/13-client.t @@ -12,96 +12,96 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); ok( - my $client = $configDB->fetchClientByFilter, - 'one client [default] should exist (scalar context)' + my $client = $configDB->fetchClientByFilter, + 'one client [default] should exist (scalar context)' ); foreach my $requiredCol (qw(name mac)) { - my $wrongClient = { - 'name' => 'name', - 'mac' => '01:02:03:04:05:06', - 'comment' => 'has column missing', - }; - delete $wrongClient->{$requiredCol}; - ok( - ! eval { my $clientID = $configDB->addClient($wrongClient); }, - "inserting a client without '$requiredCol' column should fail" - ); + my $wrongClient = { + 'name' => 'name', + 'mac' => '01:02:03:04:05:06', + 'comment' => 'has column missing', + }; + delete $wrongClient->{$requiredCol}; + ok( + ! eval { my $clientID = $configDB->addClient($wrongClient); }, + "inserting a client without '$requiredCol' column should fail" + ); } is( - my @clients = $configDB->fetchClientByFilter, 1, - 'still just one client [default] should exist (array context)' + my @clients = $configDB->fetchClientByFilter, 1, + 'still just one client [default] should exist (array context)' ); my $inClient1 = { - 'name' => 'cli-1', - 'mac' => '01:02:03:04:05:01', - 'comment' => '', - 'attrs' => { - 'slxgrp' => 'slxgrp', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - }, + 'name' => 'cli-1', + 'mac' => '01:02:03:04:05:01', + 'comment' => '', + 'attrs' => { + 'slxgrp' => 'slxgrp', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, }; is( - my $client1ID = $configDB->addClient($inClient1), 1, - 'first client has ID 1' + my $client1ID = $configDB->addClient($inClient1), 1, + 'first client has ID 1' ); my $inClient2 = { - 'name' => 'cli-2.0', - 'unbootable' => 1, - 'mac' => '01:02:03:04:05:02', - 'comment' => undef, - 'boot_type' => 'etherboot', + 'name' => 'cli-2.0', + 'unbootable' => 1, + 'mac' => '01:02:03:04:05:02', + 'comment' => undef, + 'boot_type' => 'etherboot', }; my $fullClient = { - 'name' => 'cli-nr-3', - 'mac' => '01:02:03:04:05:03', - 'comment' => 'nuff said', - 'kernel_params' => 'debug=3 console=ttyS1', - 'unbootable' => '0', - 'boot_type' => 'pxe', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'cli-nr-3', + 'mac' => '01:02:03:04:05:03', + 'comment' => 'nuff said', + 'kernel_params' => 'debug=3 console=ttyS1', + 'unbootable' => '0', + 'boot_type' => 'pxe', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($client2ID, $client3ID) = $configDB->addClient([ - $inClient2, $fullClient - ]), - 'add two more clients' + my ($client2ID, $client3ID) = $configDB->addClient([ + $inClient2, $fullClient + ]), + 'add two more clients' ); is($client2ID, 2, 'client 2 should have ID=2'); is($client3ID, 3, 'client 3 should have ID=3'); @@ -150,8 +150,8 @@ is(keys %{$client3->{attrs}}, 31, 'client 3 - attribu # fetch client 2 by a filter on id and check all values ok( - my $client2 = $configDB->fetchClientByFilter({ id => 2 }), - 'fetch client 2 by filter on id' + my $client2 = $configDB->fetchClientByFilter({ id => 2 }), + 'fetch client 2 by filter on id' ); is($client2->{id}, 2, 'client 2 - id'); is($client2->{name}, 'cli-2.0', 'client 2 - name'); @@ -163,8 +163,8 @@ is(keys %{$client2->{attrs}}, 0, 'client 2 - attribute count') # fetch client 1 by filter on name and check all values ok( - my $client1 = $configDB->fetchClientByFilter({ name => 'cli-1' }), - 'fetch client 1 by filter on name' + my $client1 = $configDB->fetchClientByFilter({ name => 'cli-1' }), + 'fetch client 1 by filter on name' ); is($client1->{id}, 1, 'client 1 - id'); is($client1->{name}, 'cli-1', 'client 1 - name'); @@ -180,8 +180,8 @@ is($client1->{attrs}->{start_sshd}, 'yes', 'client 1 - attr start_sshd') # fetch clients 3 & 1 by id ok( - my @clients3And1 = $configDB->fetchClientByID([3, 1]), - 'fetch clients 3 & 1 by id' + my @clients3And1 = $configDB->fetchClientByID([3, 1]), + 'fetch clients 3 & 1 by id' ); is(@clients3And1, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 3 and 1 @@ -191,21 +191,21 @@ is($clients3And1[1]->{id}, 3, 'second id should be 3'); # fetching clients by id without giving any should yield undef is( - $configDB->fetchClientByID(), undef, - 'fetch clients by id without giving any' + $configDB->fetchClientByID(), undef, + 'fetch clients by id without giving any' ); # fetching clients by filter without giving any should yield all of them ok( - @clients = $configDB->fetchClientByFilter(), - 'fetch clients by filter without giving any' + @clients = $configDB->fetchClientByFilter(), + 'fetch clients by filter without giving any' ); is(@clients, 4, 'should have got all four clients'); # fetch clients 1 & 2 by filter on boot_type ok( - my @clients1And3 = $configDB->fetchClientByFilter({ boot_type => 'pxe' }), - 'fetch clients 1 & 3 by filter on boot_type' + my @clients1And3 = $configDB->fetchClientByFilter({ boot_type => 'pxe' }), + 'fetch clients 1 & 3 by filter on boot_type' ); is(@clients1And3, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 1 and 3 @@ -215,17 +215,17 @@ is($clients1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch with multi-column filter ok( - ($client1, $client3) - = $configDB->fetchClientByFilter({ boot_type => 'pxe', id => 1 }), - 'fetching client with boot_type=pxe and id=1 should work' + ($client1, $client3) + = $configDB->fetchClientByFilter({ boot_type => 'pxe', id => 1 }), + 'fetching client with boot_type=pxe and id=1 should work' ); is($client1->{name}, 'cli-1', 'should have got cli-1'); is($client3, undef, 'should not get cli-nr-3'); # fetch client 1 by filter on unbootable being undef'd ok( - my @client1Only = $configDB->fetchClientByFilter({ unbootable => undef }), - 'fetch client 1 by filter on unbootable being undefined' + my @client1Only = $configDB->fetchClientByFilter({ unbootable => undef }), + 'fetch client 1 by filter on unbootable being undefined' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); @@ -233,8 +233,8 @@ is($client1Only[0]->{id}, 1, 'first id should be 1'); # try to fetch multiple occurrences of the same client, combined with # some unknown IDs ok( - @clients1And3 = $configDB->fetchClientByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), - 'fetch a complex set of clients by ID' + @clients1And3 = $configDB->fetchClientByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of clients by ID' ); is(@clients1And3, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 1 and 3 @@ -244,74 +244,74 @@ is($clients1And3[1]->{id}, 3, 'second id should be 3'); # filter clients by different attributes & values in combination ok( - @client1Only = $configDB->fetchClientByFilter( {}, undef, { - start_snmp => 'no', - } ), - 'fetch client 1 by filter on attribute start_snmp' + @client1Only = $configDB->fetchClientByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch client 1 by filter on attribute start_snmp' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); ok( - @client1Only = $configDB->fetchClientByFilter( undef, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch client 1 by filter on attribute start_snmp + non-existing attr' + @client1Only = $configDB->fetchClientByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch client 1 by filter on attribute start_snmp + non-existing attr' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); ok( - @client1Only = $configDB->fetchClientByFilter( { - name => 'cli-1', - unbootable => undef, - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch client 1 by multiple filter on values and attributes' + @client1Only = $configDB->fetchClientByFilter( { + name => 'cli-1', + unbootable => undef, + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch client 1 by multiple filter on values and attributes' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchClientByFilter( { - comment => 'xxx', - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - undef, - 'mismatch client 1 by filter with incorrect value' + $configDB->fetchClientByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect value' ); is( - $configDB->fetchClientByFilter( { - name => 'cli-1', - }, 'id', { - start_snmp => 'yes', - tex_enable => undef, - } ), - undef, - 'mismatch client 1 by filter with incorrect attribute value' + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_snmp => 'yes', + tex_enable => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect attribute value' ); is( - $configDB->fetchClientByFilter( { - name => 'cli-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch client 1 by filter with attribute not being empty' + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch client 1 by filter with attribute not being empty' ); # fetch clients 0, 1 & 2 by filter on attribute start_samba not existing ok( - my @clients01And2 = $configDB->fetchClientByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch clients 0,1 & 2 by filter on attribute start_samba not existing' + my @clients01And2 = $configDB->fetchClientByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch clients 0,1 & 2 by filter on attribute start_samba not existing' ); is(@clients01And2, 3, 'should have got 3 clients'); # now sort by ID and check if we have really got 0, 1 and 2 @@ -322,34 +322,34 @@ is($clients01And2[2]->{id}, 2, 'third id should be 2'); # try to fetch a couple of non-existing clients by id is( - $configDB->fetchClientByID(-1), undef, - 'client with id -1 should not exist' + $configDB->fetchClientByID(-1), undef, + 'client with id -1 should not exist' ); ok($configDB->fetchClientByID(0), 'client with id 0 should exist'); is( - $configDB->fetchClientByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown client' + $configDB->fetchClientByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown client' ); # try to fetch a couple of non-existing clients by filter is( - $configDB->fetchClientByFilter({ id => 4 }), undef, - 'fetching client with id=4 by filter should fail' + $configDB->fetchClientByFilter({ id => 4 }), undef, + 'fetching client with id=4 by filter should fail' ); is( - $configDB->fetchClientByFilter({ name => 'cli-1.x' }), undef, - 'fetching client with name="cli-1.x" should fail' + $configDB->fetchClientByFilter({ name => 'cli-1.x' }), undef, + 'fetching client with name="cli-1.x" should fail' ); is( - $configDB->fetchClientByFilter({ mac => '01:01:01:01:01:01', id => 1 }), undef, - 'fetching client with mac=01:01:01:01:01:01 and id=1 should fail' + $configDB->fetchClientByFilter({ mac => '01:01:01:01:01:01', id => 1 }), undef, + 'fetching client with mac=01:01:01:01:01:01 and id=1 should fail' ); # rename client 1 and then fetch it by its new name ok($configDB->changeClient(1, { name => q{CLI-'1'} }), 'changing client 1'); ok( - $client1 = $configDB->fetchClientByFilter({ name => q{CLI-'1'} }), - 'fetching renamed client 1' + $client1 = $configDB->fetchClientByFilter({ name => q{CLI-'1'} }), + 'fetching renamed client 1' ); is($client1->{id}, 1, 'really got client number 1'); is($client1->{name}, q{CLI-'1'}, q{really got client named "CLI-'1'"}); @@ -386,8 +386,8 @@ ok(!exists $client1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeClient(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeClient(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeClient(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/14-group.t b/config-db/t/14-group.t index b06620ce..5c5d0f81 100644 --- a/config-db/t/14-group.t +++ b/config-db/t/14-group.t @@ -12,90 +12,90 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $group = $configDB->fetchGroupByFilter, undef, - 'no group should exist (scalar context)' + my $group = $configDB->fetchGroupByFilter, undef, + 'no group should exist (scalar context)' ); foreach my $requiredCol (qw(name)) { - my $wrongGroup = { - 'name' => 'name', - 'priority' => 41, - 'comment' => 'has column missing', - }; - delete $wrongGroup->{$requiredCol}; - ok( - ! eval { my $groupID = $configDB->addGroup($wrongGroup); }, - "inserting a group without '$requiredCol' column should fail" - ); + my $wrongGroup = { + 'name' => 'name', + 'priority' => 41, + 'comment' => 'has column missing', + }; + delete $wrongGroup->{$requiredCol}; + ok( + ! eval { my $groupID = $configDB->addGroup($wrongGroup); }, + "inserting a group without '$requiredCol' column should fail" + ); } is( - my @groups = $configDB->fetchGroupByFilter, 0, - 'still no group should exist (array context)' + my @groups = $configDB->fetchGroupByFilter, 0, + 'still no group should exist (array context)' ); my $inGroup1 = { - 'name' => 'grp-1', - 'comment' => '', - 'attrs' => { - 'slxgrp' => 'slxgrp', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - }, + 'name' => 'grp-1', + 'comment' => '', + 'attrs' => { + 'slxgrp' => 'slxgrp', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, }; is( - my $group1ID = $configDB->addGroup($inGroup1), 1, - 'first group has ID 1' + my $group1ID = $configDB->addGroup($inGroup1), 1, + 'first group has ID 1' ); my $inGroup2 = { - 'name' => 'grp-2.0', - 'priority' => 30, - 'comment' => undef, + 'name' => 'grp-2.0', + 'priority' => 30, + 'comment' => undef, }; my $fullGroup = { - 'name' => 'grp-nr-3', - 'priority' => 50, - 'comment' => 'nuff said', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'grp-nr-3', + 'priority' => 50, + 'comment' => 'nuff said', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($group2ID, $group3ID) = $configDB->addGroup([ - $inGroup2, $fullGroup - ]), - 'add two more groups' + my ($group2ID, $group3ID) = $configDB->addGroup([ + $inGroup2, $fullGroup + ]), + 'add two more groups' ); is($group2ID, 2, 'group 2 should have ID=2'); is($group3ID, 3, 'group 3 should have ID=3'); @@ -141,8 +141,8 @@ is(keys %{$group3->{attrs}}, 31, 'group 3 - attribute coun # fetch group 2 by a filter on id and check all values ok( - my $group2 = $configDB->fetchGroupByFilter({ id => 2 }), - 'fetch group 2 by filter on id' + my $group2 = $configDB->fetchGroupByFilter({ id => 2 }), + 'fetch group 2 by filter on id' ); is($group2->{id}, 2, 'group 2 - id'); is($group2->{name}, 'grp-2.0', 'group 2 - name'); @@ -152,8 +152,8 @@ is(keys %{$group2->{attrs}}, 0, 'group 2 - attribute count'); # fetch group 1 by filter on name and check all values ok( - my $group1 = $configDB->fetchGroupByFilter({ name => 'grp-1' }), - 'fetch group 1 by filter on name' + my $group1 = $configDB->fetchGroupByFilter({ name => 'grp-1' }), + 'fetch group 1 by filter on name' ); is($group1->{id}, 1, 'group 1 - id'); is($group1->{name}, 'grp-1', 'group 1 - name'); @@ -166,8 +166,8 @@ is($group1->{attrs}->{start_sshd}, 'yes', 'group 1 - attr start_sshd'); # fetch groups 3 & 1 by id ok( - my @groups3And1 = $configDB->fetchGroupByID([3, 1]), - 'fetch groups 3 & 1 by id' + my @groups3And1 = $configDB->fetchGroupByID([3, 1]), + 'fetch groups 3 & 1 by id' ); is(@groups3And1, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 3 and 1 @@ -177,21 +177,21 @@ is($groups3And1[1]->{id}, 3, 'second id should be 3'); # fetching groups by id without giving any should yield undef is( - $configDB->fetchGroupByID(), undef, - 'fetch groups by id without giving any' + $configDB->fetchGroupByID(), undef, + 'fetch groups by id without giving any' ); # fetching groups by filter without giving any should yield all of them ok( - @groups = $configDB->fetchGroupByFilter(), - 'fetch groups by filter without giving any' + @groups = $configDB->fetchGroupByFilter(), + 'fetch groups by filter without giving any' ); is(@groups, 3, 'should have got all three groups'); # fetch groups 1 & 2 by filter on priority ok( - my @groups1And3 = $configDB->fetchGroupByFilter({ priority => 50 }), - 'fetch groups 1 & 3 by filter on priority' + my @groups1And3 = $configDB->fetchGroupByFilter({ priority => 50 }), + 'fetch groups 1 & 3 by filter on priority' ); is(@groups1And3, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 3 @@ -201,17 +201,17 @@ is($groups1And3[1]->{id}, 3, 'second id should be 3'); # fetch group 2 by filter on comment being undef'd ok( - my @group2Only = $configDB->fetchGroupByFilter({ comment => undef }), - 'fetch group 2 by filter on comment being undefined' + my @group2Only = $configDB->fetchGroupByFilter({ comment => undef }), + 'fetch group 2 by filter on comment being undefined' ); is(@group2Only, 1, 'should have got 1 group'); is($group2Only[0]->{id}, 2, 'first id should be 2'); # try to fetch with multi-column filter ok( - ($group1, $group3) - = $configDB->fetchGroupByFilter({ priority => '50', id => 1 }), - 'fetching group with priority=50 and id=1 should work' + ($group1, $group3) + = $configDB->fetchGroupByFilter({ priority => '50', id => 1 }), + 'fetching group with priority=50 and id=1 should work' ); is($group1->{name}, 'grp-1', 'should have got grp-1'); is($group3, undef, 'should not get grp-nr-3'); @@ -219,8 +219,8 @@ is($group3, undef, 'should not get grp-nr-3'); # try to fetch multiple occurrences of the same group, combined with # some unknown IDs ok( - @groups1And3 = $configDB->fetchGroupByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), - 'fetch a complex set of groups by ID' + @groups1And3 = $configDB->fetchGroupByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of groups by ID' ); is(@groups1And3, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 3 @@ -230,74 +230,74 @@ is($groups1And3[1]->{id}, 3, 'second id should be 3'); # filter groups by different attributes & values in combination ok( - my @group1Only = $configDB->fetchGroupByFilter( {}, undef, { - start_snmp => 'no', - } ), - 'fetch group 1 by filter on attribute start_snmp' + my @group1Only = $configDB->fetchGroupByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch group 1 by filter on attribute start_snmp' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); ok( - @group1Only = $configDB->fetchGroupByFilter( undef, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch group 1 by filter on attribute start_snmp + non-existing attr' + @group1Only = $configDB->fetchGroupByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by filter on attribute start_snmp + non-existing attr' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); ok( - @group1Only = $configDB->fetchGroupByFilter( { - name => 'grp-1', - priority => 50, - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch group 1 by multiple filter on values and attributes' + @group1Only = $configDB->fetchGroupByFilter( { + name => 'grp-1', + priority => 50, + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by multiple filter on values and attributes' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchGroupByFilter( { - comment => 'xxx', - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - undef, - 'mismatch group 1 by filter with incorrect value' + $configDB->fetchGroupByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect value' ); is( - $configDB->fetchGroupByFilter( { - name => 'grp-1', - }, 'id', { - start_snmp => 'yes', - tex_enable => undef, - } ), - undef, - 'mismatch group 1 by filter with incorrect attribute value' + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_snmp => 'yes', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect attribute value' ); is( - $configDB->fetchGroupByFilter( { - name => 'grp-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch group 1 by filter with attribute not being empty' + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch group 1 by filter with attribute not being empty' ); # fetch groups 1 & 2 by filter on attribute start_samba not existing ok( - my @groups1And2 = $configDB->fetchGroupByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch groups 1 & 2 by filter on attribute start_samba not existing' + my @groups1And2 = $configDB->fetchGroupByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch groups 1 & 2 by filter on attribute start_samba not existing' ); is(@groups1And2, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 2 @@ -309,29 +309,29 @@ is($groups1And2[1]->{id}, 2, 'second id should be 2'); is($configDB->fetchGroupByID(-1), undef, 'group with id -1 should not exist'); is($configDB->fetchGroupByID(0), undef, 'group with id 0 should not exist'); is( - $configDB->fetchGroupByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown group' + $configDB->fetchGroupByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown group' ); # try to fetch a couple of non-existing groups by filter is( - $configDB->fetchGroupByFilter({ id => 4 }), undef, - 'fetching group with id=4 by filter should fail' + $configDB->fetchGroupByFilter({ id => 4 }), undef, + 'fetching group with id=4 by filter should fail' ); is( - $configDB->fetchGroupByFilter({ name => 'grp-1.x' }), undef, - 'fetching group with name="grp-1.x" should fail' + $configDB->fetchGroupByFilter({ name => 'grp-1.x' }), undef, + 'fetching group with name="grp-1.x" should fail' ); is( - $configDB->fetchGroupByFilter({ priority => '22', id => 1 }), undef, - 'fetching group with priority=22 and id=1 should fail' + $configDB->fetchGroupByFilter({ priority => '22', id => 1 }), undef, + 'fetching group with priority=22 and id=1 should fail' ); # rename group 1 and then fetch it by its new name ok($configDB->changeGroup(1, { name => q{GRP-'1'} }), 'changing group 1'); ok( - $group1 = $configDB->fetchGroupByFilter({ name => q{GRP-'1'} }), - 'fetching renamed group 1' + $group1 = $configDB->fetchGroupByFilter({ name => q{GRP-'1'} }), + 'fetching renamed group 1' ); is($group1->{id}, 1, 'really got group number 1'); is($group1->{name}, q{GRP-'1'}, q{really got group named "GRP-'1'"}); @@ -368,8 +368,8 @@ ok(!exists $group1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeGroup(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeGroup(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeGroup(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/15-global_info.t b/config-db/t/15-global_info.t index 628b2495..8f2f8cf1 100644 --- a/config-db/t/15-global_info.t +++ b/config-db/t/15-global_info.t @@ -13,30 +13,30 @@ $configDB->connect(); # fetch global-info 'next-nbd-server-port' ok( - my $globalInfo = $configDB->fetchGlobalInfo('next-nbd-server-port'), - 'fetch global-info' + my $globalInfo = $configDB->fetchGlobalInfo('next-nbd-server-port'), + 'fetch global-info' ); is($globalInfo, '5000', 'global-info - value'); # try to fetch a couple of non-existing global-infos is( - $configDB->fetchGlobalInfo(-1), undef, - 'global-info with id -1 should not exist' + $configDB->fetchGlobalInfo(-1), undef, + 'global-info with id -1 should not exist' ); is($configDB->fetchGlobalInfo('xxx'), undef, - 'global-info with id xxx should not exist'); + 'global-info with id xxx should not exist'); # change value of global-info and then fetch and check the new value ok($configDB->changeGlobalInfo('next-nbd-server-port', '5050'), 'changing global-info'); is( - $configDB->fetchGlobalInfo('next-nbd-server-port'), '5050', - 'fetching changed global-info' + $configDB->fetchGlobalInfo('next-nbd-server-port'), '5050', + 'fetching changed global-info' ); # changing a non-existing global-info should fail ok( - ! eval { $configDB->changeGlobalInfo('xxx', 'new-value') }, - 'changing unknown global-info should fail' + ! eval { $configDB->changeGlobalInfo('xxx', 'new-value') }, + 'changing unknown global-info should fail' ); $configDB->disconnect(); diff --git a/config-db/t/20-client_system_ref.t b/config-db/t/20-client_system_ref.t index 46e56ddf..93b86950 100644 --- a/config-db/t/20-client_system_ref.t +++ b/config-db/t/20-client_system_ref.t @@ -25,184 +25,184 @@ my $system1 = shift @systems; my $system3 = shift @systems; foreach my $client ($defaultClient, $client1, $client3) { - is( - my @systemIDs = $configDB->fetchSystemIDsOfClient($client->{id}), - 0, "client $client->{id} has no system-IDs yet" - ); + is( + my @systemIDs = $configDB->fetchSystemIDsOfClient($client->{id}), + 0, "client $client->{id} has no system-IDs yet" + ); } foreach my $system ($defaultSystem, $system1, $system3) { - is( - my @clientIDs = $configDB->fetchClientIDsOfSystem($system->{id}), - 0, "system $system->{id} has no client-IDs yet" - ); + is( + my @clientIDs = $configDB->fetchClientIDsOfSystem($system->{id}), + 0, "system $system->{id} has no client-IDs yet" + ); } ok( - $configDB->addSystemIDsToClient(1, [3]), - 'system-ID 3 has been associated to client 1' + $configDB->addSystemIDsToClient(1, [3]), + 'system-ID 3 has been associated to client 1' ); is( - my @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no system-ID" + my @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 1, "client 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of client 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 0, "client 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" ); is( - my @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-IDs" + my @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 1, "system 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 1, "system 3 should have one client-ID" ); is($clientIDs[0], 1, "first client of system 3 should have ID 1"); ok( - $configDB->addSystemIDsToClient(3, [1,3,3,1,3]), - 'system-IDs 1 and 3 have been associated to client 3' + $configDB->addSystemIDsToClient(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to client 3' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 1, "client 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of client 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 2, "client 3 should have two system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 2, "client 3 should have two system-IDs" ); is($systemIDs[0], 1, "first system of client 3 should have ID 1"); is($systemIDs[1], 3, "second system of client 3 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 1, "system 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of system 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 2, "system 3 should have two client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 2, "system 3 should have two client-IDs" ); is($clientIDs[0], 1, "first client of system 3 should have ID 1"); is($clientIDs[1], 3, "second client of system 3 should have ID 3"); ok( - $configDB->setClientIDsOfSystem(3, []), - 'client-IDs of system 3 have been set to empty array' + $configDB->setClientIDsOfSystem(3, []), + 'client-IDs of system 3 have been set to empty array' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 0, "system 3 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should have no system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 1, "client 3 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 1, "client 3 should have one system-ID" ); is($systemIDs[0], 1, "first system of client 3 should have ID 1"); ok( - $configDB->addSystemIDsToClient(1, [0]), - 'associating the default system should have no effect' + $configDB->addSystemIDsToClient(1, [0]), + 'associating the default system should have no effect' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should still have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should still have no system-ID" ); ok( - $configDB->removeClientIDsFromSystem(1, [1]), - 'removing an unassociated client-ID should have no effect' + $configDB->removeClientIDsFromSystem(1, [1]), + 'removing an unassociated client-ID should have no effect' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 1, "system 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" ); ok( - $configDB->removeClientIDsFromSystem(1, [3]), - 'removing an associated client-ID should work' + $configDB->removeClientIDsFromSystem(1, [3]), + 'removing an associated client-ID should work' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no more client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no more client-ID" ); $configDB->addSystem({ - 'name' => 'sys-4', - 'export_id' => 1, - 'comment' => 'shortlived', + 'name' => 'sys-4', + 'export_id' => 1, + 'comment' => 'shortlived', }); ok( - $configDB->addClientIDsToSystem(4, [0]), - 'default client has been associated to system 4' + $configDB->addClientIDsToSystem(4, [0]), + 'default client has been associated to system 4' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 1, "default client should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" ); is($systemIDs[0], 4, "first system of default client should have ID 4"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 0, "client 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 0, "system 3 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(4)), - 1, "system 4 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(4)), + 1, "system 4 should have one client-ID" ); is($clientIDs[0], 0, "first client of system 4 should have ID 0"); ok( - $configDB->removeSystemIDsFromClient(0, [6]), - 'removing an unassociated system-ID should have no effect' + $configDB->removeSystemIDsFromClient(0, [6]), + 'removing an unassociated system-ID should have no effect' ); is( - @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 1, "default client should have one system-ID" + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" ); ok( - $configDB->removeSystem(4), - 'removing a system should drop client associations, too' + $configDB->removeSystem(4), + 'removing a system should drop client associations, too' ); is( - @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no more system-ID" + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no more system-ID" ); $configDB->disconnect(); diff --git a/config-db/t/21-group_system_ref.t b/config-db/t/21-group_system_ref.t index 6f92a8dd..b643f7e0 100644 --- a/config-db/t/21-group_system_ref.t +++ b/config-db/t/21-group_system_ref.t @@ -24,172 +24,172 @@ my $system1 = shift @systems; my $system3 = shift @systems; foreach my $group ($group1, $group3) { - is( - my @systemIDs = $configDB->fetchSystemIDsOfGroup($group->{id}), - 0, "group $group->{id} has no system-IDs yet" - ); + is( + my @systemIDs = $configDB->fetchSystemIDsOfGroup($group->{id}), + 0, "group $group->{id} has no system-IDs yet" + ); } foreach my $system ($defaultSystem, $system1, $system3) { - is( - my @groupIDs = $configDB->fetchGroupIDsOfSystem($system->{id}), - 0, "system $system->{id} has no group-IDs yet" - ); + is( + my @groupIDs = $configDB->fetchGroupIDsOfSystem($system->{id}), + 0, "system $system->{id} has no group-IDs yet" + ); } ok( - $configDB->addSystemIDsToGroup(1, [3]), - 'system-ID 3 has been associated to group 1' + $configDB->addSystemIDsToGroup(1, [3]), + 'system-ID 3 has been associated to group 1' ); is( - my @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 1, "group 1 should have one system-ID" + my @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of group 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 0, "group 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no system-ID" ); is( - my @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-IDs" + my @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 1, "system 3 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 1, "system 3 should have one group-ID" ); is($groupIDs[0], 1, "first group of system 3 should have ID 1"); ok( - $configDB->addSystemIDsToGroup(3, [1,3,3,1,3]), - 'system-IDs 1 and 3 have been associated to group 3' + $configDB->addSystemIDsToGroup(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to group 3' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 1, "group 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of group 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 2, "group 3 should have two system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 2, "group 3 should have two system-IDs" ); is($systemIDs[0], 1, "first system of group 3 should have ID 1"); is($systemIDs[1], 3, "second system of group 3 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 1, "system 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" ); is($groupIDs[0], 3, "first group of system 1 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 2, "system 3 should have two group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 2, "system 3 should have two group-IDs" ); is($groupIDs[0], 1, "first group of system 3 should have ID 1"); is($groupIDs[1], 3, "second group of system 3 should have ID 3"); ok( - $configDB->setGroupIDsOfSystem(3, []), - 'group-IDs of system 3 have been set to empty array' + $configDB->setGroupIDsOfSystem(3, []), + 'group-IDs of system 3 have been set to empty array' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 0, "system 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should have no more system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no more system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" ); is($systemIDs[0], 1, "first system of group 3 should have ID 1"); ok( - $configDB->addSystemIDsToGroup(1, [0]), - 'associating the default system should have no effect' + $configDB->addSystemIDsToGroup(1, [0]), + 'associating the default system should have no effect' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should still have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should still have no system-ID" ); ok( - $configDB->removeGroupIDsFromSystem(1, [1]), - 'removing an unassociated group-ID should have no effect' + $configDB->removeGroupIDsFromSystem(1, [1]), + 'removing an unassociated group-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 1, "system 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" ); ok( - $configDB->removeGroupIDsFromSystem(1, [3]), - 'removing an associated group-ID should work' + $configDB->removeGroupIDsFromSystem(1, [3]), + 'removing an associated group-ID should work' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no more group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no more group-ID" ); $configDB->addSystem({ - 'name' => 'sys-5', - 'export_id' => 1, - 'comment' => 'shortlived', + 'name' => 'sys-5', + 'export_id' => 1, + 'comment' => 'shortlived', }); ok( - $configDB->addGroupIDsToSystem(5, [3]), - 'default group has been associated to system 5' + $configDB->addGroupIDsToSystem(5, [3]), + 'default group has been associated to system 5' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have no system-ID" ); is($systemIDs[0], 5, "first system of group 3 should have ID 5"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 0, "system 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(5)), - 1, "system 5 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(5)), + 1, "system 5 should have one group-ID" ); is($groupIDs[0], 3, "first group of system 5 should have ID 3"); ok( - $configDB->removeSystemIDsFromGroup(3, [6]), - 'removing an unassociated system-ID should have no effect' + $configDB->removeSystemIDsFromGroup(3, [6]), + 'removing an unassociated system-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have one system-ID" + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" ); ok( - $configDB->removeSystem(5), - 'removing a system should drop group associations, too' + $configDB->removeSystem(5), + 'removing a system should drop group associations, too' ); is( - @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 0, "group 3 should have no more system-ID" + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no more system-ID" ); $configDB->disconnect(); diff --git a/config-db/t/22-group_client_ref.t b/config-db/t/22-group_client_ref.t index d330bc23..ff9d6ca7 100644 --- a/config-db/t/22-group_client_ref.t +++ b/config-db/t/22-group_client_ref.t @@ -24,163 +24,163 @@ my $client1 = shift @clients; my $client3 = shift @clients; foreach my $group ($group1, $group3) { - is( - my @clientIDs = $configDB->fetchClientIDsOfGroup($group->{id}), - 0, "group $group->{id} has no client-IDs yet" - ); + is( + my @clientIDs = $configDB->fetchClientIDsOfGroup($group->{id}), + 0, "group $group->{id} has no client-IDs yet" + ); } foreach my $client ($defaultClient, $client1, $client3) { - is( - my @groupIDs = $configDB->fetchGroupIDsOfClient($client->{id}), - 0, "client $client->{id} has no group-IDs yet" - ); + is( + my @groupIDs = $configDB->fetchGroupIDsOfClient($client->{id}), + 0, "client $client->{id} has no group-IDs yet" + ); } ok( - $configDB->addClientIDsToGroup(1, [3]), - 'client-ID 3 has been associated to group 1' + $configDB->addClientIDsToGroup(1, [3]), + 'client-ID 3 has been associated to group 1' ); is( - my @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 1, "group 1 should have one client-ID" + my @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of group 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 0, "group 3 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no client-ID" ); is( - my @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-IDs" + my @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 1, "client 3 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 1, "client 3 should have one group-ID" ); is($groupIDs[0], 1, "first group of client 3 should have ID 1"); ok( - $configDB->addClientIDsToGroup(3, [1,3,3,1,3]), - 'client-IDs 1 and 3 have been associated to group 3' + $configDB->addClientIDsToGroup(3, [1,3,3,1,3]), + 'client-IDs 1 and 3 have been associated to group 3' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 1, "group 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of group 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 2, "group 3 should have two client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 2, "group 3 should have two client-IDs" ); is($clientIDs[0], 1, "first client of group 3 should have ID 1"); is($clientIDs[1], 3, "second client of group 3 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 1, "client 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" ); is($groupIDs[0], 3, "first group of client 1 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 2, "client 3 should have two group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 2, "client 3 should have two group-IDs" ); is($groupIDs[0], 1, "first group of client 3 should have ID 1"); is($groupIDs[1], 3, "second group of client 3 should have ID 3"); ok( - $configDB->setGroupIDsOfClient(3, []), - 'group-IDs of client 3 have been set to empty array' + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set to empty array' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 0, "client 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 0, "group 1 should have no more client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no more client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); is($clientIDs[0], 1, "first client of group 3 should have ID 1"); ok( - $configDB->removeGroupIDsFromClient(1, [1]), - 'removing an unassociated group-ID should have no effect' + $configDB->removeGroupIDsFromClient(1, [1]), + 'removing an unassociated group-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 1, "client 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" ); ok( - $configDB->removeGroupIDsFromClient(1, [3]), - 'removing an associated group-ID should work' + $configDB->removeGroupIDsFromClient(1, [3]), + 'removing an associated group-ID should work' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no more group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no more group-ID" ); $configDB->addClient({ - 'name' => 'cli-4', - 'mac' => '01:01:01:02:02:02', - 'comment' => 'shortlived', + 'name' => 'cli-4', + 'mac' => '01:01:01:02:02:02', + 'comment' => 'shortlived', }); ok( - $configDB->addGroupIDsToClient(4, [3]), - 'default group has been associated to client 4' + $configDB->addGroupIDsToClient(4, [3]), + 'default group has been associated to client 4' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 0, "group 1 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); is($clientIDs[0], 4, "first client of group 3 should have ID 1"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 0, "client 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(4)), - 1, "client 4 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(4)), + 1, "client 4 should have one group-ID" ); is($groupIDs[0], 3, "first group of client 4 should have ID 3"); ok( - $configDB->removeClientIDsFromGroup(3, [6]), - 'removing an unassociated client-ID should have no effect' + $configDB->removeClientIDsFromGroup(3, [6]), + 'removing an unassociated client-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); ok( - $configDB->removeClient(4), - 'removing a client should drop group associations, too' + $configDB->removeClient(4), + 'removing a client should drop group associations, too' ); is( - @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 0, "group 3 should have no more client-ID" + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no more client-ID" ); $configDB->disconnect(); diff --git a/config-db/t/25-attributes.t b/config-db/t/25-attributes.t index 469d330c..32c1b0fb 100644 --- a/config-db/t/25-attributes.t +++ b/config-db/t/25-attributes.t @@ -13,350 +13,350 @@ use OpenSLX::ConfigDB qw(:support); my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); -my $defaultAttrs = { # mostly copied from DBSchema - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'yes', - 'start_xdmcp' => 'kdm', - 'tex_enable' => 'no', - 'timezone' => 'Europe/Berlin', - 'tvout' => 'no', - 'vmware' => 'no', +my $defaultAttrs = { # mostly copied from DBSchema + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'yes', + 'start_xdmcp' => 'kdm', + 'tex_enable' => 'no', + 'timezone' => 'Europe/Berlin', + 'tvout' => 'no', + 'vmware' => 'no', }; ok( - $configDB->changeSystem(0, { attrs => $defaultAttrs } ), - 'attributes of default system have been set' + $configDB->changeSystem(0, { attrs => $defaultAttrs } ), + 'attributes of default system have been set' ); my $defaultSystem = $configDB->fetchSystemByID(0); my $system1 = $configDB->fetchSystemByID(1); my $sys1Attrs = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - 'start_x' => 'no', - 'start_xdmcp' => '', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + 'start_x' => 'no', + 'start_xdmcp' => '', }; ok( - $configDB->changeSystem(1, { attrs => $sys1Attrs } ), - 'attributes of system 1 have been set' + $configDB->changeSystem(1, { attrs => $sys1Attrs } ), + 'attributes of system 1 have been set' ); my $system3 = $configDB->fetchSystemByID(3); my $sys3Attrs = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '13', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => '23', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => '29', - 'tvout' => '30', - 'vmware' => '31', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => '23', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => '29', + 'tvout' => '30', + 'vmware' => '31', }; ok( - $configDB->changeSystem(3, { attrs => $sys3Attrs } ), - 'attributes of system 3 have been set' + $configDB->changeSystem(3, { attrs => $sys3Attrs } ), + 'attributes of system 3 have been set' ); my $defaultClient = $configDB->fetchClientByID(0); my $defaultClientAttrs = { - # pretend the whole computer centre has been warped to London ;-) - 'timezone' => 'Europe/London', - # pretend we wanted to activate snmp globally (e.g. for testing) - 'start_snmp' => 'yes', + # pretend the whole computer centre has been warped to London ;-) + 'timezone' => 'Europe/London', + # pretend we wanted to activate snmp globally (e.g. for testing) + 'start_snmp' => 'yes', }; ok( - $configDB->changeClient(0, { attrs => $defaultClientAttrs } ), - 'attributes of default client have been set' + $configDB->changeClient(0, { attrs => $defaultClientAttrs } ), + 'attributes of default client have been set' ); # check merging of default attributes, the order should be: # default system attributes overruled by system attributes overruled by # default client attributes: my $shouldBeAttrs1 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'Europe/London', - 'tvout' => 'no', - 'vmware' => 'no', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'no', }; my $mergedSystem1 = $configDB->fetchSystemByID(1); ok( - $configDB->mergeDefaultAttributesIntoSystem($mergedSystem1), - 'merging default attributes into system 1' + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem1), + 'merging default attributes into system 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedSystem1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for system 1" - ); + is( + $mergedSystem1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for system 1" + ); } # check merging code for completeness (using all attributes): my $shouldBeAttrs3 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '13', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'Europe/London', - 'tvout' => '30', - 'vmware' => '31', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => '31', }; my $mergedSystem3 = $configDB->fetchSystemByID(3); ok( - $configDB->mergeDefaultAttributesIntoSystem($mergedSystem3), - 'merging default attributes into system 3' + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem3), + 'merging default attributes into system 3' ); foreach my $key (sort keys %$shouldBeAttrs3) { - is( - $mergedSystem3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for system 3" - ); + is( + $mergedSystem3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for system 3" + ); } # setup client / group relations my $group1 = $configDB->fetchGroupByID(1); my $group1Attrs = { - 'priority' => '50', - # this group of clients is connected via underwater cable ... - 'timezone' => 'America/New_York', - # ... and use a local scratch partition - 'scratch' => '/dev/sdd1', - # the following should be a noop (as that attribute is system-specific) -# 'ramfs_nicmods' => 'e1000', + 'priority' => '50', + # this group of clients is connected via underwater cable ... + 'timezone' => 'America/New_York', + # ... and use a local scratch partition + 'scratch' => '/dev/sdd1', + # the following should be a noop (as that attribute is system-specific) +# 'ramfs_nicmods' => 'e1000', }; ok( - $configDB->changeGroup(1, { attrs => $group1Attrs } ), - 'attributes of group 1 have been set' + $configDB->changeGroup(1, { attrs => $group1Attrs } ), + 'attributes of group 1 have been set' ); my $group3 = $configDB->fetchGroupByID(3); my $group3Attrs = { - 'priority' => '30', - # this specific client group is older and thus has a different scratch - 'scratch' => '/dev/hdd1', - 'vmware' => 'yes', + 'priority' => '30', + # this specific client group is older and thus has a different scratch + 'scratch' => '/dev/hdd1', + 'vmware' => 'yes', }; ok( - $configDB->changeGroup(3, { attrs => $group3Attrs } ), - 'attributes of group 3 have been set' + $configDB->changeGroup(3, { attrs => $group3Attrs } ), + 'attributes of group 3 have been set' ); my $client1 = $configDB->fetchClientByID(1); my $client1Attrs = { - # this specific client uses yet another local scratch partition - 'scratch' => '/dev/sdx3', + # this specific client uses yet another local scratch partition + 'scratch' => '/dev/sdx3', }; ok( - $configDB->changeClient(1, { attrs => $client1Attrs } ), - 'attributes of client 1 have been set' + $configDB->changeClient(1, { attrs => $client1Attrs } ), + 'attributes of client 1 have been set' ); ok( - $configDB->setGroupIDsOfClient(1, [1]), - 'group-IDs of client 1 have been set' + $configDB->setGroupIDsOfClient(1, [1]), + 'group-IDs of client 1 have been set' ); ok( - $configDB->setGroupIDsOfClient(3, []), - 'group-IDs of client 3 have been set' + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set' ); # check merging of attributes into client, the order should be: # default client attributes overruled by group attributes (ordered by priority) # overruled by specific client attributes: $shouldBeAttrs1 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'America/New_York', - 'tvout' => undef, - 'vmware' => undef, + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => undef, }; my $mergedClient1 = $configDB->fetchClientByID(1); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), - 'merging default and group attributes into client 1' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for client 1" - ); + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); } $shouldBeAttrs3 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'Europe/London', - 'tvout' => undef, - 'vmware' => undef, + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => undef, }; # remove all attributes from client 3 @@ -364,314 +364,314 @@ $configDB->changeClient(3, { attrs => {} } ); my $mergedClient3 = $configDB->fetchClientByID(3); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), - 'merging default and group attributes into client 3' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for client 3" - ); + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); } # now associate default client with group 3 and try again ok( - $configDB->setGroupIDsOfClient(0, [3]), - 'group-IDs of default client have been set' + $configDB->setGroupIDsOfClient(0, [3]), + 'group-IDs of default client have been set' ); $shouldBeAttrs1 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'America/New_York', - 'tvout' => undef, - 'vmware' => 'yes', + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => 'yes', }; $mergedClient1 = $configDB->fetchClientByID(1); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), - 'merging default and group attributes into client 1' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for client 1" - ); + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); } $shouldBeAttrs3 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/hdd1', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'Europe/London', - 'tvout' => undef, - 'vmware' => 'yes', + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => 'yes', }; $mergedClient3 = $configDB->fetchClientByID(3); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), - 'merging default and group attributes into client 3' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for client 3" - ); + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); } # finally we merge systems into clients and check the outcome of that my $fullMerge11 = dclone($mergedClient1); ok( - mergeAttributes($fullMerge11, $mergedSystem1), - 'merging system 1 into client 1' + mergeAttributes($fullMerge11, $mergedSystem1), + 'merging system 1 into client 1' ); my $shouldBeAttrs11 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'America/New_York', - 'tvout' => 'no', - 'vmware' => 'yes', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'America/New_York', + 'tvout' => 'no', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs11) { - is( - $fullMerge11->{attrs}->{$key}, $shouldBeAttrs11->{$key}, - "checking merged attribute $key for client 1 / system 1" - ); + is( + $fullMerge11->{attrs}->{$key}, $shouldBeAttrs11->{$key}, + "checking merged attribute $key for client 1 / system 1" + ); } my $fullMerge31 = dclone($mergedClient3); ok( - mergeAttributes($fullMerge31, $mergedSystem1), - 'merging system 1 into client 3' + mergeAttributes($fullMerge31, $mergedSystem1), + 'merging system 1 into client 3' ); my $shouldBeAttrs31 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/hdd1', - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'Europe/London', - 'tvout' => 'no', - 'vmware' => 'yes', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs31) { - is( - $fullMerge31->{attrs}->{$key}, $shouldBeAttrs31->{$key}, - "checking merged attribute $key for client 3 / system 1" - ); + is( + $fullMerge31->{attrs}->{$key}, $shouldBeAttrs31->{$key}, + "checking merged attribute $key for client 3 / system 1" + ); } my $fullMerge13 = dclone($mergedClient1); ok( - mergeAttributes($fullMerge13, $mergedSystem3), - 'merging system 3 into client 1' + mergeAttributes($fullMerge13, $mergedSystem3), + 'merging system 3 into client 1' ); my $shouldBeAttrs13 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '/dev/sdx3', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'America/New_York', - 'tvout' => '30', - 'vmware' => 'yes', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/sdx3', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'America/New_York', + 'tvout' => '30', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs13) { - is( - $fullMerge13->{attrs}->{$key}, $shouldBeAttrs13->{$key}, - "checking merged attribute $key for client 1 / system 3" - ); + is( + $fullMerge13->{attrs}->{$key}, $shouldBeAttrs13->{$key}, + "checking merged attribute $key for client 1 / system 3" + ); } my $fullMerge33 = dclone($mergedClient3); ok( - mergeAttributes($fullMerge33, $mergedSystem3), - 'merging system 3 into client 3' + mergeAttributes($fullMerge33, $mergedSystem3), + 'merging system 3 into client 3' ); my $shouldBeAttrs33 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '/dev/hdd1', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'Europe/London', - 'tvout' => '30', - 'vmware' => 'yes', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/hdd1', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs33) { - is( - $fullMerge33->{attrs}->{$key}, $shouldBeAttrs33->{$key}, - "checking merged attribute $key for client 3 / system 3" - ); + is( + $fullMerge33->{attrs}->{$key}, $shouldBeAttrs33->{$key}, + "checking merged attribute $key for client 3 / system 3" + ); } $configDB->disconnect(); diff --git a/config-db/t/29-transaction.t b/config-db/t/29-transaction.t index 2088a16c..1f1566bf 100644 --- a/config-db/t/29-transaction.t +++ b/config-db/t/29-transaction.t @@ -30,7 +30,7 @@ my @clients2 = $configDB->fetchClientByFilter(); my @groups2 = $configDB->fetchGroupByFilter(); is( - scalar @vendorOSes2, scalar @vendorOSes, "should still have all vendor-OSes" + scalar @vendorOSes2, scalar @vendorOSes, "should still have all vendor-OSes" ); is(scalar @exports2, scalar @exports, "should still have all exports"); is(scalar @systems2, scalar @systems, "should still have all systems"); diff --git a/config-db/t/run-all-tests.pl b/config-db/t/run-all-tests.pl index c082052d..4ae59a7d 100755 --- a/config-db/t/run-all-tests.pl +++ b/config-db/t/run-all-tests.pl @@ -28,8 +28,8 @@ $Test::Harness::Verbose = 1 if $openslxConfig{'verbose-level'}; # remove the test-db if it already exists my $metaDB = OpenSLX::MetaDB::SQLite->new(); if ($metaDB->databaseExists()) { - print "removing leftovers of slx-test-db\n"; - $metaDB->dropDatabase(); + print "removing leftovers of slx-test-db\n"; + $metaDB->dropDatabase(); } runtests(glob("*.t")); -- cgit v1.2.3-55-g7522