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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
# 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/
# -----------------------------------------------------------------------------
# CSV.pm
# - provides CSV-specific overrides of the OpenSLX MetaDB API.
# -----------------------------------------------------------------------------
package OpenSLX::MetaDB::CSV;
use vars qw(@ISA $VERSION);
@ISA = ('OpenSLX::MetaDB::DBI');
$VERSION = 1.01; # API-version . implementation-version
################################################################################
### This class provides a MetaDB backend for CSV files (CSV = comma separated
### files).
### - 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 OpenSLX::Basics;
use OpenSLX::MetaDB::DBI $VERSION;
my $superVersion = $OpenSLX::MetaDB::DBI::VERSION;
if ($superVersion < $VERSION) {
confess _tr('Unable to load module <%s> (Version <%s> required, but <%s> found)',
'OpenSLX::MetaDB::DBI', $VERSION, $superVersion);
}
################################################################################
### 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{'db-basepath'};
my $dbDatadir = $openslxConfig{'db-datadir'}
|| "$openslxConfig{'db-name'}-csv";
my $dbPath = "$dbBasepath/$dbDatadir";
if (!-e $dbPath) {
mkdir $dbPath
or die _tr("unable to create db-datadir %s! (%s)\n",
$dbPath, $!);
}
$dbSpec = "f_dir=$dbPath;csv_eol=\n;";
}
vlog 1, "trying to connect to CSV-database <$dbSpec>";
eval ('require DBD::CSV; 1;')
or die _tr(qq[%s doesn't seem to be installed,
so there is no support for %s available, sorry!\n], 'DBI::CSV', 'CSV');
$self->{'dbh'} = DBI->connect("dbi:CSV:$dbSpec", undef, undef,
{PrintError => 0})
or confess _tr("Cannot connect to database <%s> (%s)",
$dbSpec, $DBI::errstr);
}
sub quote
{ # DBD::CSV has a buggy quoting mechanism which can't cope with backslashes
# so we reimplement the quoting ourselves...
my $self = shift;
my $val = shift;
$val =~ s[(['])][\\$1]go;
return "'$val'";
}
sub generateNextIdForTable
{ # CSV doesn't provide any mechanism to generate IDs, we just...
my $self = shift;
my $table = shift;
return 1 unless defined $table;
# now fetch the next ID from a table-specific file:
my $dbh = $self->{'dbh'};
my $idFile = "$dbh->{'f_dir'}/id-$table";
sysopen(IDFILE, $idFile, O_RDWR|O_CREAT)
or confess _tr(q[Can't open ID-file <%s> (%s)], $idFile, $!);
flock(IDFILE, LOCK_EX)
or confess _tr(q[Can't lock ID-file <%s> (%s)], $idFile, $!);
my $nextID = <IDFILE>;
if (!$nextID) {
# no ID information available, we protect against users having
# deleted the ID-file by fetching the highest ID from the DB:
$nextID = 1+$self->_doSelect("SELECT max(id) AS id FROM $table", 'id');
}
seek(IDFILE, 0, 0)
or confess _tr(q[Can't to seek ID-file <%s> (%s)], $idFile, $!);
truncate(IDFILE, 0)
or confess _tr(q[Can't truncate ID-file <%s> (%s)], $idFile, $!);
print IDFILE $nextID+1
or confess _tr(q[Can't update ID-file <%s> (%s)], $idFile, $!);
close(IDFILE);
return $nextID;
}
sub schemaDeclareTable
{ # explicitly set file name for each table such that it makes
# use of '.csv'-extension
my $self = shift;
my $table = shift;
my $dbh = $self->{'dbh'};
$dbh->{'csv_tables'}->{"$table"} = { 'file' => "${table}.csv"};
}
sub schemaRenameTable
{ # renames corresponding id-file after renaming the table
my $self = shift;
my $oldTable = shift;
my $newTable = shift;
$self->schemaDeclareTable($newTable);
$self->SUPER::schemaRenameTable($oldTable, $newTable, @_);
my $dbh = $self->{'dbh'};
rename "$dbh->{'f_dir'}/id-$oldTable", "$dbh->{'f_dir'}/id-$newTable";
}
sub schemaDropTable
{ # removes corresponding id-file after dropping the table
my $self = shift;
my $table = shift;
$self->SUPER::schemaDropTable($table, @_);
my $dbh = $self->{'dbh'};
unlink "$dbh->{'f_dir'}/id-$table";
}
1;
|
