1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
# 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 vars qw($VERSION);
$VERSION = 1.01; # API-version . implementation-version
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
################################################################################
sub new
{
my $class = shift;
my $self = {};
return bless $self, $class;
}
sub connect
{
my $self = shift;
my $dbSpec = $openslxConfig{'db-spec'};
if (!defined $dbSpec) {
# build $dbSpec from individual parameters:
my $dbBasepath = "$openslxConfig{'private-path'}/db";
my $dbDatadir = 'sqlite';
my $dbPath = "$dbBasepath/$dbDatadir";
system("mkdir -p $dbPath") unless -e $dbPath;
$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);
}
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 confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr);
}
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 confess _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);
}
}
1;
|
