diff options
Diffstat (limited to 'config-db/OpenSLX')
| -rw-r--r-- | config-db/OpenSLX/AttributeRoster.pm | 768 | ||||
| -rw-r--r-- | config-db/OpenSLX/ConfigDB.pm | 1466 | ||||
| -rw-r--r-- | config-db/OpenSLX/ConfigExport/DHCP/ISC.pm | 20 | ||||
| -rw-r--r-- | config-db/OpenSLX/DBSchema.pm | 1292 | ||||
| -rw-r--r-- | config-db/OpenSLX/MetaDB/Base.pm | 20 | ||||
| -rw-r--r-- | config-db/OpenSLX/MetaDB/DBI.pm | 1978 | ||||
| -rw-r--r-- | config-db/OpenSLX/MetaDB/SQLite.pm | 138 | ||||
| -rw-r--r-- | config-db/OpenSLX/MetaDB/mysql.pm | 234 |
8 files changed, 2958 insertions, 2958 deletions
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<getAttrInfo()> @@ -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<getStage3Attrs()> @@ -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<getSystemAttrs()> @@ -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<getClientAttrs()> @@ -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<connect()> @@ -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<disconnect()> @@ -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<startTransaction()> @@ -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<commitTransaction()> @@ -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<rollbackTransaction()> @@ -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<fetchVendorOSByFilter([%$filter], [$resultCols])> @@ -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<fetchVendorOSByID(@$ids, [$resultCols])> @@ -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<fetchInstalledPlugins($vendorOSID)> @@ -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<fetchExportByFilter([%$filter], [$resultCols])> @@ -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<fetchExportByID(@$ids, [$resultCols])> @@ -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<fetchExportIDsOfVendorOS($id)> @@ -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<fetchGlobalInfo($id)> @@ -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<fetchSystemByFilter([%$filter], [$resultCols])> @@ -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<fetchSystemByID(@$ids, [$resultCols])> @@ -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<fetchSystemIDsOfExport($id)> @@ -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<fetchSystemIDsOfClient($id)> @@ -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<fetchSystemIDsOfGroup($id)> @@ -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<fetchClientByFilter([%$filter], [$resultCols])> @@ -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<fetchClientByID(@$ids, [$resultCols])> @@ -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<fetchClientIDsOfSystem($id)> @@ -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<fetchClientIDsOfGroup($id)> @@ -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<fetchGroupByFilter([%$filter], [$resultCols])> @@ -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<fetchGroupByID(@$ids, [$resultCols])> @@ -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<fetchGroupIDsOfSystem($id)> @@ -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<fetchGroupIDsOfClient($id)> @@ -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<undef> 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<removeVendorOS(@$vendorOSIDs)> @@ -1023,19 +1023,19 @@ C<1> if the vendorOS(es) could be removed, C<undef> 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<changeVendorOS(@$vendorOSIDs, @$valRows)> @@ -1062,11 +1062,11 @@ C<1> if the vendorOS(es) could be changed, C<undef> 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<addInstalledPlugin($vendorOSID, $pluginName)> @@ -1093,17 +1093,17 @@ The ID of the new reference entry, C<undef> 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<removeInstalledPlugin($vendorOSID, $pluginName)> @@ -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<addExport(@$valRows)> @@ -1157,13 +1157,13 @@ The IDs of the new export(s), C<undef> 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<removeExport(@$exportIDs)> @@ -1186,10 +1186,10 @@ C<1> if the export(s) could be removed, C<undef> 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<changeExport(@$exportIDs, @$valRows)> @@ -1216,11 +1216,11 @@ C<1> if the export(s) could be changed, C<undef> 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<incrementGlobalCounter($counterName)> @@ -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<changeGlobalInfo($id, $value)> @@ -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<addSystem(@$valRows)> @@ -1309,31 +1309,31 @@ The IDs of the new system(s), C<undef> 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<removeSystem(@$systemIDs)> @@ -1356,15 +1356,15 @@ C<1> if the system(s) could be removed, C<undef> 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<changeSystem(@$systemIDs, @$valRows)> @@ -1391,13 +1391,13 @@ C<1> if the system(s) could be changed, C<undef> 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<setSystemAttr($systemID, $attrName, $attrValue)> @@ -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<setClientIDsOfSystem($systemID, @$clientIDs)> @@ -1462,18 +1462,18 @@ C<1> if the system/client references could be set, C<undef> 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<addClientIDsToSystem($systemID, @$clientIDs)> @@ -1501,14 +1501,14 @@ C<1> if the system/client references could be set, C<undef> 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<removeClientIDsFromSystem($systemID, @$clientIDs)> @@ -1536,17 +1536,17 @@ C<1> if the system/client references could be set, C<undef> 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<setGroupIDsOfSystem($systemID, @$groupIDs)> @@ -1574,16 +1574,16 @@ C<1> if the system/group references could be set, C<undef> 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<addGroupIDsToSystem($systemID, @$groupIDs)> @@ -1611,14 +1611,14 @@ C<1> if the system/group references could be set, C<undef> 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<removeGroupIDsFromSystem($systemID, @$groupIDs)> @@ -1646,17 +1646,17 @@ C<1> if the system/group references could be set, C<undef> 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<addClient(@$valRows)> @@ -1679,21 +1679,21 @@ The IDs of the new client(s), C<undef> 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<removeClient(@$clientIDs)> @@ -1716,15 +1716,15 @@ C<1> if the client(s) could be removed, C<undef> 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<changeClient(@$clientIDs, @$valRows)> @@ -1751,13 +1751,13 @@ C<1> if the client(s) could be changed, C<undef> 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<setClientAttr($clientID, $attrName, $attrValue)> @@ -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<setSystemIDsOfClient($clientID, @$systemIDs)> @@ -1822,16 +1822,16 @@ C<1> if the client/system references could be set, C<undef> 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<addSystemIDsToClient($clientID, @$systemIDs)> @@ -1859,14 +1859,14 @@ C<1> if the client/system references could be set, C<undef> 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<removeSystemIDsFromClient($clientID, @$systemIDs)> @@ -1894,17 +1894,17 @@ C<1> if the client/system references could be set, C<undef> 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<setGroupIDsOfClient($clientID, @$groupIDs)> @@ -1931,13 +1931,13 @@ C<1> if the client/group references could be set, C<undef> 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<addGroupIDsToClient($clientID, @$groupIDs)> @@ -1965,14 +1965,14 @@ C<1> if the client/group references could be set, C<undef> 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<removeGroupsIDsFromClient($clientID, @$groupIDs)> @@ -2000,17 +2000,17 @@ C<1> if the client/group references could be set, C<undef> 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<addGroup(@$valRows)> @@ -2033,20 +2033,20 @@ The IDs of the new group(s), C<undef> 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<removeGroup(@$groupIDs)> @@ -2069,15 +2069,15 @@ C<1> if the group(s) could be removed, C<undef> 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<setGroupAttr($groupID, $attrName, $attrValue)> @@ -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<changeGroup(@$groupIDs, @$valRows)> @@ -2141,13 +2141,13 @@ C<1> if the group(s) could be changed, C<undef> 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<setClientIDsOfGroup($groupID, @$clientIDs)> @@ -2174,13 +2174,13 @@ C<1> if the group/client references could be set, C<undef> 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<addClientIDsToGroup($groupID, @$clientIDs)> @@ -2207,14 +2207,14 @@ C<1> if the group/client references could be set, C<undef> 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<removeClientIDsFromGroup($groupID, @$clientIDs)> @@ -2241,17 +2241,17 @@ C<1> if the group/client references could be set, C<undef> 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<setSystemIDsOfGroup($groupID, @$systemIDs)> @@ -2279,14 +2279,14 @@ C<1> if the group/system references could be set, C<undef> 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<addSystemIDsToGroup($groupID, @$systemIDs)> @@ -2313,14 +2313,14 @@ C<1> if the group/system references could be set, C<undef> 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<removeSystemIDsFromGroup($groupID, @$systemIDs)> @@ -2347,17 +2347,17 @@ C<1> if the group/system references could be set, C<undef> 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<emptyDatabase()> @@ -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 '<<<default>>>' } $self->fetchClientByFilter(); - $self->removeClient(\@clientIDs); + my @clientIDs = map { $_->{id} } + grep { $_->{name} ne '<<<default>>>' } $self->fetchClientByFilter(); + $self->removeClient(\@clientIDs); - my @sysIDs = map { $_->{id} } - grep { $_->{name} ne '<<<default>>>' } $self->fetchSystemByFilter(); - $self->removeSystem(\@sysIDs); + my @sysIDs = map { $_->{id} } + grep { $_->{name} ne '<<<default>>>' } $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 => '<<<default>>>'}); - mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); + # first look into default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<<default>>>'}); + 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 => '<<<default>>>'}); - pushAttributes($system, $defaultClient, $originInfo, 'default-client'); + # finally push the attributes specified for the system itself + my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); + pushAttributes($system, $defaultClient, $originInfo, 'default-client'); - return 1; + return 1; } =item C<mergeDefaultAndGroupAttributesIntoClient($client)> @@ -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 => '<<<default>>>'}); - 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 => '<<<default>>>'}); + mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); + + return 1; } =item C<aggregatedSystemIDsOfClient($client)> @@ -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 => '<<<default>>>'}); - push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); + # add all systems inherited from default client + my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); + push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); - return _unique(@systemIDs); + return _unique(@systemIDs); } =item C<aggregatedClientIDsOfSystem($system)> @@ -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 => '<<<default>>>'}); - my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); + # add all clients directly linked to system: + my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'}); + my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); - if (grep { $_ == $defaultClient->{id}; } @clientIDs) { - # add *all* client-IDs if the system is being referenced by - # the default client, as that means that all clients should offer - # this system for booting: - push( - @clientIDs, - map { $_->{id} } $self->fetchClientByFilter(undef, 'id') - ); - } + 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 => '<<<default>>>'}); - push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); + # add all clients inherited from default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<<default>>>'}); + push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); - return _unique(@clientIDs); + return _unique(@clientIDs); } =item C<aggregatedSystemFileInfoFor($system)> @@ -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<pushAttributes($target, $source)> @@ -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<externalIDForSystem($system)> @@ -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 '<<<default>>>'; + return "default" if $system->{name} eq '<<<default>>>'; - my $name = $system->{name}; - $name =~ tr[/][_]; + my $name = $system->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C<externalIDForClient($client)> @@ -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 '<<<default>>>'; + return "default" if $client->{name} eq '<<<default>>>'; - 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<externalConfigNameForClient($client)> @@ -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 '<<<default>>>'; + return "default" if $client->{name} eq '<<<default>>>'; - my $name = $client->{name}; - $name =~ tr[/][_]; + my $name = $client->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C<generatePlaceholdersFor($varName)> @@ -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' => '<<<default>>>', - '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-name>-<export-type> - 'vendor_os_id:fk', # foreign key - 'comment:s.1024', # internal comment (optional, for admins) - 'type:s.10', # 'nbd', 'nfs', ... - 'server_ip:s.16', # IP of exporting server, if empty the - # boot server will be used - 'port:i', # some export types need to use a specific - # port for each incarnation, if that's the - # case you can specify it here - 'uri:s.255', # path to export (squashfs or NFS-path), if - # empty it will be auto-generated by - # config-demuxer - ], - }, - 'global_info' => { - # a home for global counters and other info - 'cols' => [ - 'id:s.32', # key - 'value:s.128', # value - ], - 'vals' => [ - { # add nbd-server-port - 'id' => 'next-nbd-server-port', - 'value' => '5000', - }, - ], - }, - 'groups' => { - # a group encapsulates a set of clients as one entity, managing - # a group-specific attribute set. All the different attribute - # sets a client inherits via group membership are folded into - # one resulting attribute set with respect to each group's priority. - 'cols' => [ - 'id:pk', # primary key - 'name:s.128', # name of group - 'priority:i', # priority, used for order in group-list - # (from 0-highest to 99-lowest) - 'comment:s.1024', # internal comment (optional, for admins) - ], - }, - 'group_attr' => { - # attributes of groups - 'cols' => [ - 'id:pk', # primary key - 'group_id:fk', # foreign key to group - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'group_client_ref' => { - # groups referring to their clients - 'cols' => [ - 'group_id:fk', # foreign key - 'client_id:fk', # foreign key - ], - }, - 'group_system_ref' => { - # groups referring to the systems each of their clients should - # offer for booting - 'cols' => [ - 'group_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, - 'installed_plugin' => { - # holds the plugins that have been installed into a specific - # vendor-OS - 'cols' => [ - 'id:pk', # primary key - 'vendor_os_id:fk', # foreign key - 'plugin_name:s.64', # name of installed plugin - # (e.g. suse-9.3-kde, debian-3.1-ppc, - # suse-10.2-cloned-from-kiwi). - # This is used as the folder name for the - # corresponding stage1, too. - ], - }, - 'installed_plugin_attr' => { - # (stage1-)attributes of installed plugins - 'cols' => [ - 'id:pk', # primary key - 'installed_plugin_id:fk', # foreign key to installed plugin - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'meta' => { - # information about the database as such - 'cols' => [ - '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: - # <vendor-os-name>-<export-type>-<kernel> - 'label:s.64', # name visible to user (pxe-label) - # if empty, this will be autocreated from - # the name - 'kernel:s.128', # path to kernel file, relative to /boot - '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' => '<<<default>>>', - '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' => '<<<default>>>', + '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-name>-<export-type> + 'vendor_os_id:fk', # foreign key + 'comment:s.1024', # internal comment (optional, for admins) + 'type:s.10', # 'nbd', 'nfs', ... + 'server_ip:s.16', # IP of exporting server, if empty the + # boot server will be used + 'port:i', # some export types need to use a specific + # port for each incarnation, if that's the + # case you can specify it here + 'uri:s.255', # path to export (squashfs or NFS-path), if + # empty it will be auto-generated by + # config-demuxer + ], + }, + 'global_info' => { + # a home for global counters and other info + 'cols' => [ + 'id:s.32', # key + 'value:s.128', # value + ], + 'vals' => [ + { # add nbd-server-port + 'id' => 'next-nbd-server-port', + 'value' => '5000', + }, + ], + }, + 'groups' => { + # a group encapsulates a set of clients as one entity, managing + # a group-specific attribute set. All the different attribute + # sets a client inherits via group membership are folded into + # one resulting attribute set with respect to each group's priority. + 'cols' => [ + 'id:pk', # primary key + 'name:s.128', # name of group + 'priority:i', # priority, used for order in group-list + # (from 0-highest to 99-lowest) + 'comment:s.1024', # internal comment (optional, for admins) + ], + }, + 'group_attr' => { + # attributes of groups + 'cols' => [ + 'id:pk', # primary key + 'group_id:fk', # foreign key to group + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'group_client_ref' => { + # groups referring to their clients + 'cols' => [ + 'group_id:fk', # foreign key + 'client_id:fk', # foreign key + ], + }, + 'group_system_ref' => { + # groups referring to the systems each of their clients should + # offer for booting + 'cols' => [ + 'group_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, + 'installed_plugin' => { + # holds the plugins that have been installed into a specific + # vendor-OS + 'cols' => [ + 'id:pk', # primary key + 'vendor_os_id:fk', # foreign key + 'plugin_name:s.64', # name of installed plugin + # (e.g. suse-9.3-kde, debian-3.1-ppc, + # suse-10.2-cloned-from-kiwi). + # This is used as the folder name for the + # corresponding stage1, too. + ], + }, + 'installed_plugin_attr' => { + # (stage1-)attributes of installed plugins + 'cols' => [ + 'id:pk', # primary key + 'installed_plugin_id:fk', # foreign key to installed plugin + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'meta' => { + # information about the database as such + 'cols' => [ + '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: + # <vendor-os-name>-<export-type>-<kernel> + 'label:s.64', # name visible to user (pxe-label) + # if empty, this will be autocreated from + # the name + 'kernel:s.128', # path to kernel file, relative to /boot + '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' => '<<<default>>>', + '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 => '<<<default>>>', - comment => 'holds default plugins for all vendor-OS', - }]); - - return 1; - }, - 0.28 => sub { - my $metaDB = shift; - - # correct effects of implementation error last time around that caused - # the default vendor-OS to not have any plugins at all - so we add - # the default plugins here: - $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 => '<<<default>>>', + comment => 'holds default plugins for all vendor-OS', + }]); + + return 1; + }, + 0.28 => sub { + my $metaDB = shift; + + # correct effects of implementation error last time around that caused + # the default vendor-OS to not have any plugins at all - so we add + # the default plugins here: + $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 <old> RENAME TO <new>' SQL-command (which - # is much more efficient). - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; - my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $newTable ($colDescrString)"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); - $self->_doInsert($newTable, \@dataRows); - $sql = "DROP TABLE $oldTable"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); - return; + # steps: + # - create the new table + # - copy the data over from the old one + # - drop the old table + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE <old> RENAME TO <new>' SQL-command (which + # is much more efficient). + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $newTable ($colDescrString)"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); + $self->_doInsert($newTable, \@dataRows); + $sql = "DROP TABLE $oldTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); + return; } sub schemaAddColumns { # a rather simple-minded implementation that adds columns to a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE <table> ADD COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); - my $newColStr = join ', ', @newColNames; - vlog(1, "adding columns <$newColStr> to table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - # N.B.: for the insert, we rely on the caller having added the new - # columns to the end of the table (if that isn't the case, things - # break here!) - - if (defined $newColDefaultVals) { - # default values have been provided, we apply them now: - $self->_doUpdate($tempTable, undef, $newColDefaultVals); - } - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE <table> ADD COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); + my $newColStr = join ', ', @newColNames; + vlog(1, "adding columns <$newColStr> to table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + # N.B.: for the insert, we rely on the caller having added the new + # columns to the end of the table (if that isn't the case, things + # break here!) + + if (defined $newColDefaultVals) { + # default values have been provided, we apply them now: + $self->_doUpdate($tempTable, undef, $newColDefaultVals); + } + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } sub schemaDropColumns { # a rather simple-minded implementation that drops columns from a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <table> DROP COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $dropColStr = join ', ', @$dropColNames; - vlog(1, "dropping columns <$dropColStr> from table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE <table> DROP COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $dropColStr = join ', ', @$dropColNames; + vlog(1, "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } sub schemaChangeColumns { # a rather simple-minded implementation that changes columns - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE <table> CHANGE COLUMN <col>' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> of table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - foreach my $oldCol (keys %$colChanges) { - my $newCol = - $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); - # rename current column in all data-rows: - foreach my $row (@dataRows) { - $row->{$newCol} = $row->{$oldCol}; - delete $row->{$oldCol}; - } - } - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE <table> CHANGE COLUMN <col>' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $changeColStr = join ', ', keys %$colChanges; + vlog(1, "changing columns <$changeColStr> of table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + foreach my $oldCol (keys %$colChanges) { + my $newCol = + $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); + # rename current column in all data-rows: + foreach my $row (@dataRows) { + $row->{$newCol} = $row->{$oldCol}; + delete $row->{$oldCol}; + } + } + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } 1; 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; |