1 package BackupPC::Config::Db;
3 use base 'BackupPC::Config';
12 my($ret, $mesg, $dbConfig);
14 $dbConfig = "$self->{TopDir}/conf/db.pl";
18 if ( !defined($ret = do $dbConfig) && ($! || $@) ) {
19 $mesg = "Couldn't open $dbConfig: $!" if ( $! );
20 $mesg = "Couldn't execute $dbConfig: $@" if ( $@ );
23 $self->{errstr} = $mesg;
27 $Db{passwd} = $ENV{BPC_DBPASSWD} if !exists $Db{passwd};
37 my($self, $client) = @_;
39 # ORDER BY is important! BackupPC_dump expects list to be sorted
40 my $cmd = "SELECT " . join(', ', @{ $self->{BackupFields} })
41 . " FROM Backup WHERE client = '$client' ORDER BY num";
42 my $sth = $self->{dbh}->prepare($cmd);
48 while ($row = $sth->fetchrow_hashref) {
49 $backups[@backups] = { %$row };
57 my($self, $client, @backups) = @_;
59 #BackupPC_dump passes an array containing all backup records, so we must
60 #1) figure out which ones aren't in the database and add them; then
61 #2) delete records in the database that weren't passed
63 # get a hash of currently existing backup nums from database
64 my %current = map {$_, 1}
65 @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Backup") };
67 my %textFields = map {$_, 1} 'client', @{ $self->{BackupTextFields} };
72 foreach my $backup (@backups) {
73 $num = $backup->{num};
75 if (defined $current{$num}) {
76 #it's in the database as well as @backups; delete it from hash
77 delete $current{$num};
80 #it's not in database yet, so add it
81 $cmd = "INSERT Backup (client, " . join(', ', @{ $self->{BackupFields} })
82 . ") VALUES ('$client', " . join(', ',
83 map {(defined $textFields{$_})? "'$backup->{$_}'" : $backup->{$_}}
84 @{ $self->{BackupFields} }) . ")";
86 $self->{dbh}->prepare($cmd)->execute;
91 # any remaining items in %current should be discarded
93 $cmd = "DELETE FROM Backup WHERE num IN (" . join(', ', sort keys %current)
95 $self->{dbh}->prepare($cmd)->execute;
101 # See comments in "Backup" subs, above
104 my($self, $client) = @_;
106 # ORDER BY is important! BackupPC_dump expects list to be sorted
107 my $cmd = "SELECT " . join(', ', @{ $self->{RestoreFields} })
108 . " FROM Restore WHERE client = '$client' ORDER BY num";
109 my $sth = $self->{dbh}->prepare($cmd);
115 while ($row = $sth->fetchrow_hashref) {
116 $restores[@restores] = { %$row };
123 # See comments in "Backup" subs, above
126 my($self, $client, @restores) = @_;
128 my %current = map {$_, 1}
129 @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Restore") };
131 my %textFields = map {$_, 1} 'client', @{ $self->{RestoreTextFields} };
133 my($num, $cmd, $sth);
136 foreach my $restore (@restores) {
137 $num = $restore->{num};
139 if (defined $current{$num}) {
140 delete $current{$num};
143 $cmd = "INSERT Restore (client, " . join(', ', @{ $self->{RestoreFields} })
144 . ") VALUES ('$client', " . join(', ',
145 map {(defined $textFields{$_})? "'$restore->{$_}'" : $restore->{$_}}
146 @{ $self->{RestoreFields} }) . ")";
148 $self->{dbh}->prepare($cmd)->execute;
154 $cmd = "DELETE FROM Restore WHERE num IN (" . join(', ', sort keys %current)
156 $self->{dbh}->prepare($cmd)->execute;
162 my($self, $oneClient) = @_;
164 my $cmd = "SELECT client AS host, dhcp, user, moreUsers FROM Client";
165 my $sth = $self->{dbh}->prepare($cmd);
168 my($row, $client, %clients);
171 while ($row = $sth->fetchrow_hashref) {
172 $client = $row->{host};
174 if (defined $oneClient) {
175 next CLIENT unless $oneClient eq $client;
176 $clients{$client} = {%$row};
180 $clients{$client} = {%$row};
188 #TODO: Replace w/ Db version!!
191 my($self, $host) = @_;
192 my($ret, $mesg, $config, @configs);
197 push(@configs, "$self->{TopDir}/conf/config.pl");
198 push(@configs, "$self->{TopDir}/pc/$host/config.pl")
199 if ( defined($host) && -f "$self->{TopDir}/pc/$host/config.pl" );
200 foreach $config ( @configs ) {
202 if ( !defined($ret = do $config) && ($! || $@) ) {
203 $mesg = "Couldn't open $config: $!" if ( $! );
204 $mesg = "Couldn't execute $config: $@" if ( $@ );
205 $mesg =~ s/[\n\r]+//;
208 %{$self->{Conf}} = ( %{$self->{Conf} || {}}, %Conf );
211 #$mesg = $self->CheckConfigInfo;
212 #return $mesg if $mesg;
214 return if ( !defined($self->{Conf}{Language}) );
216 my $langFile = "$self->{LibDir}/BackupPC/Lang/$self->{Conf}{Language}.pm";
218 if ( !defined($ret = do $langFile) && ($! || $@) ) {
219 $mesg = "Couldn't open language file $langFile: $!" if ( $! );
220 $mesg = "Couldn't execute language file $langFile: $@" if ( $@ );
221 $mesg =~ s/[\n\r]+//;
226 $self->{Lang} = \%Lang;
231 our %gConfigWriteHandler = (SCALAR => \&_ConfigWriteScalar,
232 ARRAY => \&_ConfigWriteArray,
233 HASH => \&_ConfigWriteHash,
234 ARRAYOFHASH => \&_ConfigWriteArrayOfHash,
235 HASHOFARRAY => \&_ConfigWriteHashOfArray,
238 our %gConfigTypeField; # will be defined by database-specific Config module
241 my($self, $client) = @_;
242 my $dbh = $self->{dbh};
244 $dbh->{RaiseError} = 0;
247 $cmd = "DELETE FROM Config WHERE client = '~~$client'";
248 $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
249 $sth->execute or return "$cmd\n". $dbh->errstr;
251 $cmd = "UPDATE Config SET client = '~~$client' WHERE client = '$client'";
252 $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
253 $sth->execute or return "$cmd\n". $dbh->errstr;
255 my($attr, $val, $def, $handler, $mesg);
257 foreach $attr (sort keys %{ $self->{Conf} }) {
258 $val = $self->{Conf}->{$attr};
259 $def = $self->{ConfigDef}->{$attr};
261 $handler = $gConfigWriteHandler{$def->{struct}};
262 $mesg = &$handler($dbh, $def, $client, $attr, $val);
263 return $mesg if $mesg;
267 $cmd = "DELETE FROM Config WHERE client = '~~$client'";
268 $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
269 $sth->execute or return "$cmd\n". $dbh->errstr;
271 $self->{dbh}->{RaiseError} = 1;
276 sub _ConfigWriteScalar {
277 my($dbh, $def, $client, $attr, $val) = @_;
278 return if !defined $val;
283 return "Expected $attr to be SCALAR, but got $ref";
286 &_WriteConfigRow($dbh, $client, $attr, -1, '', $def->{type}, $val)
289 sub _ConfigWriteArray {
290 my($dbh, $def, $client, $attr, $val, $key) = @_;
291 return if !defined $val;
293 $key = '' unless defined $key;
297 #expecting ARRAY, got string -- implicit convert
299 } elsif ($ref ne 'ARRAY') {
300 $attr = "$attr\{$key}" if $key ne '';
301 return "Expected $attr to be ARRAY, but got $ref";
306 my $type = $def->{type};
308 foreach $item (@$val) {
309 &_WriteConfigRow($dbh, $client, $attr, $subscript++,
314 sub _ConfigWriteHash {
315 my($dbh, $def, $client, $attr, $val, $subscript) = @_;
316 return if !defined $val;
318 $subscript = -1 unless defined $subscript;
322 #expecting HASH, got string -- implicit convert
323 $val = { '*' => $val };
324 } elsif ($ref ne 'HASH') {
325 $attr = "$attr\[$subscript]" if $subscript != -1;
326 return "Expected $attr to be HASH, but got $ref";
330 my $type = $def->{type};
332 # If 'type' is a hash ref, this means the attribute's subvalue type
333 # depends on what its corresponding key is. In that case, we set
334 # $thisType for each iteration; otherwise, we leave it set to 'type'
335 my $typeByKey = ref $type;
336 my $thisType = $type;
338 foreach $key (sort keys %$val) {
339 $item = $val->{$key};
342 $thisType = $type->{$key};
344 if (!defined $thisType) {
345 return "Don't know how to handle subvalue $key for $attr";
349 &_WriteConfigRow($dbh, $client, $attr, $subscript,
350 $key, $thisType, $item)
354 sub _ConfigWriteArrayOfHash {
355 my($dbh, $def, $client, $attr, $val) = @_;
356 return if !defined $val;
361 #expecting ARRAY, got string -- implicit convert
363 } elsif ($ref ne 'ARRAY') {
364 return "Expected $attr to be ARRAY, but got $ref";
370 foreach $item (@$val) {
371 &_ConfigWriteHash($dbh, $def, $client, $attr,
372 $item, $subscript++);
376 sub _ConfigWriteHashOfArray {
377 my($dbh, $def, $client, $attr, $val) = @_;
378 return if !defined $val;
383 #expecting HASH, got string -- implicit convert
384 $val = { '*' => $val };
385 } elsif ($ref ne 'HASH') {
386 return "Expected $attr to be HASH, but got $ref";
391 foreach $key (sort keys %$val) {
392 $item = $val->{$key};
393 &_ConfigWriteArray($dbh, $def, $client, $attr,
399 sub _WriteConfigRow {
400 my($dbh, $client, $attr, $subscript, $key, $type, $val) = @_;
402 defined $gConfigTypeField{$type}
403 or return "Unknown ConfigDef type '$type' ($attr); aborting";
405 my($confType, $field, %fields);
407 while(($confType, $field) = each %gConfigTypeField) {
408 if ($confType eq $type) {
409 # this is the correct field for value of interest,
410 # so copy and format it
411 $fields{$field} = ($confType =~ /^(STRING|MEMO)$/)?
412 $dbh->quote($val) : $val;
414 $fields{$field} = 'NULL';
418 $fields{'client'} = $dbh->quote($client);
419 $fields{'clientGroup'} = "''"; #TODO: add group logic
420 $fields{'attribute'} = $dbh->quote($attr);
421 $fields{'subscript'} = $subscript;
422 $fields{'hashKey'} = $dbh->quote($key);
424 my @fields = sort keys %fields;
425 my @values = map { $fields{ $_ } } @fields;
427 my $cmd = "INSERT Config (" . join(', ', @fields) . ")\nVALUES ("
428 . join(', ', @values) . ")";
430 my $sth = $dbh->prepare($cmd) or return "$cmd\n\n" . $dbh->errstr;
431 $sth->execute or return "$cmd\n\n". $dbh->errstr;
436 #TODO: Replace w/ Db version!!
438 # Return the mtime of the config file
443 return (stat("$self->{TopDir}/conf/config.pl"))[9];
451 $self->{dbh}->disconnect if defined $self->{dbh};