1 files changed, 130 insertions, 0 deletions
diff --git a/src/config-db/OpenSLX/MetaDB/SQLite.pm b/src/config-db/OpenSLX/MetaDB/SQLite.pm
new file mode 100644
index 00000000..0846582f
--- /dev/null
+++ b/src/config-db/OpenSLX/MetaDB/SQLite.pm
@@ -0,0 +1,130 @@
+# Copyright (c) 2006, 2007 - OpenSLX GmbH
+#
+# This program is free software distributed under the GPL version 2.
+# See http://openslx.org/COPYING
+#
+# If you have any feedback please consult http://openslx.org/feedback and
+# send your suggestions, praise, or complaints to feedback@openslx.org
+#
+# General information about OpenSLX can be found at http://openslx.org/
+# -----------------------------------------------------------------------------
+# SQLite.pm
+#    - provides SQLite-specific overrides of the OpenSLX MetaDB API.
+# -----------------------------------------------------------------------------
+package OpenSLX::MetaDB::SQLite;
+
+use strict;
+use warnings;
+
+use base qw(OpenSLX::MetaDB::DBI);
+
+################################################################################
+### This class provides a MetaDB backend for SQLite databases.
+### - by default the db will be created inside a 'openslxdata-sqlite' directory.
+################################################################################
+use DBD::SQLite;
+use OpenSLX::Basics;
+
+################################################################################
+### implementation
+################################################################################
+sub new
+{
+    my $class = shift;
+    my $self  = {};
+    return bless $self, $class;
+}
+
+sub databaseExists
+{
+    my $self = shift;
+    
+    my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}";
+    return -e $fullDBPath;
+}
+
+sub dropDatabase
+{
+    my $self = shift;
+    
+    if ($self->{dbh}) {
+        die "need to disconnect before you can drop the database!";
+    }
+    
+    my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}";
+    system("rm -rf $fullDBPath") if -e $fullDBPath;
+}
+
+sub connect        ## no critic (ProhibitBuiltinHomonyms)
+{
+    my $self = shift;
+
+    my $dbSpec = $openslxConfig{'db-spec'};
+    if (!defined $dbSpec) {
+        # build $dbSpec from individual parameters:
+        my $dbPath = $self->_getDBPath;
+        system("mkdir -p $dbPath") unless -e $dbPath;
+        $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}";
+    }
+    vlog(1, "trying to connect to SQLite-database <$dbSpec>");
+    $self->{'dbh'} = DBI->connect(
+        "dbi:SQLite:$dbSpec", undef, undef,    
+        {PrintError => 0, AutoCommit => 1, sqlite_unicode => 1}
+    ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr);
+    return 1;
+}
+
+sub schemaRenameTable
+{
+    my $self      = shift;
+    my $oldTable  = shift;
+    my $newTable  = shift;
+    my $colDescrs = shift;
+    my $isSubCmd  = shift;
+
+    my $dbh = $self->{'dbh'};
+    vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd;
+    my $sql = "ALTER TABLE $oldTable RENAME TO $newTable";
+    vlog(3, $sql);
+    $dbh->do($sql)
+      or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr));
+    return;
+}
+
+sub schemaAddColumns
+{
+    my $self              = shift;
+    my $table             = shift;
+    my $newColDescrs      = shift;
+    my $newColDefaultVals = shift;
+    my $colDescrs         = shift;
+    my $isSubCmd          = shift;
+
+    my $dbh         = $self->{'dbh'};
+    my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs);
+    vlog(1, "adding columns <$newColNames> to table <$table>")
+      unless $isSubCmd;    
+    foreach my $colDescr (@$newColDescrs) {
+        my $colDescrString =
+          $self->_convertColDescrsToDBNativeString([$colDescr]);
+        my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString";
+        vlog(3, $sql);
+        $dbh->do($sql)
+          or croak(_tr(q[Can't add column to table <%s> (%s)], $table,
+            $dbh->errstr));
+    }
+    # if default values have been provided, we apply them now:
+    if (defined $newColDefaultVals) {
+        $self->_doUpdate($table, undef, $newColDefaultVals);
+    }
+    return;
+}
+
+sub _getDBPath
+{
+    my $self = shift;
+
+    return "$openslxConfig{'private-path'}/db/sqlite";
+}
+
+1;