Add database configuration logic; minor bugfixes and code cleanup
[BackupPC.git] / lib / BackupPC / Config / Db.pm
1 package BackupPC::Config::Db;
2
3 use base 'BackupPC::Config';
4 use warnings;
5 use strict;
6
7 use DBI;
8
9 sub GetDbConnInfo
10 {
11     my($self, $dbi) = @_;
12     my($ret, $mesg, $dbConfig);
13
14     $dbConfig = "$self->{TopDir}/conf/db.pl";
15     
16     our %Db;
17     
18     if ( !defined($ret = do $dbConfig) && ($! || $@) ) {
19         $mesg = "Couldn't open $dbConfig: $!" if ( $! );
20         $mesg = "Couldn't execute $dbConfig: $@" if ( $@ );
21         $mesg =~ s/[\n\r]+//;
22         
23         $self->{errstr} = $mesg;
24         return undef;
25     }
26     
27     $Db{passwd} = $ENV{BPC_DBPASSWD} if !exists $Db{passwd};
28     
29     my %parm = %Db;
30     undef %Db;
31     
32     return %parm;
33 }
34
35 sub BackupInfoRead
36 {
37     my($self, $client) = @_;
38
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);
43
44     $sth->execute;
45     my($row, @backups);
46
47 NUM:
48     while ($row = $sth->fetchrow_hashref) {
49         $backups[@backups] = { %$row };
50     }
51
52     return @backups;
53 }
54
55 sub BackupInfoWrite
56 {
57     my($self, $client, @backups) = @_;
58     
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
62     
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") };
66         
67     my %textFields = map {$_, 1} 'client', @{ $self->{BackupTextFields} };
68     
69     my($num, $cmd, $sth);
70
71 NUM:
72     foreach my $backup (@backups) {
73         $num = $backup->{num};
74         
75         if (defined $current{$num}) {
76             #it's in the database as well as @backups; delete it from hash
77             delete $current{$num};
78             
79         } else {
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} }) . ")";
85         
86             $self->{dbh}->prepare($cmd)->execute;
87         }
88
89     }
90
91     # any remaining items in %current should be discarded
92     if (%current) {
93         $cmd = "DELETE FROM Backup WHERE num IN (" . join(', ', sort keys %current)
94             . ")";
95         $self->{dbh}->prepare($cmd)->execute;
96     }
97
98 }
99
100
101 # See comments in "Backup" subs, above
102 sub RestoreInfoRead
103 {
104     my($self, $client) = @_;
105
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);
110
111     $sth->execute;
112     my($row, @restores);
113
114 NUM:
115     while ($row = $sth->fetchrow_hashref) {
116         $restores[@restores] = { %$row };
117     }
118
119     return @restores;
120 }
121
122
123 # See comments in "Backup" subs, above
124 sub RestoreInfoWrite
125 {
126     my($self, $client, @restores) = @_;
127     
128     my %current = map {$_, 1}
129         @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Restore") };
130         
131     my %textFields = map {$_, 1} 'client', @{ $self->{RestoreTextFields} };
132     
133     my($num, $cmd, $sth);
134
135 NUM:
136     foreach my $restore (@restores) {
137         $num = $restore->{num};
138         
139         if (defined $current{$num}) {
140             delete $current{$num};
141             
142         } else {
143             $cmd = "INSERT Restore (client, " . join(', ', @{ $self->{RestoreFields} })
144                 . ") VALUES ('$client', " . join(', ',
145                 map {(defined $textFields{$_})? "'$restore->{$_}'" : $restore->{$_}}
146                 @{ $self->{RestoreFields} }) . ")";
147         
148             $self->{dbh}->prepare($cmd)->execute;
149         }
150
151     }
152
153     if (%current) {
154         $cmd = "DELETE FROM Restore WHERE num IN (" . join(', ', sort keys %current)
155             . ")";
156         $self->{dbh}->prepare($cmd)->execute;
157     }
158
159 }
160
161 sub HostInfoRead {
162     my($self, $oneClient) = @_;
163     
164     my $cmd = "SELECT client AS host, dhcp, user, moreUsers FROM Client";
165     my $sth = $self->{dbh}->prepare($cmd);
166     
167     $sth->execute;
168     my($row, $client, %clients);
169     
170 CLIENT:
171     while ($row = $sth->fetchrow_hashref) {
172         $client = $row->{host};
173     
174         if (defined $oneClient) {
175             next CLIENT unless $oneClient eq $client;
176             $clients{$client} = {%$row};
177             return \%clients;
178         }
179     
180         $clients{$client} = {%$row};
181     }
182     
183     return \%clients;
184
185 }
186
187
188 #TODO: Replace w/ Db version!!
189 sub ConfigRead
190 {
191     my($self, $host) = @_;
192     my($ret, $mesg, $config, @configs);
193     
194     our %Conf;
195
196     $self->{Conf} = ();
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 ) {
201         %Conf = ();
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]+//;
206             return $mesg;
207         }
208         %{$self->{Conf}} = ( %{$self->{Conf} || {}}, %Conf );
209     }
210     
211     #$mesg = $self->CheckConfigInfo;
212     #return $mesg if $mesg;
213     
214     return if ( !defined($self->{Conf}{Language}) );
215     
216     my $langFile = "$self->{LibDir}/BackupPC/Lang/$self->{Conf}{Language}.pm";
217     
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]+//;
222         return $mesg;
223     }
224     
225     our %Lang;
226     $self->{Lang} = \%Lang;
227     
228     return;
229 }
230
231 our %gConfigWriteHandler = (SCALAR      => \&_ConfigWriteScalar,
232                             ARRAY       => \&_ConfigWriteArray,
233                             HASH        => \&_ConfigWriteHash,
234                             ARRAYOFHASH => \&_ConfigWriteArrayOfHash,
235                             HASHOFARRAY => \&_ConfigWriteHashOfArray,
236                            );
237
238 our %gConfigTypeField; # will be defined by database-specific Config module
239
240 sub ConfigWrite {
241     my($self, $client) = @_;
242     my $dbh = $self->{dbh};
243     
244     $dbh->{RaiseError} = 0;
245     my($cmd, $sth);
246     
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;
250     
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;
254     
255     my($attr, $val, $def, $handler, $mesg);
256     
257     foreach $attr (sort keys %{ $self->{Conf} }) {
258         $val = $self->{Conf}->{$attr};
259         $def = $self->{ConfigDef}->{$attr};
260         
261         $handler = $gConfigWriteHandler{$def->{struct}};
262         $mesg = &$handler($dbh, $def, $client, $attr, $val);
263         return $mesg if $mesg;
264     }
265
266     
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;
270     
271     $self->{dbh}->{RaiseError} = 1;
272     
273     return;
274 }
275
276 sub _ConfigWriteScalar {
277     my($dbh, $def, $client, $attr, $val) = @_;
278     return if !defined $val;
279     
280     my $ref = ref $val;
281     
282     if ($ref) {
283         return "Expected $attr to be SCALAR, but got $ref";
284     }
285     
286     &_WriteConfigRow($dbh, $client, $attr, -1, '', $def->{type}, $val)
287 }
288
289 sub _ConfigWriteArray {
290     my($dbh, $def, $client, $attr, $val, $key) = @_;
291     return if !defined $val;
292
293     $key = '' unless defined $key;
294     my $ref = ref $val;
295     
296     if (!$ref) {
297         #expecting ARRAY, got string -- implicit convert
298         $val = [ $val ];
299     } elsif ($ref ne 'ARRAY') {
300         $attr = "$attr\{$key}" if $key ne '';
301         return "Expected $attr to be ARRAY, but got $ref";
302     }
303     
304     my $subscript = 0;
305     my $item;
306     my $type = $def->{type};
307     
308     foreach $item (@$val) {
309         &_WriteConfigRow($dbh, $client, $attr, $subscript++,
310                          $key, $type, $item)
311     }
312 }
313
314 sub _ConfigWriteHash {
315     my($dbh, $def, $client, $attr, $val, $subscript) = @_;
316     return if !defined $val;
317
318     $subscript = -1 unless defined $subscript;
319     my $ref = ref $val;
320     
321     if (!$ref) {
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";
327     }
328     
329     my($key, $item);
330     my $type = $def->{type};
331     
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;
337     
338     foreach $key (sort keys %$val) {
339         $item = $val->{$key};
340         
341         if ($typeByKey) {
342             $thisType = $type->{$key};
343             
344             if (!defined $thisType) {
345                 return "Don't know how to handle subvalue $key for $attr";
346             }
347         }
348         
349         &_WriteConfigRow($dbh, $client, $attr, $subscript,
350                          $key, $thisType, $item)
351     }
352 }
353
354 sub _ConfigWriteArrayOfHash {
355     my($dbh, $def, $client, $attr, $val) = @_;
356     return if !defined $val;
357
358     my $ref = ref $val;
359     
360     if (!$ref) {
361         #expecting ARRAY, got string -- implicit convert
362         $val = [ $val ];
363     } elsif ($ref ne 'ARRAY') {
364         return "Expected $attr to be ARRAY, but got $ref";
365     }
366     
367     my $subscript = 0;
368     my $item;
369     
370     foreach $item (@$val) {
371         &_ConfigWriteHash($dbh, $def, $client, $attr,
372                           $item, $subscript++);
373     }
374 }
375
376 sub _ConfigWriteHashOfArray {
377     my($dbh, $def, $client, $attr, $val) = @_;
378     return if !defined $val;
379
380     my $ref = ref $val;
381     
382     if (!$ref) {
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";
387     }
388     
389     my($key, $item);
390     
391     foreach $key (sort keys %$val) {
392         $item = $val->{$key};
393         &_ConfigWriteArray($dbh, $def, $client, $attr,
394                            $item, $key);
395     }
396     
397 }
398
399 sub _WriteConfigRow {
400     my($dbh, $client, $attr, $subscript, $key, $type, $val) = @_;
401     
402     defined $gConfigTypeField{$type}
403         or return "Unknown ConfigDef type '$type' ($attr); aborting";
404         
405     my($confType, $field, %fields);
406     
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;
413         } else {
414             $fields{$field} = 'NULL';
415         }
416     }
417     
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);
423     
424     my @fields = sort keys %fields;
425     my @values = map { $fields{ $_ } } @fields;
426     
427     my $cmd = "INSERT Config (" . join(', ', @fields) . ")\nVALUES ("
428         . join(', ', @values) . ")";
429     
430     my $sth = $dbh->prepare($cmd) or return "$cmd\n\n" . $dbh->errstr;
431     $sth->execute or return "$cmd\n\n". $dbh->errstr;
432
433     return;
434 }
435
436 #TODO: Replace w/ Db version!!
437 #
438 # Return the mtime of the config file
439 #
440 sub ConfigMTime
441 {
442     my($self) = @_;
443     return (stat("$self->{TopDir}/conf/config.pl"))[9];
444 }
445
446
447
448 sub DESTROY {
449     my($self) = @_;
450
451     $self->{dbh}->disconnect if defined $self->{dbh};
452 }
453
454
455 1;