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 our $SELF;
   9
  10 sub BackupInfoRead
  11 {
  12     my($self, $client) = @_;
  13
  14     # ORDER BY is important! BackupPC_dump expects list to be sorted
  15     my $cmd = "SELECT " . join(', ', @{ $self->{BackupFields} })
  16         . " FROM Backup WHERE client = '$client' ORDER BY num";
  17     my $sth = $self->{dbh}->prepare($cmd);
  18
  19     $sth->execute;
  20     my($row, @backups);
  21
  22 NUM:
  23     while ($row = $sth->fetchrow_hashref) {
  24         $backups[@backups] = { %$row };
  25     }
  26
  27     return @backups;
  28 }
  29
  30 sub BackupInfoWrite
  31 {
  32     my($self, $client, @backups) = @_;
  33
  34     #BackupPC_dump passes an array containing all backup records, so we must
  35     #1) figure out which ones aren't in the database and add them; then
  36     #2) delete records in the database that weren't passed
  37
  38     # get a hash of currently existing backup nums from database
  39     my %current = map {$_, 1}
  40         @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Backup") };
  41
  42     my %textFields = map {$_, 1} 'client', @{ $self->{BackupTextFields} };
  43
  44     my($num, $cmd, $sth);
  45
  46 NUM:
  47     foreach my $backup (@backups) {
  48         $num = $backup->{num};
  49
  50         if (defined $current{$num}) {
  51             #it's in the database as well as @backups; delete it from hash
  52             delete $current{$num};
  53
  54         } else {
  55             #it's not in database yet, so add it
  56             $cmd = "INSERT Backup (client, " . join(', ', @{ $self->{BackupFields} })
  57                 . ") VALUES ('$client', " . join(', ',
  58                 map {(defined $textFields{$_})? "'$backup->{$_}'" : $backup->{$_}}
  59                 @{ $self->{BackupFields} }) . ")";
  60
  61             $self->{dbh}->prepare($cmd)->execute;
  62         }
  63
  64     }
  65
  66     # any remaining items in %current should be discarded
  67     if (%current) {
  68         $cmd = "DELETE FROM Backup WHERE num IN (" . join(', ', sort keys %current)
  69             . ")";
  70         $self->{dbh}->prepare($cmd)->execute;
  71     }
  72
  73 }
  74
  75
  76 # See comments in "Backup" subs, above
  77 sub RestoreInfoRead
  78 {
  79     my($self, $client) = @_;
  80
  81     # ORDER BY is important! BackupPC_dump expects list to be sorted
  82     my $cmd = "SELECT " . join(', ', @{ $self->{RestoreFields} })
  83         . " FROM Restore WHERE client = '$client' ORDER BY num";
  84     my $sth = $self->{dbh}->prepare($cmd);
  85
  86     $sth->execute;
  87     my($row, @restores);
  88
  89 NUM:
  90     while ($row = $sth->fetchrow_hashref) {
  91         $restores[@restores] = { %$row };
  92     }
  93
  94     return @restores;
  95 }
  96
  97
  98 # See comments in "Backup" subs, above
  99 sub RestoreInfoWrite
 100 {
 101     my($self, $client, @restores) = @_;
 102
 103     my %current = map {$_, 1}
 104         @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Restore") };
 105
 106     my %textFields = map {$_, 1} 'client', @{ $self->{RestoreTextFields} };
 107
 108     my($num, $cmd, $sth);
 109
 110 NUM:
 111     foreach my $restore (@restores) {
 112         $num = $restore->{num};
 113
 114         if (defined $current{$num}) {
 115             delete $current{$num};
 116
 117         } else {
 118             $cmd = "INSERT Restore (client, " . join(', ', @{ $self->{RestoreFields} })
 119                 . ") VALUES ('$client', " . join(', ',
 120                 map {(defined $textFields{$_})? "'$restore->{$_}'" : $restore->{$_}}
 121                 @{ $self->{RestoreFields} }) . ")";
 122
 123             $self->{dbh}->prepare($cmd)->execute;
 124         }
 125
 126     }
 127
 128     if (%current) {
 129         $cmd = "DELETE FROM Restore WHERE num IN (" . join(', ', sort keys %current)
 130             . ")";
 131         $self->{dbh}->prepare($cmd)->execute;
 132     }
 133
 134 }
 135
 136 sub HostInfoRead {
 137     my($self, $oneClient) = @_;
 138
 139     my $cmd = "SELECT client AS host, dhcp, user, moreUsers FROM Client";
 140     my $sth = $self->{dbh}->prepare($cmd);
 141
 142     $sth->execute;
 143     my($row, $client, %clients);
 144
 145 CLIENT:
 146     while ($row = $sth->fetchrow_hashref) {
 147         $client = $row->{host};
 148
 149         if (defined $oneClient) {
 150             next CLIENT unless $oneClient eq $client;
 151             $clients{$client} = {%$row};
 152             return \%clients;
 153         }
 154
 155         $clients{$client} = {%$row};
 156     }
 157
 158     return \%clients;
 159
 160 }
 161
 162
 163 #TODO: Replace w/ Db version!!
 164 sub ConfigRead
 165 {
 166     my($self, $host) = @_;
 167     my($ret, $mesg, $config, @configs);
 168
 169     our %Conf;
 170
 171     $self->{Conf} = ();
 172     push(@configs, "$self->{TopDir}/conf/config.pl");
 173     push(@configs, "$self->{TopDir}/pc/$host/config.pl")
 174             if ( defined($host) && -f "$self->{TopDir}/pc/$host/config.pl" );
 175     foreach $config ( @configs ) {
 176         %Conf = ();
 177         if ( !defined($ret = do $config) && ($! || $@) ) {
 178             $mesg = "Couldn't open $config: $!" if ( $! );
 179             $mesg = "Couldn't execute $config: $@" if ( $@ );
 180             $mesg =~ s/[\n\r]+//;
 181             return $mesg;
 182         }
 183         %{$self->{Conf}} = ( %{$self->{Conf} || {}}, %Conf );
 184     }
 185
 186     #$mesg = $self->CheckConfigInfo;
 187     #return $mesg if $mesg;
 188
 189     return if ( !defined($self->{Conf}{Language}) );
 190
 191     my $langFile = "$self->{LibDir}/BackupPC/Lang/$self->{Conf}{Language}.pm";
 192
 193     if ( !defined($ret = do $langFile) && ($! || $@) ) {
 194         $mesg = "Couldn't open language file $langFile: $!" if ( $! );
 195         $mesg = "Couldn't execute language file $langFile: $@" if ( $@ );
 196         $mesg =~ s/[\n\r]+//;
 197         return $mesg;
 198     }
 199
 200     our %Lang;
 201     $self->{Lang} = \%Lang;
 202
 203     return;
 204 }
 205
 206 our %gConfigWriteHandler = (SCALAR      => \&_ConfigWriteScalar,
 207                             ARRAY       => \&_ConfigWriteArray,
 208                             HASH        => \&_ConfigWriteHash,
 209                             ARRAYOFHASH => \&_ConfigWriteArrayOfHash,
 210                             HASHOFARRAY => \&_ConfigWriteHashOfArray,
 211                            );
 212
 213 our %gConfigTypeField; # will be defined by database-specific Config module
 214
 215 sub ConfigWrite {
 216     my($self, $client) = @_;
 217     $SELF = $self;
 218     my $dbh = $self->{dbh};
 219
 220     $dbh->{RaiseError} = 0;
 221     my($cmd, $sth);
 222
 223     $cmd = "DELETE FROM Config WHERE client = '~~$client'";
 224     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 225     $sth->execute or return "$cmd\n". $dbh->errstr;
 226
 227     $cmd = "UPDATE Config SET client = '~~$client' WHERE client = '$client'";
 228     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 229     $sth->execute or return "$cmd\n". $dbh->errstr;
 230
 231     my($attr, $val, $def, $handler, $mesg);
 232
 233     foreach $attr (sort keys %{ $self->{Conf} }) {
 234         $val = $self->{Conf}->{$attr};
 235         $def = $self->{ConfigDef}->{$attr};
 236
 237         $handler = $gConfigWriteHandler{$def->{struct}};
 238         $mesg = &$handler($dbh, $def, $client, $attr, $val);
 239         return $mesg if $mesg;
 240     }
 241
 242
 243     $cmd = "DELETE FROM Config WHERE client = '~~$client'";
 244     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 245     $sth->execute or return "$cmd\n". $dbh->errstr;
 246
 247     $self->{dbh}->{RaiseError} = 1;
 248
 249     return;
 250 }
 251
 252 sub _ConfigWriteScalar {
 253     my($dbh, $def, $client, $attr, $val) = @_;
 254     $SELF->Debug("SCALAR $val") if $attr eq 'BackupFilesOnly';
 255     return if !defined $val;
 256
 257     my $ref = ref $val;
 258
 259     if ($ref) {
 260         return "Expected $attr to be SCALAR, but got $ref";
 261     }
 262
 263     &_WriteConfigRow($dbh, $client, $attr, -1, '', $def->{type}, $val)
 264 }
 265
 266 sub _ConfigWriteArray {
 267     my($dbh, $def, $client, $attr, $val, $key) = @_;
 268     $SELF->Debug("ARRAY $val, $key") if $attr eq 'BackupFilesOnly';
 269     return if !defined $val;
 270
 271     $key = '' unless defined $key;
 272     my $ref = ref $val;
 273
 274     if (!$ref) {
 275         #expecting ARRAY, got string -- implicit convert
 276         $val = [ $val ];
 277     } elsif ($ref ne 'ARRAY') {
 278         $attr = "$attr\{$key}" if $key ne '';
 279         return "Expected $attr to be ARRAY, but got $ref";
 280     }
 281
 282     my $subscript = 0;
 283     my $item;
 284     my $type = $def->{type};
 285
 286     foreach $item (@$val) {
 287         &_WriteConfigRow($dbh, $client, $attr, $subscript++,
 288                          $key, $type, $item)
 289     }
 290 }
 291
 292 sub _ConfigWriteHash {
 293     my($dbh, $def, $client, $attr, $val, $subscript) = @_;
 294     $SELF->Debug("HASH $val") if $attr eq 'BackupFilesOnly';
 295     return if !defined $val;
 296
 297     $subscript = -1 unless defined $subscript;
 298     my $ref = ref $val;
 299
 300     if (!$ref) {
 301         #expecting HASH, got string -- implicit convert
 302         $val = { '*' => $val };
 303     } elsif ($ref ne 'HASH') {
 304         $attr = "$attr\[$subscript]" if $subscript != -1;
 305         return "Expected $attr to be HASH, but got $ref";
 306     }
 307
 308     my($key, $item);
 309     my $type = $def->{type};
 310
 311     # If 'type' is a hash ref, this means the attribute's subvalue type
 312     # depends on what its corresponding key is. In that case, we set
 313     # $thisType for each iteration; otherwise, we leave it set to 'type'
 314     my $typeByKey = ref $type;
 315     my $thisType = $type;
 316
 317     foreach $key (sort keys %$val) {
 318         $item = $val->{$key};
 319
 320         if ($typeByKey) {
 321             $thisType = $type->{$key};
 322
 323             if (!defined $thisType) {
 324                 return "Don't know how to handle subvalue $key for $attr";
 325             }
 326         }
 327
 328         &_WriteConfigRow($dbh, $client, $attr, $subscript,
 329                          $key, $thisType, $item)
 330     }
 331 }
 332
 333 sub _ConfigWriteArrayOfHash {
 334     my($dbh, $def, $client, $attr, $val) = @_;
 335     return if !defined $val;
 336
 337     my $ref = ref $val;
 338
 339     if (!$ref) {
 340         #expecting ARRAY, got string -- implicit convert
 341         $val = [ $val ];
 342     } elsif ($ref ne 'ARRAY') {
 343         return "Expected $attr to be ARRAY, but got $ref";
 344     }
 345
 346     my $subscript = 0;
 347     my $item;
 348
 349     foreach $item (@$val) {
 350         &_ConfigWriteHash($dbh, $def, $client, $attr,
 351                           $item, $subscript++);
 352     }
 353 }
 354
 355 sub _ConfigWriteHashOfArray {
 356     my($dbh, $def, $client, $attr, $val) = @_;
 357     $SELF->Debug("HASHOFARRAY $val") if $attr eq 'BackupFilesOnly';
 358     return if !defined $val;
 359
 360     my $ref = ref $val;
 361
 362     if (!$ref) {
 363         #expecting HASH, got string -- implicit convert
 364         $val = { '*' => $val };
 365     } elsif ($ref ne 'HASH') {
 366         return "Expected $attr to be HASH, but got $ref";
 367     }
 368
 369     my($key, $item);
 370
 371     foreach $key (sort keys %$val) {
 372         $item = $val->{$key};
 373         &_ConfigWriteArray($dbh, $def, $client, $attr,
 374                            $item, $key);
 375     }
 376
 377 }
 378
 379 sub _WriteConfigRow {
 380     my($dbh, $client, $attr, $subscript, $key, $type, $val) = @_;
 381
 382     defined $gConfigTypeField{$type}
 383         or return "Unknown ConfigDef type '$type' ($attr); aborting";
 384
 385     my($confType, $field, %fields);
 386
 387     while(($confType, $field) = each %gConfigTypeField) {
 388         if ($confType eq $type) {
 389             # this is the correct field for value of interest,
 390             # so copy and format it
 391             $fields{$field} = ($confType =~ /^(STRING|MEMO)$/)?
 392                 $dbh->quote($val) : $val;
 393         } else {
 394             $fields{$field} = 'NULL';
 395         }
 396     }
 397
 398     $fields{'client'} = $dbh->quote($client);
 399     $fields{'clientGroup'} = "''"; #TODO: add group logic
 400     $fields{'attribute'} = $dbh->quote($attr);
 401     $fields{'subscript'} = $subscript;
 402     $fields{'hashKey'} = $dbh->quote($key);
 403
 404     my @fields = sort keys %fields;
 405     my @values = map { $fields{ $_ } } @fields;
 406
 407     my $cmd = "INSERT Config (" . join(', ', @fields) . ")\nVALUES ("
 408         . join(', ', @values) . ")";
 409
 410     my $sth = $dbh->prepare($cmd) or return "$cmd\n\n" . $dbh->errstr;
 411     $sth->execute or return "$cmd\n\n". $dbh->errstr;
 412
 413     return;
 414 }
 415
 416 #TODO: Replace w/ Db version!!
 417 #
 418 # Return the mtime of the config file
 419 #
 420 sub ConfigMTime
 421 {
 422     my($self) = @_;
 423     return (stat("$self->{TopDir}/conf/config.pl"))[9];
 424 }
 425
 426
 427
 428 sub DESTROY {
 429     my($self) = @_;
 430
 431     $self->{dbh}->disconnect if defined $self->{dbh};
 432 }
 433
 434
 435 1;