summaryrefslogtreecommitdiffstats
path: root/config-db/OpenSLX
diff options
context:
space:
mode:
authorOliver Tappe2007-07-01 22:28:50 +0200
committerOliver Tappe2007-07-01 22:28:50 +0200
commit6974fa8b0419bbd0711f79c8b78e07a9543810dd (patch)
tree25141f0f4d20ca8fdb1c845edf5b9ce4b24a6e98 /config-db/OpenSLX
parentTried to add Ubuntu 7.04 to the list of cloneable systems. (diff)
downloadcore-6974fa8b0419bbd0711f79c8b78e07a9543810dd.tar.gz
core-6974fa8b0419bbd0711f79c8b78e07a9543810dd.tar.xz
core-6974fa8b0419bbd0711f79c8b78e07a9543810dd.zip
* activated 'use warnings' to all modules and adjusted all occurences of
'use of uninitialized values', a couple of which might still show up * adjusted all code with respect to passing perlcritic level 4 and 5 git-svn-id: http://svn.openslx.org/svn/openslx/trunk@1207 95ad53e4-c205-0410-b2fa-d234c58c8868
Diffstat (limited to 'config-db/OpenSLX')
-rw-r--r--config-db/OpenSLX/ConfigDB.pm58
-rw-r--r--config-db/OpenSLX/DBSchema.pm6
-rw-r--r--config-db/OpenSLX/Export/DHCP/ISC.pm8
-rw-r--r--config-db/OpenSLX/MetaDB/Base.pm6
-rw-r--r--config-db/OpenSLX/MetaDB/CSV.pm7
-rw-r--r--config-db/OpenSLX/MetaDB/DBI.pm8
-rw-r--r--config-db/OpenSLX/MetaDB/SQLite.pm20
-rw-r--r--config-db/OpenSLX/MetaDB/mysql.pm7
8 files changed, 53 insertions, 67 deletions
diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm
index 5518d230..e9940fd1 100644
--- a/config-db/OpenSLX/ConfigDB.pm
+++ b/config-db/OpenSLX/ConfigDB.pm
@@ -11,9 +11,14 @@
package OpenSLX::ConfigDB;
use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
$VERSION = 1; # API-version
+use Exporter;
+@ISA = qw(Exporter);
+
################################################################################
### This module defines the data abstraction layer for the OpenSLX configuration
### database.
@@ -28,9 +33,6 @@ $VERSION = 1; # API-version
### - support methods
################################################################################
-use Exporter;
-@ISA = qw(Exporter);
-
my @supportExports = qw(
isAttribute mergeAttributes pushAttributes
externalIDForSystem externalIDForClient externalConfigNameForClient
@@ -44,7 +46,6 @@ my @supportExports = qw(
################################################################################
### private stuff
################################################################################
-use Carp;
use OpenSLX::Basics;
use OpenSLX::DBSchema;
@@ -106,7 +107,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary
$changeDescr->{'cols'}
);
} else {
- confess _tr('UnknownDbSchemaCommand', $cmd);
+ croak _tr('UnknownDbSchemaCommand', $cmd);
}
}
}
@@ -162,29 +163,25 @@ sub connect
$dbType = $dbTypeMap{$lcType};
}
+ my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm";
my $dbModule = "OpenSLX::MetaDB::$dbType";
- unless (eval "require $dbModule") {
+ unless (eval { require $dbModuleName } ) {
if ($! == 2) {
die _tr(
"Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n",
- $dbModule
+ $dbModuleName
);
} else {
- die _tr("Unable to load DB-module <%s> (%s)\n", $dbModule, $@);
+ die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@);
}
}
- my $modVersion = $dbModule->VERSION;
- if ($modVersion < $VERSION) {
- confess _tr(
- 'Could not load module <%s> (Version <%s> required, but <%s> found)',
- $dbModule, $VERSION, $modVersion);
- }
my $metaDB = $dbModule->new();
- if (!eval '$metaDB->connect($dbParams);1') {
- warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModule, $@);
+ 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 ('CSV', 'mysql', 'SQLite') {
- if (eval "require DBD::$dbMod;") {
+ my $fullDbModName = "DBD/$dbMod.pm";
+ if (eval { require $fullDbModName }) {
vlog(0, "\t$dbMod\n");
}
}
@@ -436,7 +433,7 @@ sub incrementExportCounterForVendorOS
$self->start_transaction();
my $vendorOS = $self->fetchVendorOSByID($id);
- return undef unless defined $vendorOS;
+ return unless defined $vendorOS;
my $exportCounter = $vendorOS->{export_counter} + 1;
$self->changeVendorOS($id, {'export_counter' => $exportCounter});
$self->commit_transaction();
@@ -451,7 +448,7 @@ sub incrementGlobalCounter
$self->start_transaction();
my $value = $self->fetchGlobalInfo($counterName);
- return undef unless defined $value;
+ return unless defined $value;
my $newValue = $value + 1;
$self->changeGlobalInfo($counterName, $newValue);
$self->commit_transaction();
@@ -499,10 +496,10 @@ sub addSystem
my $valRows = _aref(shift);
foreach my $valRow (@$valRows) {
- if (!length($valRow->{kernel})) {
+ if (!defined $valRow->{kernel} || !length($valRow->{kernel})) {
$valRow->{kernel} = 'vmlinuz';
}
- if (!length($valRow->{label})) {
+ if (!defined $valRow->{label} || !length($valRow->{label})) {
$valRow->{label} = $valRow->{name};
}
}
@@ -958,7 +955,7 @@ sub aggregatedSystemFileInfoFor
"$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot";
$info->{'kernel-file'} = "$kernelPath/$system->{kernel}";
- my $exportURI = $export->{'uri'};
+ my $exportURI = $export->{'uri'} || '';
if ($exportURI !~ m[\w]) {
# auto-generate export_uri if none has been given:
my $type = $export->{'type'};
@@ -987,9 +984,11 @@ sub mergeAttributes
my $source = shift;
foreach my $key (grep { isAttribute($_) } keys %$source) {
- if (length($source->{$key}) > 0 && length($target->{$key}) == 0) {
- vlog(3, _tr("merging %s (val=%s)", $key, $source->{$key}));
- $target->{$key} = $source->{$key};
+ my $sourceVal = $source->{$key} || '';
+ my $targetVal = $target->{$key} || '';
+ if (length($sourceVal) > 0 && length($targetVal) == 0) {
+ vlog(3, _tr("merging %s (val=%s)", $key, $sourceVal));
+ $target->{$key} = $sourceVal;
}
}
}
@@ -1000,9 +999,10 @@ sub pushAttributes
my $source = shift;
foreach my $key (grep { isAttribute($_) } keys %$source) {
- if (length($source->{$key}) > 0) {
- vlog(3, _tr("pushing %s (val=%s)", $key, $source->{$key}));
- $target->{$key} = $source->{$key};
+ my $sourceVal = $source->{$key} || '';
+ if (length($sourceVal) > 0) {
+ vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal));
+ $target->{$key} = $sourceVal;
}
}
}
diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm
index 0fbce67a..1454390a 100644
--- a/config-db/OpenSLX/DBSchema.pm
+++ b/config-db/OpenSLX/DBSchema.pm
@@ -14,7 +14,9 @@
package OpenSLX::DBSchema;
use strict;
-use vars qw(@ISA @EXPORT $VERSION);
+use warnings;
+
+our (@ISA, @EXPORT, $VERSION);
use Exporter;
$VERSION = 0.01;
@@ -24,7 +26,7 @@ $VERSION = 0.01;
$DbSchema %DbSchemaHistory
);
-use vars qw($DbSchema %DbSchemaHistory);
+our ($DbSchema, %DbSchemaHistory);
# configurable attributes for system, client and group:
my @sharedAttributes = (
diff --git a/config-db/OpenSLX/Export/DHCP/ISC.pm b/config-db/OpenSLX/Export/DHCP/ISC.pm
index 194876fa..2e7aa01b 100644
--- a/config-db/OpenSLX/Export/DHCP/ISC.pm
+++ b/config-db/OpenSLX/Export/DHCP/ISC.pm
@@ -13,14 +13,14 @@
# -----------------------------------------------------------------------------
package OpenSLX::Export::DHCP::ISC;
-use vars qw(@ISA $VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+use strict;
+use warnings;
+
+our $VERSION = 1.01; # API-version . implementation-version
################################################################################
### This class provides an ISC specific implementation for DHCP export.
################################################################################
-use strict;
-use Carp;
use OpenSLX::Basics;
################################################################################
diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm
index 2738cb16..2aa1c3f2 100644
--- a/config-db/OpenSLX/MetaDB/Base.pm
+++ b/config-db/OpenSLX/MetaDB/Base.pm
@@ -14,11 +14,11 @@
package OpenSLX::MetaDB::Base;
use strict;
+use warnings;
-use vars qw($VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+our $VERSION = 1.01; # API-version . implementation-version
-use Carp;
+use OpenSLX::Basics;
################################################################################
### basic functions
diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm
index 104a4d98..ef96833a 100644
--- a/config-db/OpenSLX/MetaDB/CSV.pm
+++ b/config-db/OpenSLX/MetaDB/CSV.pm
@@ -14,8 +14,8 @@
package OpenSLX::MetaDB::CSV;
use strict;
-use vars qw($VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+use warnings;
+
use base qw(OpenSLX::MetaDB::DBI);
################################################################################
@@ -24,12 +24,9 @@ use base qw(OpenSLX::MetaDB::DBI);
### - each table will be stored into a CSV file.
### - by default all files will be created inside a 'openslxdata-csv' directory.
################################################################################
-use strict;
-use Carp;
use Fcntl qw(:DEFAULT :flock);
use DBD::CSV 0.22;
use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
################################################################################
### implementation
diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm
index ea0b66f1..91d774c7 100644
--- a/config-db/OpenSLX/MetaDB/DBI.pm
+++ b/config-db/OpenSLX/MetaDB/DBI.pm
@@ -14,14 +14,12 @@
package OpenSLX::MetaDB::DBI;
use strict;
-use vars qw($VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+use warnings;
+
use base qw(OpenSLX::MetaDB::Base);
-use Carp;
use DBI;
use OpenSLX::Basics;
-use OpenSLX::MetaDB::Base 1;
################################################################################
### basics
@@ -783,7 +781,7 @@ sub schemaFetchDBVersion
eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); };
return 0 if $@;
# no database access possible
- return undef unless defined $row;
+ return unless defined $row;
# no entry in meta-table
return $row->{schema_version};
}
diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm
index 65e1668c..d6681ce6 100644
--- a/config-db/OpenSLX/MetaDB/SQLite.pm
+++ b/config-db/OpenSLX/MetaDB/SQLite.pm
@@ -14,19 +14,16 @@
package OpenSLX::MetaDB::SQLite;
use strict;
-use vars qw($VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+use warnings;
+
use base qw(OpenSLX::MetaDB::DBI);
################################################################################
### This class provides a MetaDB backend for SQLite databases.
### - by default the db will be created inside a 'openslxdata-sqlite' directory.
################################################################################
-use strict;
-use Carp;
use DBD::SQLite;
use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
################################################################################
### implementation
@@ -52,16 +49,11 @@ sub connect
$dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}";
}
vlog(1, "trying to connect to SQLite-database <$dbSpec>");
- eval('require DBD::SQLite; 1;')
- or die _tr(
- qq[%s doesn't seem to be installed,
-so there is no support for %s available, sorry!\n%s], 'DBD::SQLite', 'SQLite',
- $@
- );
$self->{'dbh'} =
DBI->connect("dbi:SQLite:$dbSpec", undef, undef,
{PrintError => 0, AutoCommit => 1})
or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr);
+ return 1;
}
sub schemaRenameTable
@@ -77,7 +69,7 @@ sub schemaRenameTable
my $sql = "ALTER TABLE $oldTable RENAME TO $newTable";
vlog(3, $sql);
$dbh->do($sql)
- or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr);
+ or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr));
}
sub schemaAddColumns
@@ -99,8 +91,8 @@ sub schemaAddColumns
my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString";
vlog(3, $sql);
$dbh->do($sql)
- or confess _tr(q[Can't add column to table <%s> (%s)], $table,
- $dbh->errstr);
+ 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) {
diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm
index 195f9870..769506d1 100644
--- a/config-db/OpenSLX/MetaDB/mysql.pm
+++ b/config-db/OpenSLX/MetaDB/mysql.pm
@@ -14,19 +14,16 @@
package OpenSLX::MetaDB::mysql;
use strict;
-use vars qw($VERSION);
-$VERSION = 1.01; # API-version . implementation-version
+use warnings;
+
use base qw(OpenSLX::MetaDB::DBI);
################################################################################
### This class provides a MetaDB backend for mysql databases.
### - by default the db will be created inside a 'openslxdata-mysql' directory.
################################################################################
-use strict;
-use Carp;
use DBD::mysql;
use OpenSLX::Basics;
-use OpenSLX::MetaDB::DBI 1;
################################################################################
### implementation