clearadm/lib/Clearadm.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Clearadm.pm,v $
   4
   5 Object oriented interface to Clearadm.
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.54 $
  18
  19 =item Created
  20
  21 Tue Dec 07 09:13:27 EST 2010
  22
  23 =item Modified
  24
  25 $Date: 2012/11/09 06:43:26 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides the Clearadm object which handles all interaction with the Clearadm
  32 database. Similar add/change/delete/update methods for other record types. In
  33 general you must orient your record hashs to have the appropriately named
  34 keys that correspond to the database. Also see mothod documentation for
  35 specifics about the method you are envoking.
  36
  37  # Create new Clearadm object
  38  my $clearadm = new Clearadm;
  39
  40  # Add a new system
  41  my %system =(
  42   name          => 'jupiter',
  43   alias         => 'defaria.com',
  44   admin         => 'Andrew DeFaria',
  45   os            => 'Linux defaria.com 2.6.32-25-generic-pae #45-Ubuntu SMP Sat Oct 16 21:01:33 UTC 2010 i686 GNU/Linux',
  46   type          => 'Linux',
  47   description   => 'Home server',
  48  );
  49
  50  my ($err, $msg) = $clearadm->AddSystem(%system);
  51
  52  # Find systems matching 'jup'
  53  my @systems = $clearadm->FindSystem('jup');
  54
  55  # Get a system by name
  56  my %system = $clearadm->GetSystem('jupiter');
  57
  58  # Update system
  59  my %update = (
  60   'region' => 'East Coast',
  61  );
  62
  63  my ($err, $msg) = $clearadm->UpdateSystem ('jupiter', %update);
  64
  65  # Delete system (Warning: will delete all related records regarding this
  66  # system).
  67  my ($err, $msg) = $clearadm->DeleteSystem('jupiter');
  68
  69 =head1 DESCRIPTION
  70
  71 This package provides and object oriented interface to the Clearadm database.
  72 Methods are provided to manipulate records by adding, updating and deleting
  73 them. In general you need to specify a hash which contains keys and values
  74 corresponding to the database field names and values.
  75
  76 =head1 ROUTINES
  77
  78 The following methods are available:
  79
  80 =cut
  81
  82 package Clearadm;
  83
  84 use strict;
  85 use warnings;
  86
  87 use Carp;
  88 use DBI;
  89 use File::Basename;
  90 use Net::Domain qw(hostdomain);
  91 use Sys::Hostname;
  92
  93 use FindBin;
  94
  95 use lib "$FindBin::Bin", "$FindBin::Bin/../../lib";
  96
  97 use DateUtils;
  98 use Display;
  99 use GetConfig;
 100 use Mail;
 101 use Clearcase::Vob;
 102 use Clearcase::View;
 103
 104 my $conf = dirname(__FILE__) . '/../etc/clearadm.conf';
 105
 106 our %CLEAROPTS = GetConfig($conf);
 107
 108 # Globals
 109 our $VERSION  = '$Revision: 1.54 $';
 110    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
 111
 112 $CLEAROPTS{CLEARADM_USERNAME} = $ENV{CLEARADM_USERNAME}
 113                               ? $ENV{CLEARADM_USERNAME}
 114                               : $CLEAROPTS{CLEARADM_USERNAME}
 115                               ? $CLEAROPTS{CLEARADM_USERNAME}
 116                               : 'clearwriter';
 117 $CLEAROPTS{CLEARADM_PASSWORD} = $ENV{CLEARADM_PASSWORD}
 118                               ? $ENV{CLEARADM_PASSWORD}
 119                               : $CLEAROPTS{CLEARADM_PASSWORD}
 120                               ? $CLEAROPTS{CLEARADM_PASSWORD}
 121                               : 'clearwriter';
 122 $CLEAROPTS{CLEARADM_SERVER}   = $ENV{CLEARADM_SERVER}
 123                               ? $ENV{CLEARADM_SERVER}
 124                               : $CLEAROPTS{CLEARADM_SERVER}
 125                               ? $CLEAROPTS{CLEARADM_SERVER}
 126                               : 'localhost';
 127
 128 my $defaultFilesystemThreshold = 90;
 129 my $defaultFilesystemHist      = '6 months';
 130 my $defaultLoadavgHist         = '6 months';
 131
 132 # Internal methods
 133 sub _dberror($$) {
 134   my ($self, $msg, $statement) = @_;
 135
 136   my $dberr    = $self->{db}->err;
 137   my $dberrmsg = $self->{db}->errstr;
 138
 139   $dberr    ||= 0;
 140   $dberrmsg ||= 'Success';
 141
 142   my $message = '';
 143
 144   if ($dberr) {
 145     my $function = (caller(1)) [3];
 146
 147     $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
 148              . "SQL Statement: $statement";
 149   } # if
 150
 151   return $dberr, $message;
 152 } # _dberror
 153
 154 sub _formatValues(@) {
 155   my ($self, @values) = @_;
 156
 157   my @returnValues;
 158
 159   # Quote data values
 160   push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote($_) for (@values);
 161
 162   return @returnValues;
 163 } # _formatValues
 164
 165 sub _formatNameValues(%) {
 166   my ($self, %rec) = @_;
 167
 168   my @nameValueStrs;
 169
 170   push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_}) for (keys %rec);
 171
 172   return @nameValueStrs;
 173 } # _formatNameValues
 174
 175 sub _addRecord($%) {
 176   my ($self, $table, %rec) = @_;
 177
 178   my $statement  = "insert into $table (";
 179      $statement .= join ',', keys %rec;
 180      $statement .= ') values (';
 181      $statement .= join ',', $self->_formatValues(values %rec);
 182      $statement .= ')';
 183
 184   my ($err, $msg);
 185
 186   $self->{db}->do($statement);
 187
 188   return $self->_dberror("Unable to add record to $table", $statement);
 189 } # _addRecord
 190
 191 sub _deleteRecord($;$) {
 192   my ($self, $table, $condition) = @_;
 193
 194   my $count;
 195
 196   my $statement  = "select count(*) from $table ";
 197      $statement .= "where $condition" if $condition;
 198
 199   my $sth = $self->{db}->prepare($statement)
 200     or return $self->_dberror('Unable to prepare statement', $statement);
 201
 202   $sth->execute
 203     or return $self->_dberror('Unable to execute statement', $statement);
 204
 205   my @row = $sth->fetchrow_array;
 206
 207   $sth->finish;
 208
 209   if ($row[0]) {
 210     $count = $row[0];
 211   } else {
 212     $count = 0;
 213   } # if
 214
 215   return ($count, 'Records deleted') if $count == 0;
 216
 217   $statement  = "delete from $table ";
 218   $statement .= "where $condition" if $condition;
 219
 220   $self->{db}->do($statement);
 221
 222   if ($self->{db}->err) {
 223     return $self->_dberror("Unable to delete record from $table", $statement);
 224   } else {
 225     return $count, 'Records deleted';
 226   } # if
 227 } # _deleteRecord
 228
 229 sub _updateRecord($$%) {
 230   my ($self, $table, $condition, %rec) = @_;
 231
 232   my $statement  = "update $table set ";
 233      $statement .= join ',', $self->_formatNameValues(%rec);
 234      $statement .= " where $condition" if $condition;
 235
 236   $self->{db}->do($statement);
 237
 238   return $self->_dberror("Unable to update record in $table", $statement);
 239 } # _updateRecord
 240
 241 sub _checkRequiredFields($$) {
 242   my ($fields, $rec) = @_;
 243
 244   for my $fieldname (@$fields) {
 245     my $found = 0;
 246
 247     for (keys %$rec) {
 248       if ($fieldname eq $_) {
 249          $found = 1;
 250          last;
 251       } # if
 252     } # for
 253
 254     return "$fieldname is required" unless $found;
 255   } # for
 256
 257   return;
 258 } # _checkRequiredFields
 259
 260 sub _getRecords($$;$) {
 261   my ($self, $table, $condition, $additional) = @_;
 262
 263   my ($err, $msg);
 264
 265   $additional ||= '';
 266
 267   my $statement  = "select * from $table";
 268      $statement .= " where $condition" if $condition;
 269      $statement .= $additional;
 270
 271   my $sth = $self->{db}->prepare($statement);
 272
 273   unless ($sth) {
 274     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
 275
 276     croak $msg;
 277   } # if
 278
 279   my $attempts    = 0;
 280   my $maxAttempts = 3;
 281   my $sleepTime   = 30;
 282   my $status;
 283
 284   # We've been having the server going away. Supposedly it should reconnect so
 285   # here we simply retry up to $maxAttempts times to re-execute the statement.
 286   # (Are there other places where we need to do this?)
 287   $err = 2006;
 288
 289   while ($err == 2006 and $attempts++ < $maxAttempts) {
 290     $status = $sth->execute;
 291
 292     if ($status) {
 293       $err = 0;
 294       last;
 295     } else {
 296       ($err, $msg) = $self->_dberror('Unable to execute statement',
 297                                       $statement);
 298     } # if
 299
 300     last if $err == 0;
 301
 302     croak $msg unless $err == 2006;
 303
 304     my $timestamp = YMDHMS;
 305
 306     $self->Error("$timestamp: Unable to talk to DB server.\n\n$msg\n\n"
 307                 . "Will try again in $sleepTime seconds", -1);
 308
 309     # Try to reconnect
 310     $self->_connect($self->{dbserver});
 311
 312     sleep $sleepTime;
 313   } # while
 314
 315   $self->Error("After $maxAttempts attempts I could not connect to the database", $err)
 316     if ($err == 2006 and $attempts > $maxAttempts);
 317
 318   my @records;
 319
 320   while (my $row = $sth->fetchrow_hashref) {
 321     push @records, $row;
 322   } # while
 323
 324   return @records;
 325 } # _getRecords
 326
 327 sub _aliasSystem($) {
 328   my ($self, $system) = @_;
 329
 330   my %system = $self->GetSystem($system);
 331
 332   if ($system{name}) {
 333     return $system{name};
 334   } else {
 335     return;
 336   } # if
 337 } # _aliasSystem
 338
 339 sub _getLastID() {
 340   my ($self) = @_;
 341
 342   my $statement = 'select last_insert_id()';
 343
 344   my $sth = $self->{db}->prepare($statement);
 345
 346   my ($err, $msg);
 347
 348   unless ($sth) {
 349     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
 350
 351     croak $msg;
 352   } # if
 353
 354   my $status = $sth->execute;
 355
 356   unless ($status) {
 357     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
 358
 359     croak $msg;
 360   } # if
 361
 362   my @records;
 363
 364   my @row = $sth->fetchrow_array;
 365
 366   return $row[0];
 367 } # _getLastID
 368
 369 sub _connect(;$) {
 370   my ($self, $dbserver) = @_;
 371
 372   $dbserver ||= $CLEAROPTS{CLEARADM_SERVER};
 373
 374   my $dbname   = 'clearadm';
 375   my $dbdriver = 'mysql';
 376
 377   $self->{db} = DBI->connect(
 378     "DBI:$dbdriver:$dbname:$dbserver",
 379     $CLEAROPTS{CLEARADM_USERNAME},
 380     $CLEAROPTS{CLEARADM_PASSWORD},
 381     {PrintError => 0},
 382   ) or croak(
 383     "Couldn't connect to $dbname database "
 384   . "as $CLEAROPTS{CLEARADM_USERNAME}\@$CLEAROPTS{CLEARADM_SERVER}"
 385   );
 386
 387   $self->{dbserver} = $dbserver;
 388
 389   return;
 390 } # _connect
 391
 392 sub new(;$) {
 393   my ($class, $dbserver) = @_;
 394
 395   my $self = bless {}, $class;
 396
 397   $self->_connect($dbserver);
 398
 399   return $self;
 400 } # new
 401
 402 sub SetNotify() {
 403   my ($self) = @_;
 404
 405   $self->{NOTIFY} = $CLEAROPTS{CLEARADM_NOTIFY};
 406
 407   return;
 408 } # SetNotify
 409
 410 sub Error($;$) {
 411   my ($self, $msg, $errno) = @_;
 412
 413   # If $errno is specified we need to stop. However we need to notify somebody
 414   # that cleartasks is no longer running.
 415   error $msg;
 416
 417   if ($errno) {
 418     if ($self->{NOTIFY}) {
 419       mail(
 420         to      => $self->{NOTIFY},
 421         subject => 'Internal error occurred in Clearadm',
 422         data    => "<p>An unexpected, internal error occurred in Clearadm:</p><p>$msg</p>",
 423         mode    => 'html',
 424       );
 425
 426       exit $errno  if $errno > 0;
 427     } # if
 428   } # if
 429
 430   return;
 431 } # Error
 432
 433 sub AddSystem(%) {
 434   my ($self, %system) = @_;
 435
 436   my @requiredFields = (
 437     'name',
 438   );
 439
 440   my $result = _checkRequiredFields \@requiredFields, \%system;
 441
 442   return -1, "AddSystem: $result" if $result;
 443
 444   $system{loadavgHist} ||= $defaultLoadavgHist;
 445
 446   return $self->_addRecord('system', %system);
 447 } # AddSystem
 448
 449 sub DeleteSystem($) {
 450   my ($self, $name) = @_;
 451
 452   return $self->_deleteRecord('system', "name='$name'");
 453 } # DeleteSystem
 454
 455 sub UpdateSystem ($%) {
 456   my ($self, $name, %update) = @_;
 457
 458   return $self->_updateRecord('system', "name='$name'", %update);
 459 } # UpdateSystem
 460
 461 sub GetSystem($) {
 462   my ($self, $system) = @_;
 463
 464   return unless $system;
 465
 466   my @records = $self->_getRecords(
 467     'system',
 468     "name='$system' or alias like '%$system%'"
 469   );
 470
 471   if ($records[0]) {
 472     return %{$records[0]};
 473   } else {
 474     return;
 475   } # if
 476 } # GetSystem
 477
 478 sub FindSystem(;$) {
 479   my ($self, $system) = @_;
 480
 481   $system ||= '';
 482
 483   my $condition = "name like '%$system%' or alias like '%$system%'";
 484
 485   return $self->_getRecords('system', $condition);
 486 } # FindSystem
 487
 488 sub SearchSystem(;$) {\r
 489   my ($self, $condition) = @_;
 490
 491   $condition = "name like '%'" unless $condition;
 492
 493   return $self->_getRecords('system', $condition);\r
 494 } # SearchSystem
 495
 496 sub AddPackage(%) {
 497   my ($self, %package) = @_;
 498
 499   my @requiredFields = (
 500     'system',
 501     'name',
 502     'version'
 503   );
 504
 505   my $result = _checkRequiredFields \@requiredFields, \%package;
 506
 507   return -1, "AddPackage: $result" if $result;
 508
 509   return $self->_addRecord('package', %package);
 510 } # AddPackage
 511
 512 sub DeletePackage($$) {
 513   my ($self, $system, $name) = @_;
 514
 515   return $self->_deleteRecord(
 516     'package',
 517     "(system='$system' or alias='$system') and name='$name'");
 518 } # DeletePackage
 519
 520 sub UpdatePackage($$%) {
 521   my ($self, $system, $name, %update) = @_;
 522
 523   $system = $self->_aliasSystem($system);
 524
 525   return unless $system;
 526
 527   return $self->_updateRecord('package', "system='$system'", %update);
 528 } # UpdatePackage
 529
 530 sub GetPackage($$) {
 531   my ($self, $system, $name) = @_;
 532
 533   $system = $self->_aliasSystem($system);
 534
 535   return unless $system;
 536   return unless $name;
 537
 538   my @records = $self->_getRecords(
 539     'package',
 540     "system='$system' and name='$name'"
 541   );
 542
 543   if ($records[0]) {
 544     return %{$records[0]};
 545   } else {
 546     return;
 547   } # if
 548 } # GetPackage
 549
 550 sub FindPackage($;$) {
 551   my ($self, $system, $name) = @_;
 552
 553   $name ||= '';
 554
 555   $system = $self->_aliasSystem($system);
 556
 557   return unless $system;
 558
 559   my $condition = "system='$system' and name like '%$name%'";
 560
 561   return $self->_getRecords('package', $condition);
 562 } # FindPackage
 563
 564 sub AddFilesystem(%) {
 565   my ($self, %filesystem) = @_;
 566
 567   my @requiredFields = (
 568     'system',
 569     'filesystem',
 570     'fstype'
 571   );
 572
 573   my $result = _checkRequiredFields \@requiredFields, \%filesystem;
 574
 575   return -1, "AddFilesystem: $result" if $result;
 576
 577   # Default filesystem threshold
 578   $filesystem{threshold} ||= $defaultFilesystemThreshold;
 579
 580   return $self->_addRecord('filesystem', %filesystem);
 581 } # AddFilesystem
 582
 583 sub DeleteFilesystem($$) {
 584   my ($self, $system, $filesystem) = @_;
 585
 586   $system = $self->_aliasSystem($system);
 587
 588   return unless $system;
 589
 590   return $self->_deleteRecord(
 591     'filesystem',
 592     "system='$system' and filesystem='$filesystem'"
 593   );
 594 } # DeleteFilesystem
 595
 596 sub UpdateFilesystem($$%) {
 597   my ($self, $system, $filesystem, %update) = @_;
 598
 599   $system = $self->_aliasSystem($system);
 600
 601   return unless $system;
 602
 603   return $self->_updateRecord(
 604     'filesystem',
 605     "system='$system' and filesystem='$filesystem'",
 606     %update
 607   );
 608 } # UpdateFilesystem
 609
 610 sub GetFilesystem($$) {
 611   my ($self, $system, $filesystem) = @_;
 612
 613   $system = $self->_aliasSystem($system);
 614
 615   return unless $system;
 616   return unless $filesystem;
 617
 618   my @records = $self->_getRecords(
 619     'filesystem',
 620     "system='$system' and filesystem='$filesystem'"
 621   );
 622
 623   if ($records[0]) {
 624     return %{$records[0]};
 625   } else {
 626     return;
 627   } # if
 628 } # GetFilesystem
 629
 630 sub FindFilesystem($;$) {
 631   my ($self, $system, $filesystem) = @_;
 632
 633   $filesystem ||= '';
 634
 635   $system = $self->_aliasSystem($system);
 636
 637   return unless $system;
 638
 639   my $condition = "system='$system' and filesystem like '%$filesystem%'";
 640
 641   return $self->_getRecords('filesystem', $condition);
 642 } # FindFilesystem
 643
 644 sub AddVob(%) {
 645   my ($self, %vob) = @_;
 646
 647   my @requiredFields = (
 648     'tag',
 649     'region',
 650   );
 651
 652   my $result = _checkRequiredFields \@requiredFields, \%vob;
 653
 654   return -1, "AddVob: $result" if $result;
 655
 656   return $self->_addRecord('vob', %vob);
 657 } # AddVob
 658
 659 sub DeleteVob($$) {
 660   my ($self, $tag, $region) = @_;
 661
 662   return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
 663 } # DeleteVob
 664
 665 sub GetVob($$) {
 666   my ($self, $tag, $region) = @_;
 667
 668   return unless $tag;
 669
 670   # Windows vob tags begin with "\", which is problematic. The solution is to
 671   # escape the "\"
 672   $tag =~ s/^\\/\\\\/;
 673
 674   my @records = $self->_getRecords('vob', "tag='$tag' and region='$region'");
 675
 676   if ($records[0]) {
 677     return %{$records[0]};
 678   } else {
 679     return;
 680   } # if
 681 } # GetVob
 682
 683 <<<<<<< HEAD
 684 sub FindVobStorage(;$$) {
 685   my ($self, $tag, $region) = @_;
 686
 687   $tag    ||= '';
 688   $region ||= '';
 689
 690 =======
 691 sub FindVob($;$) {
 692   my ($self, $tag, $region) = @_;
 693
 694   # Windows vob tags begin with "\", which is problematic. The solution is to
 695   # escape the "\"
 696   $tag =~ s/^\\/\\\\/;
 697
 698   my $condition = "tag like '%$tag%'";
 699
 700   $condition .= " and region='$region'" if $region;
 701
 702   return $self->_getRecords('vobstorage', $condition);
 703 } # FindVobStorage
 704
 705 sub FindVob(;$$) {
 706   my ($self, $tag, $region) = @_;
 707
 708   $tag    ||= '';
 709   $region ||= '';
 710
 711   # Windows vob tags begin with "\", which is problematic. The solution is to
 712   # escape the "\"
 713   $tag =~ s/^\\/\\\\/;
 714
 715   my $condition = "tag like '%$tag%'";
 716
 717   $condition .= " and region='$region'" if $region;
 718
 719   return $self->_getRecords('vob', $condition);
 720 } # FindVob
 721
 722 sub UpdateVob(%) {
 723   my ($self, %vob) = @_;
 724
 725   # Windows vob tags begin with "\", which is problematic. The solution is to
 726   # escape the "\"
 727   my $vobtag = $vob{tag};
 728
 729   $vobtag =~ s/^\\/\\\\/;
 730
 731   return $self->_updateRecord('vob', "tag='$vobtag' and region='$vob{region}'", %vob);
 732 } # UpdateVob
 733
 734 sub AddView(%) {
 735   my ($self, %view) = @_;
 736
 737   my @requiredFields = (
 738     'tag',
 739     'region'
 740   );
 741
 742   my $result = _checkRequiredFields \@requiredFields, \%view;
 743
 744   return -1, "AddView: $result" if $result;
 745
 746   return $self->_addRecord('view', %view);
 747 } # AddView
 748
 749 sub DeleteView($$) {
 750   my ($self, $tag, $region) = @_;
 751
 752   return $self->_deleteRecord('vob', "tag='$tag' and region='$region'");
 753 } # DeleteView
 754
 755 sub UpdateView(%) {
 756   my ($self, %view) = @_;
 757
 758   return $self->_updateRecord('view', "tag='$view{tag}' and region='$view{region}'", %view);
 759 } # UpdateView
 760
 761 sub GetView($$) {
 762   my ($self, $tag, $region) = @_;
 763
 764   return unless $tag;
 765
 766   my @records = $self->_getRecords('view', "tag='$tag' and region='$region'");
 767
 768   if ($records[0]) {
 769     return %{$records[0]};
 770   } else {
 771     return;
 772   } # if
 773 } # GetView
 774
 775 sub FindView(;$$$$) {
 776   my ($self, $tag, $region, $ownerName) = @_;
 777
 778   my $condition;
 779   my @conditions;
 780
 781   push @conditions, "tag like '%$tag%'"           if $tag;
 782   push @conditions, "region = '$region'"          if $region;
 783   push @conditions, "ownerName like '$ownerName'" if $ownerName;
 784
 785   $condition = join " and ", @conditions if @conditions;
 786
 787   return $self->_getRecords('view', $condition);
 788 } # FindView
 789
 790 sub AddFS(%) {
 791   my ($self, %fs) = @_;
 792
 793   my @requiredFields = (
 794     'system',
 795     'filesystem',
 796   );
 797
 798   my $result = _checkRequiredFields \@requiredFields, \%fs;
 799
 800   return -1, "AddFS: $result"
 801     if $result;
 802
 803   # Timestamp record
 804   $fs{timestamp} = Today2SQLDatetime;
 805
 806   return $self->_addRecord('fs', %fs);
 807 } # AddFS
 808
 809 sub TrimFS($$) {
 810   my ($self, $system, $filesystem) = @_;
 811
 812   my %filesystem = $self->GetFilesystem($system, $filesystem);
 813
 814   return unless %filesystem;
 815
 816   my %task = $self->GetTask('scrub');
 817
 818   $self->Error("Unable to find scrub task!", 1) unless %task;
 819
 820   my $days;
 821   my $today = Today2SQLDatetime;
 822
 823   # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
 824   # in February is not right.
 825   if ($filesystem{filesystemHist} =~ /(\d+) month/i) {
 826     $days = $1 * 30;
 827   } elsif ($filesystem{filesystemHist} =~ /(\d+) year/i) {
 828     $days = $1 * 365;
 829   } # if
 830
 831   my $oldage = SubtractDays $today, $days;
 832
 833   my ($dberr, $dbmsg) = $self->_deleteRecord(
 834     'fs',
 835     "system='$system' and filesystem='$filesystem' and timestamp<='$oldage'"
 836   );
 837
 838   if ($dbmsg eq 'Records deleted') {
 839     return (0, $dbmsg) if $dberr == 0;
 840
 841     my %runlog;
 842
 843     $runlog{task}    = $task{name};
 844     $runlog{started} = $today;
 845     $runlog{status}  = 0;
 846     $runlog{message} =
 847       "Scrubbed $dberr fs records for filesystem $system:$filesystem";
 848
 849     my ($err, $msg) = $self->AddRunlog(%runlog);
 850
 851     $self->Error("Unable to add runlog - (Error: $err)\n$msg") if $err;
 852   } # if
 853
 854   return ($dberr, $dbmsg);
 855 } # TrimFS
 856
 857 sub TrimLoadavg($) {
 858   my ($self, $system) = @_;
 859
 860   my %system = $self->GetSystem($system);
 861
 862   return unless %system;
 863
 864   my %task = $self->GetTask('loadavg');
 865
 866   $self->Error("Unable to find loadavg task!", 1) unless %task;
 867
 868   my $days;
 869   my $today = Today2SQLDatetime;
 870
 871   # TODO: SubtractDays uses just an approximation (i.e. subtracting 30 days when
 872   # in February is not right.
 873   if ($system{loadavgHist} =~ /(\d+) month/i) {
 874     $days = $1 * 30;
 875   } elsif ($system{loadavgHist} =~ /(\d+) year/i) {
 876     $days = $1 * 365;
 877   } # if
 878
 879   my $oldage = SubtractDays $today, $days;
 880
 881   my ($dberr, $dbmsg) = $self->_deleteRecord(
 882     'loadavg',
 883     "system='$system' and timestamp<='$oldage'"
 884   );
 885
 886   if ($dbmsg eq 'Records deleted') {
 887     return (0, $dbmsg) if $dberr == 0;
 888
 889     my %runlog;
 890
 891     $runlog{task}    = $task{name};
 892     $runlog{started} = $today;
 893     $runlog{status}  = 0;
 894     $runlog{message} =
 895       "Scrubbed $dberr loadavg records for system $system";
 896
 897     my ($err, $msg) = $self->AddRunlog(%runlog);
 898
 899     $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
 900   } # if
 901
 902   return ($dberr, $dbmsg);
 903 } # TrimLoadavg
 904
 905 sub TrimStorage($$$) {
 906   my ($self, $type, $tag, $region) = @_;
 907
 908   my $today = Today2SQLDatetime;
 909
 910   my $oldage = SubtractDays $today, $Clearadm::CLEAROPTS{CLEARADM_SCRUBDAYS};
 911
 912   my $table = $type =~ /vob/i
 913             ? 'vobstorage'
 914             : 'viewstorage';
 915
 916   my ($dberr, $dbmsg) = $self->_deleteRecord(
 917     $table,
 918     "tag='$tag' and region='$region' and timestamp<='$oldage'"
 919   );
 920
 921   if ($dbmsg eq 'Records deleted') {
 922     return (0, $dbmsg) if $dberr == 0;
 923
 924     my %runlog;
 925
 926     $runlog{task}    = 'Scrub';
 927     $runlog{started} = $today;
 928     $runlog{status}  = 0;
 929     $runlog{message} =
 930       "Scrubbed $dberr ${type}storage records";
 931
 932     my ($err, $msg) = $self->AddRunlog(%runlog);
 933
 934     $self->Error("Unable to add runload (Error: $err)\n$msg") if $err;
 935   } # if
 936
 937   return ($dberr, $dbmsg);
 938 } # TrimStorage
 939
 940 sub ValidateCCObjects() {
 941   my ($self) = @_;
 942
 943   my $vobRecordsDeleted  = 0;
 944   my $viewRecordsDeleted = 0;
 945
 946   for my $region ($Clearcase::CC->regions) {
 947     for my $type (qw(vob view)) {
 948       my @ccobjs;
 949       verbose "Processing ${type}s in $region";
 950
 951       if ($type eq 'vob') {
 952         verbose "Finding all vobs in region $region";
 953         @ccobjs = $self->FindVob(undef, $region);
 954         verbose 'Found ' . scalar @ccobjs . ' vobs to process';
 955       } elsif ($type eq 'view') {
 956         verbose "Finding all views in region $region";
 957         @ccobjs = $self->FindView(undef, $region);
 958         verbose 'Found ' . scalar @ccobjs . ' views to process';
 959       } # if
 960
 961       for my $object (@ccobjs) {
 962         my %ccobjrec = %$object;
 963
 964         verbose "Processing $ccobjrec{tag}:$ccobjrec{region}";
 965
 966         my $ccobj;
 967
 968         if ($type eq 'vob') {
 969           $ccobj = Clearcase::Vob->new($ccobjrec{tag}, $ccobjrec{region});
 970         } else {
 971           $ccobj = Clearcase::View->new($ccobjrec{tag}, $ccobjrec{region});
 972         } # if
 973
 974         verbose_nolf 'Checking if ' . $ccobj->{tag} . ':' . $ccobj->{region} . ' exists anymore...';
 975
 976         if ($ccobj->exists) {
 977           verbose ' it does! Skipping...';
 978           next;
 979         } else {
 980           verbose ' it doesn\'t!';
 981         } # if
 982
 983         #next if $ccobj->exists;
 984
 985         verbose "Deleting $type $ccobjrec{tag}:$ccobjrec{region}";
 986
 987         my ($recordsDeleted, $msg) = $self->_deleteRecord($type,
 988           "tag='$ccobjrec{tag}' and region='$ccobjrec{region}'");
 989
 990         if ($msg ne 'Records deleted') {
 991           return ($recordsDeleted, $msg);
 992         } else {
 993           $viewRecordsDeleted += $recordsDeleted if $type eq 'view';
 994           $vobRecordsDeleted  += $recordsDeleted if $type eq 'vob';
 995         } # if
 996       } # for
 997     } # for
 998   } # for
 999
1000   return ($viewRecordsDeleted, $vobRecordsDeleted);
1001 } # ValidateCCObjects
1002
1003 sub GetFS($$;$$$$) {
1004   my ($self, $system, $filesystem, $start, $end, $count, $interval) = @_;
1005
1006   $system = $self->_aliasSystem($system);
1007
1008   return unless $system;
1009   return unless $filesystem;
1010
1011   $interval ||= 'Minute';
1012
1013   my $size = $interval =~ /month/i
1014            ? 7
1015            : $interval =~ /day/i
1016            ? 10
1017            : $interval =~ /hour/i
1018            ? 13
1019            : 16;
1020
1021   undef $start if $start and $start =~ /earliest/i;
1022   undef $end   if $end   and $end   =~ /latest/i;
1023
1024   my $condition  = "system='$system' and filesystem='$filesystem'";
1025      $condition .= " and timestamp>='$start'" if $start;
1026      $condition .= " and timestamp<='$end'"   if $end;
1027
1028      $condition .= " group by left(timestamp,$size)";
1029
1030   if ($count) {
1031     # We can't simply do a "limit 0, $count" as that just gets the front end of
1032     # the records return (i.e. if $count = say 10 and the timestamp range
1033     # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1034     # $offset, $count where $offset = the number of qualifying records minus
1035     # $count
1036     my $nbrRecs = $self->Count('fs', $condition);
1037     my $offset  = $nbrRecs - $count;
1038
1039     # Offsets of < 0 are not allowed.
1040     $offset = 0
1041       if $offset < 0;
1042
1043     $condition .= " limit $offset, $count";
1044   } # if
1045
1046   my $statement = <<"END";
1047 select
1048   system,
1049   filesystem,
1050   mount,
1051   left(timestamp,$size) as timestamp,
1052   avg(size) as size,
1053   avg(used) as used,
1054   avg(free) as free,
1055   reserve
1056 from
1057   fs
1058   where $condition
1059 END
1060
1061   my ($err, $msg);
1062
1063   my $sth = $self->{db}->prepare($statement);
1064
1065   unless ($sth) {
1066     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1067
1068     croak $msg;
1069   } # if
1070
1071   my $status = $sth->execute;
1072
1073   unless ($status) {
1074     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1075
1076     croak $msg;
1077   } # if
1078
1079   my @records;
1080
1081   while (my $row = $sth->fetchrow_hashref) {
1082     push @records, $row;
1083   } # while
1084
1085   return @records;
1086 } # GetFS
1087
1088 sub GetLatestFS($$) {
1089   my ($self, $system, $filesystem) = @_;
1090
1091   $system = $self->_aliasSystem($system);
1092
1093   return unless $system;
1094   return unless $filesystem;
1095
1096   my @records = $self->_getRecords(
1097     'fs',
1098     "system='$system' and filesystem='$filesystem'"
1099   . " order by timestamp desc limit 0, 1",
1100   );
1101
1102   if ($records[0]) {
1103     return %{$records[0]};
1104   } else {
1105     return;
1106   } # if
1107 } # GetLatestFS
1108
1109 sub AddLoadavg() {
1110   my ($self, %loadavg) = @_;
1111
1112   my @requiredFields = (
1113     'system',
1114   );
1115
1116   my $result = _checkRequiredFields \@requiredFields, \%loadavg;
1117
1118   return -1, "AddLoadavg: $result" if $result;
1119
1120   # Timestamp record
1121   $loadavg{timestamp} = Today2SQLDatetime;
1122
1123   return $self->_addRecord('loadavg', %loadavg);
1124 } # AddLoadavg
1125
1126 sub GetLoadavg($;$$$$) {
1127   my ($self, $system, $start, $end, $count, $interval) = @_;
1128
1129   $system = $self->_aliasSystem($system);
1130
1131   return unless $system;
1132
1133   $interval ||= 'Minute';
1134
1135   my $size = $interval =~ /month/i
1136            ? 7
1137            : $interval =~ /day/i
1138            ? 10
1139            : $interval =~ /hour/i
1140            ? 13
1141            : 16;
1142
1143   my $condition;
1144
1145   undef $start if $start and $start =~ /earliest/i;
1146   undef $end   if $end   and $end   =~ /latest/i;
1147
1148   $condition .= " system='$system'"        if $system;
1149   $condition .= " and timestamp>='$start'" if $start;
1150   $condition .= " and timestamp<='$end'"   if $end;
1151
1152   $condition .= " group by left(timestamp,$size)";
1153
1154   if ($count) {
1155     # We can't simply do a "limit 0, $count" as that just gets the front end of
1156     # the records return (i.e. if $count = say 10 and the timestamp range
1157     # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1158     # $offset, $count where $offset = the number of qualifying records minus
1159     # $count
1160     my $nbrRecs = $self->Count('loadavg', $condition);
1161     my $offset  = $nbrRecs - $count;
1162
1163     # Offsets of < 0 are not allowed.
1164     $offset = 0 if $offset < 0;
1165
1166     $condition .= " limit $offset, $count";
1167   } # if
1168
1169   my $statement = <<"END";
1170 select
1171   system,
1172   left(timestamp,$size) as timestamp,
1173   uptime,
1174   users,
1175   avg(loadavg) as loadavg
1176 from
1177   loadavg
1178   where $condition
1179 END
1180
1181   my ($err, $msg);
1182
1183   my $sth = $self->{db}->prepare($statement);
1184
1185   unless ($sth) {
1186     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1187
1188     croak $msg;
1189   } # if
1190
1191   my $status = $sth->execute;
1192
1193   unless ($status) {
1194     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1195
1196     croak $msg;
1197   } # if
1198
1199   my @records;
1200
1201   while (my $row = $sth->fetchrow_hashref) {
1202     push @records, $row;
1203   } # while
1204
1205   return @records;
1206 } # GetLoadvg
1207
1208 sub GetLatestLoadavg($) {
1209   my ($self, $system) = @_;
1210
1211   $system = $self->_aliasSystem($system);
1212
1213   return unless $system;
1214
1215   my @records = $self->_getRecords(
1216     'loadavg',
1217     "system='$system'"
1218   . " order by timestamp desc limit 0, 1",
1219   );
1220
1221   if ($records[0]) {
1222     return %{$records[0]};
1223   } else {
1224     return;
1225   } # if
1226 } # GetLatestLoadavg
1227
1228 sub GetStoragePool($$$;$$$$$) {
1229   my ($self, $type, $tag, $storage, $region, $start, $end, $count, $interval) = @_;
1230
1231   $interval ||= 'Day';
1232   $region   ||= $Clearcase::CC->region;
1233
1234   return unless $type =~ /vob/i or $type =~ /view/;
1235
1236   my $size = $interval =~ /month/i
1237            ? 7
1238            : $interval =~ /day/i
1239            ? 10
1240            : $interval =~ /hour/i
1241            ? 13
1242            : 16;
1243
1244   undef $start if $start and $start =~ /earliest/i;
1245   undef $end   if $end   and $end   =~ /latest/i;
1246
1247   # Windows vob tags begin with "\", which is problematic. The solution is to
1248   # escape the "\"
1249   $tag =~ s/^\\/\\\\/;
1250
1251   my $condition;
1252   my $table = $type eq 'vob' ? 'vobstorage' : 'viewstorage';
1253
1254   $condition  = "tag='$tag' and region='$region'";
1255   $condition .= " and timestamp>='$start'" if $start;
1256   $condition .= " and timestamp<='$end'"   if $end;
1257
1258   $condition .= " group by left(timestamp,$size)";
1259
1260   if ($count) {
1261     # We can't simply do a "limit 0, $count" as that just gets the front end of
1262     # the records return (i.e. if $count = say 10 and the timestamp range
1263     # returns 40 rows we'll see only rows 1-10, not rows 31-40). We need limit
1264     # $offset, $count where $offset = the number of qualifying records minus
1265     # $count
1266     my $nbrRecs = $self->Count($table, $condition);
1267     my $offset  = $nbrRecs - $count;
1268
1269     # Offsets of < 0 are not allowed.
1270     $offset = 0 if $offset < 0;
1271
1272     $condition .= " limit $offset, $count";
1273   } # if
1274
1275   my $statement = <<"END";
1276 select
1277   tag,
1278   region,
1279   left(timestamp,$size) as timestamp,
1280   avg($storage) as size
1281 from
1282   $table
1283   where $condition
1284 END
1285
1286   my ($err, $msg);
1287
1288   my $sth = $self->{db}->prepare($statement);
1289
1290   unless ($sth) {
1291     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1292
1293     croak $msg;
1294   } # if
1295
1296   my $status = $sth->execute;
1297
1298   unless ($status) {
1299     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1300
1301     croak $msg;
1302   } # if
1303
1304   my @records;
1305
1306   while (my $row = $sth->fetchrow_hashref) {
1307     push @records, $row;
1308   } # while
1309
1310   return @records;
1311 } # GetStoragePool
1312
1313 sub AddTask(%) {
1314   my ($self, %task) = @_;
1315
1316   my @requiredFields = (
1317     'name',
1318     'command'
1319   );
1320
1321   my $result = _checkRequiredFields \@requiredFields, \%task;
1322
1323   return -1, "AddTask: $result" if $result;
1324
1325   return $self->_addRecord('task', %task);
1326 } # AddTask
1327
1328 sub DeleteTask($) {
1329   my ($self, $name) = @_;
1330
1331   return $self->_deleteRecord('task', "name='$name'");
1332 } # DeleteTask
1333
1334 sub FindTask($) {
1335   my ($self, $name) = @_;
1336
1337   $name ||= '';
1338
1339   my $condition = "name like '%$name%'";
1340
1341   return $self->_getRecords('task', $condition);
1342 } # FindTask
1343
1344 sub GetTask($) {
1345   my ($self, $name) = @_;
1346
1347   return unless $name;
1348
1349   my @records = $self->_getRecords('task', "name='$name'");
1350
1351   if ($records[0]) {
1352     return %{$records[0]};
1353   } else {
1354     return;
1355   } # if
1356 } # GetTask
1357
1358 sub UpdateTask($%) {
1359   my ($self, $name, %update) = @_;
1360
1361   return $self->_updateRecord('task', "name='$name'", %update);
1362 } # Update
1363
1364 sub AddSchedule(%) {
1365   my ($self, %schedule) = @_;
1366
1367   my @requiredFields = (
1368     'task',
1369   );
1370
1371   my $result = _checkRequiredFields \@requiredFields, \%schedule;
1372
1373   return -1, "AddSchedule: $result" if $result;
1374
1375   return $self->_addRecord('schedule', %schedule);
1376 } # AddSchedule
1377
1378 sub DeleteSchedule($) {
1379   my ($self, $name) = @_;
1380
1381   return $self->_deleteRecord('schedule', "name='$name'");
1382 } # DeleteSchedule
1383
1384 sub FindSchedule(;$$) {
1385   my ($self, $name, $task) = @_;
1386
1387   $name ||= '';
1388   $task ||= '';
1389
1390   my $condition  = "name like '%$name%'";
1391      $condition .= ' and ';
1392      $condition .= "task like '%$task%'";
1393
1394   return $self->_getRecords('schedule', $condition);
1395 } # FindSchedule
1396
1397 sub GetSchedule($) {
1398   my ($self, $name) = @_;
1399
1400   my @records = $self->_getRecords('schedule', "name='$name'");
1401
1402   if ($records[0]) {
1403     return %{$records[0]};
1404   } else {
1405     return;
1406   } # if
1407 } # GetSchedule
1408
1409 sub UpdateSchedule($%) {
1410   my ($self, $name, %update) = @_;
1411
1412   return $self->_updateRecord('schedule', "name='$name'", %update);
1413 } # UpdateSchedule
1414
1415 sub AddRunlog(%) {
1416   my ($self, %runlog) = @_;
1417
1418   my @requiredFields = (
1419     'task',
1420   );
1421
1422   my $result = _checkRequiredFields \@requiredFields, \%runlog;
1423
1424   return -1, "AddRunlog: $result" if $result;
1425
1426   $runlog{ended} = Today2SQLDatetime;
1427
1428   $runlog{system} = hostname if $runlog{system} =~ /localhost/i;
1429
1430   my ($err, $msg) = $self->_addRecord('runlog', %runlog);
1431
1432   return ($err, $msg, $self->_getLastID);
1433 } # AddRunlog
1434
1435 sub DeleteRunlog($) {
1436   my ($self, $condition) = @_;
1437
1438   return $self->_deleteRecord('runlog', $condition);
1439 } # DeleteRunlog
1440
1441 sub FindRunlog(;$$$$$$) {
1442   my ($self, $task, $system, $status, $id, $start, $page) = @_;
1443
1444   # If ID is specified then that's all that really matters as it uniquely
1445   # identifies a runlog entry;
1446   my ($condition, $conditions);
1447   my $limit = '';
1448
1449   unless ($id) {
1450     if ($task !~ /all/i) {
1451       $conditions++;
1452       $condition = "task like '%$task%'";
1453     } # if
1454
1455     if ($system !~ /all/i) {
1456       $condition .= ' and ' if $conditions;
1457       $condition .= "system like '%$system%'";
1458       $conditions++;
1459     } # if
1460
1461     if ($status) {
1462       $condition .= ' and ' if $conditions;
1463
1464       if ($status =~ /!(-*\d+)/) {
1465         $condition .= "status<>$1";
1466       } else {
1467         $condition .= "status=$status"
1468       } # if
1469     } # if
1470
1471     # Need defined here as $start may be 0!
1472     if (defined $start) {
1473       $page ||= 10;
1474       $limit = "limit $start, $page";
1475     } # unless
1476   } else {
1477     $condition = "id=$id";
1478   } # unless
1479
1480   return $self->_getRecords('runlog', $condition, " order by started desc $limit");
1481 } # FindRunlog
1482
1483 sub GetRunlog($) {
1484   my ($self, $id) = @_;
1485
1486   return unless $id;
1487
1488   my @records = $self->_getRecords('runlog', "id=$id");
1489
1490   if ($records[0]) {
1491     return %{$records[0]};
1492   } else {
1493     return;
1494   } # if
1495 } # GetRunlog
1496
1497 sub UpdateRunlog($%) {
1498   my ($self, $id, %update) = @_;
1499
1500   return $self->_updateRecord('runlog', "id=$id", %update);
1501 } # UpdateRunlog
1502
1503 sub Count($;$) {
1504   my ($self, $table, $condition) = @_;
1505
1506   $condition = $condition ? 'where ' . $condition : '';
1507
1508   my ($err, $msg);
1509
1510   my $statement = "select count(*) from $table $condition";
1511
1512   my $sth = $self->{db}->prepare($statement);
1513
1514   unless ($sth) {
1515     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1516
1517     croak $msg;
1518   } # if
1519
1520   my $status = $sth->execute;
1521
1522   unless ($status) {
1523     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1524
1525     croak $msg;
1526   } # if
1527
1528   # Hack! Statements such as the following:
1529   #
1530   # select count(*) from fs where system='jupiter' and filesystem='/dev/sdb5'
1531   # > group by left(timestamp,10);
1532   # +----------+
1533   # | count(*) |
1534   # +----------+
1535   # |       49 |
1536   # |       98 |
1537   # |      140 |
1538   # |        7 |
1539   # |       74 |
1540   # |      124 |
1541   # |      190 |
1542   # +----------+
1543   # 7 rows in set (0.00 sec)
1544   #
1545   # Here we want 7 but what we see in $records[0] is 49. So the hack is that if
1546   # statement contains "group by" then we assume we have the above and return
1547   # scalar @records, otherwise we return $records[0];
1548   if ($statement =~ /group by/i) {
1549     my $allrows = $sth->fetchall_arrayref;
1550
1551     return scalar @{$allrows};
1552   } else {
1553     my @records = $sth->fetchrow_array;
1554
1555     return $records[0];
1556   } # if
1557 } # Count
1558
1559 # GetWork returns two items, the number of seconds to wait before the next task
1560 # and array of hash records of work to be done immediately. The caller should
1561 # execute the work to be done, timing it, and subtracting it from the $sleep
1562 # time returned. If the caller exhausts the $sleep time then they should call
1563 # us again.
1564 sub GetWork() {
1565   my ($self) = @_;
1566
1567   my ($err, $msg);
1568
1569   my $statement = <<"END";
1570 select
1571   schedule.name as schedulename,
1572   task.name,
1573   task.system as system,
1574   task.command,
1575   schedule.notification,
1576   frequency,
1577   runlog.started as lastrun
1578 from
1579   task,
1580   schedule left join runlog on schedule.lastrunid=runlog.id
1581 where
1582       schedule.task=task.name
1583   and schedule.active='true'
1584 order by lastrun
1585 END
1586
1587   my $sth = $self->{db}->prepare($statement);
1588
1589   unless ($sth) {
1590     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1591
1592     croak $msg;
1593   } # if
1594
1595   my $status = $sth->execute;
1596
1597   unless ($status) {
1598     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1599
1600     croak $msg;
1601   } # if
1602
1603   my $sleep;
1604   my @records;
1605
1606   while (my $row = $sth->fetchrow_hashref) {
1607    if ($$row{system} !~ /localhost/i) {
1608      my %system = $self->GetSystem($$row{system});
1609
1610      # Skip inactive systems
1611      next if $system{active} eq 'false';
1612    } # if
1613
1614     # If started is not defined then this task was never run so run it now.
1615     unless ($$row{lastrun}) {
1616       push @records, $row;
1617       next;
1618     } # unless
1619
1620     # TODO: Handle frequencies better.
1621     my $seconds;
1622
1623     if ($$row{frequency} =~ /(\d+) seconds/i) {
1624       $seconds = $1;
1625     } elsif ($$row{frequency} =~ /(\d+) minute/i) {
1626       $seconds = $1 * 60;
1627     } elsif ($$row{frequency} =~ /(\d+) hour/i) {
1628       $seconds = $1 * 60 * 60;
1629     } elsif ($$row{frequency} =~ /(\d+) day/i) {
1630       $seconds= $1 * 60 * 60 * 24;
1631     } else {
1632       warning "Don't know how to handle frequencies like $$row{frequency}";
1633       next;
1634     } # if
1635
1636     my $today    = Today2SQLDatetime;
1637     my $lastrun  = Add($$row{lastrun}, (seconds => $seconds));
1638     my $waitTime = DateToEpoch($lastrun) - DateToEpoch($today);
1639
1640     if ($waitTime < 0) {
1641       # We're late - push this onto records and move on
1642       push @records, $row;
1643     } # if
1644
1645     $sleep ||= $waitTime;
1646
1647     if ($sleep > $waitTime) {
1648       $sleep = $waitTime;
1649     } # if
1650   } # while
1651
1652   # Even if there is nothing to do the caller should sleep a bit and come back
1653   # to us. So if it ends up there's nothing past due, and nothing upcoming, then
1654   # sleep for a minute and return here. Somebody may have added a new task next
1655   # time we're called.
1656   if (@records == 0 and not $sleep) {
1657     $sleep = 60;
1658   } # if
1659
1660   return ($sleep, @records);
1661 } # GetWork
1662
1663 sub GetUniqueList($$) {
1664   my ($self, $table, $field) = @_;
1665
1666   my ($err, $msg);
1667
1668   my $statement = "select $field from $table group by $field";
1669
1670   my $sth = $self->{db}->prepare($statement);
1671
1672   unless ($sth) {
1673     ($err, $msg) = $self->_dberror('Unable to prepare statement', $statement);
1674
1675     croak $msg;
1676   } # if
1677
1678   my $status = $sth->execute;
1679
1680   unless ($status) {
1681     ($err, $msg) = $self->_dberror('Unable to execute statement', $statement);
1682
1683     croak $msg;
1684   } # if
1685
1686   my @values;
1687
1688   while (my @row = $sth->fetchrow_array) {
1689     if ($row[0]) {
1690       push @values, $row[0];
1691     } else {
1692       push @values, '<NULL>';
1693     } # if
1694   } # for
1695
1696   return @values;
1697 } # GetUniqueList
1698
1699 sub AddAlert(%) {
1700   my ($self, %alert) = @_;
1701
1702   my @requiredFields = (
1703     'name',
1704     'type',
1705   );
1706
1707   my $result = _checkRequiredFields \@requiredFields, \%alert;
1708
1709   return -1, "AddAlert: $result" if $result;
1710
1711   return $self->_addRecord('alert', %alert);
1712 } # AddAlert
1713
1714 sub DeleteAlert($) {
1715   my ($self, $name) = @_;
1716
1717   return $self->_deleteRecord('alert', "name='$name'");
1718 } # DeleteAlert
1719
1720 sub FindAlert(;$) {
1721   my ($self, $alert) = @_;
1722
1723   $alert ||= '';
1724
1725   my $condition = "name like '%$alert%'";
1726
1727   return $self->_getRecords('alert', $condition);
1728 } # FindAlert
1729
1730 sub GetAlert($) {
1731   my ($self, $name) = @_;
1732
1733   return
1734     unless $name;
1735
1736   my @records = $self->_getRecords('alert', "name='$name'");
1737
1738   if ($records[0]) {
1739     return %{$records[0]};
1740   } else {
1741     return;
1742   } # if
1743 } # GetAlert
1744
1745 sub SendAlert($$$$$$$) {
1746   my (
1747     $self,
1748     $alert,
1749     $system,
1750     $notification,
1751     $subject,
1752     $message,
1753     $to,
1754     $runlogID,
1755   ) = @_;
1756
1757   my $footing  = '<hr><p style="text-align: center;">';
1758      $footing .= '<font color="#bbbbbb">';
1759   my $year     = (localtime)[5] + 1900;
1760      $footing .= "<a href='$CLEAROPTS{CLEARADM_WEBBASE}'>Clearadm</a><br>";
1761      $footing .= "Copyright &copy; $year, ClearSCM, Inc. - All rights reserved";
1762
1763   my %alert = $self->GetAlert($alert);
1764
1765   if ($alert{type} eq 'email') {
1766     my $from = 'Clearadm@' . hostdomain;
1767
1768     mail(
1769       from    => $from,
1770       to      => $to,
1771       subject => "Clearadm Alert: $system: $subject",
1772       mode    => 'html',
1773       data    => $message,
1774       footing => $footing,
1775     );
1776   } else {
1777     $self->Error("Don't know how to send $alert{type} alerts\n"
1778                 . "Subject: $subject\n"
1779                 . "Message: $message", 1);
1780   } # if
1781
1782   # Log alert
1783   my %alertlog = (
1784     alert        => $alert,
1785     system       => $system,
1786     notification => $notification,
1787     runlog       => $runlogID,
1788     timestamp    => Today2SQLDatetime,
1789     message      => $subject,
1790   );
1791
1792   return $self->AddAlertlog(%alertlog);
1793 } # SendAlert
1794
1795 sub GetLastAlert($$) {
1796   my ($self, $notification, $system) = @_;
1797
1798   my $statement = <<"END";
1799 select
1800   runlog,
1801   timestamp
1802 from
1803   alertlog
1804 where
1805       notification='$notification'
1806   and system='$system'
1807 order by
1808   timestamp desc
1809 limit
1810   0, 1
1811 END
1812
1813   my $sth = $self->{db}->prepare($statement)
1814     or return $self->_dberror('Unable to prepare statement', $statement);
1815
1816   $sth->execute
1817     or return $self->_dberror('Unable to execute statement', $statement);
1818
1819   my $alertlog= $sth->fetchrow_hashref;
1820
1821   $sth->finish;
1822
1823   if ($alertlog) {
1824     return %$alertlog;
1825   } else {
1826     return;
1827   } # if
1828 } # GetLastAlert
1829
1830 sub GetLastTaskFailure($$) {
1831   my ($self, $task, $system) = @_;
1832
1833   my $statement = <<"END";
1834 select
1835   id,
1836   ended
1837 from
1838   runlog
1839 where
1840       status <> 0
1841   and task='$task'
1842   and system='$system'
1843   and alerted='true'
1844 order by
1845   ended desc
1846 limit
1847   0, 1
1848 END
1849
1850   my $sth = $self->{db}->prepare($statement)
1851     or return $self->_dberror('Unable to prepare statement', $statement);
1852
1853   $sth->execute
1854     or return $self->_dberror('Unable to execute statement', $statement);
1855
1856   my $runlog= $sth->fetchrow_hashref;
1857
1858   $sth->finish;
1859
1860   if ($$runlog{ended}) {
1861     return %$runlog;
1862   } # if
1863
1864   # If we didn't get any ended in the last call then there's nothing that
1865   # qualified. Still let's return a record (%runlog) that has a valid id so
1866   # that the caller can update that runlog with alerted = 'true'.
1867   $statement = <<"END";
1868 select
1869   id
1870 from
1871   runlog
1872 where
1873       status <> 0
1874   and task='$task'
1875   and system='$system'
1876 order by
1877   ended desc
1878 limit
1879   0, 1
1880 END
1881
1882   $sth = $self->{db}->prepare($statement)
1883     or return $self->_dberror('Unable to prepare statement', $statement);
1884
1885   $sth->execute
1886     or return $self->_dberror('Unable to execute statement', $statement);
1887
1888   $runlog = $sth->fetchrow_hashref;
1889
1890   $sth->finish;
1891
1892   if ($runlog) {
1893     return %$runlog;
1894   } else {
1895     return
1896   } # if
1897 } # GetLastTaskFailure
1898
1899 sub Notify($$$$$$) {
1900   my (
1901     $self,
1902     $notification,
1903     $subject,
1904     $message,
1905     $task,
1906     $system,
1907     $filesystem,
1908     $runlogID,
1909   ) = @_;
1910
1911   $runlogID = $self->_getLastID
1912     unless $runlogID;
1913
1914   my ($err, $msg);
1915
1916   # Update filesystem, if $filesystem was specified
1917   if ($filesystem) {
1918     ($err, $msg) = $self->UpdateFilesystem(
1919       $system,
1920       $filesystem, (
1921         notification => $notification,
1922       ),
1923     );
1924
1925     $self->Error("Unable to set notification for filesystem $system:$filesystem "
1926                . "(Status: $err)\n$msg", $err) if $err;
1927   } # if
1928
1929   # Update system
1930   ($err, $msg) = $self->UpdateSystem(
1931     $system, (
1932       notification => $notification,
1933     ),
1934   );
1935
1936   my %notification = $self->GetNotification($notification);
1937
1938   my %lastnotified = $self->GetLastAlert($notification, $system);
1939
1940   if (%lastnotified and $lastnotified{timestamp}) {
1941     my $today        = Today2SQLDatetime;
1942     my $lastnotified = $lastnotified{timestamp};
1943
1944     if ($notification{nomorethan} =~ /hour/i) {
1945       $lastnotified = Add($lastnotified, (hours => 1));
1946     } elsif ($notification{nomorethan} =~ /day/i) {
1947       $lastnotified = Add($lastnotified, (days => 1));
1948     } elsif ($notification{nomorethan} =~ /week/i) {
1949       $lastnotified = Add($lastnotified, (days => 7));
1950     } elsif ($notification{nomorethan} =~ /month/i) {
1951       $lastnotified = Add($lastnotified, (month => 1));
1952     } # if
1953
1954     # If you want to fake an alert in the debugger just change $diff accordingly
1955     my $diff = Compare($today, $lastnotified);
1956
1957     return if $diff <= 0;
1958   } # if
1959
1960   my $when       = Today2SQLDatetime;
1961   my $nomorethan = lc $notification{nomorethan};
1962   my %alert      = $self->GetAlert($notification{alert});
1963   my $to         = $alert{who};
1964
1965   # If $to is null then this means to send the alert to the admin for the
1966   # machine.
1967   unless ($to) {
1968     if ($system) {
1969       my %system = $self->GetSystem($system);
1970
1971       $to = $system{email};
1972     } else {
1973       # If we don't know what system this error occurred on we'll have to notify
1974       # the "super user" defined as $self->{NOTIFY} (The receiver of last
1975       # resort)
1976       $to = $self->{NOTIFY};
1977     } # if
1978   } # unless
1979
1980   unless ($to) {
1981     Error "To undefined";
1982   } # unless
1983
1984   $message .= "<p>You will receive this alert no more than $nomorethan.</p>";
1985
1986   ($err, $msg) = $self->SendAlert(
1987     $notification{alert},
1988     $system,
1989     $notification{name},
1990     $subject,
1991     $message,
1992     $to,
1993     $runlogID,
1994   );
1995
1996   $self->Error("Unable to send alert (Status: $err)\n$msg", $err) if $err;
1997
1998   verbose "Sent alert to $to";
1999
2000   # Update runlog to indicate we notified the user for this execution
2001   ($err, $msg) = $self->UpdateRunlog(
2002     $runlogID, (
2003       alerted => 'true',
2004     ),
2005   );
2006
2007   $self->Error("Unable to update runlog (Status: $err)\n$msg", $err) if $err;
2008
2009   return;
2010 } # Notify
2011
2012 sub ClearNotifications($$;$) {
2013   my ($self, $system, $filesystem) = @_;
2014
2015   my ($err, $msg);
2016
2017   if ($filesystem) {
2018     ($err, $msg) = $self->UpdateFilesystem(
2019       $system,
2020       $filesystem, (notification => undef),
2021     );
2022
2023     error "Unable to clear notification for filesystem $system:$filesystem "
2024         . "(Status: $err)\n$msg", $err
2025       if $err;
2026
2027     # Check to see any of this system's filesystems have notifications. If none
2028     # then it's save to say we've turned off the last notification for a
2029     # filesystem involved with this system and if $system{notification} was
2030     # 'Filesystem' then we can toggle off the notification on the system too
2031     my $filesystemsAlerted = 0;
2032
2033     for ($self->FindFilesystem($system)) {
2034       $filesystemsAlerted++
2035         if $$_{notification};
2036     } # for
2037
2038     my %system = $self->GetSystem($system);
2039
2040     return unless $system;
2041
2042     if ($system{notification}                 and
2043         $system{notification} eq 'Filesystem' and
2044         $filesystemsAlerted == 0) {
2045       ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
2046
2047       $self->Error("Unable to clear notification for system $system "
2048                   . "(Status: $err)\n$msg", $err) if $err;
2049     } # if
2050   } else {
2051     ($err, $msg) = $self->UpdateSystem($system, (notification => undef));
2052
2053     $self->Error("Unable to clear notification for system $system "
2054                 . "(Status: $err)\n$msg", $err) if $err;
2055   } # if
2056
2057   return;
2058 } # ClearNotifications
2059
2060 sub SystemAlive(%) {
2061   my ($self, %system) = @_;
2062
2063   # If we've never heard from this system then we will assume that the system
2064   # has not been set up to run clearagent and has never checked in. In any event
2065   # we cannot say the system died because we've never known it to be alive!
2066   return 1 unless $system{lastheardfrom};
2067
2068   # If a system is not active (may have been temporarily been deactivated) then
2069   # we don't want to turn on the bells and whistles alerting people it's down.
2070   return 1 if $system{active} eq 'false';
2071
2072   my $today         = Today2SQLDatetime;
2073   my $lastheardfrom = $system{lastheardfrom};
2074
2075   my $tenMinutes = 10 * 60;
2076
2077   $lastheardfrom = Add($lastheardfrom, (seconds => $tenMinutes));
2078
2079   if (DateToEpoch($lastheardfrom) < DateToEpoch($today)) {
2080     $self->UpdateSystem(
2081       $system{name}, (
2082         notification => 'Heartbeat'
2083       ),
2084     );
2085
2086     return;
2087   } else {
2088     if ($system{notification}) {
2089       $self->UpdateSystem(
2090         $system{name}, (
2091           notification => undef
2092         ),
2093       );
2094     }
2095     return 1;
2096   } # if
2097 } # SystemAlive
2098
2099 sub UpdateAlert($%) {
2100   my ($self, $name, %update) = @_;
2101
2102   return $self->_updateRecord(
2103     'alert',
2104     "name='$name'",
2105     %update
2106   );
2107 } # UpdateAlert
2108
2109 sub AddAlertlog(%) {
2110   my ($self, %alertlog) = @_;
2111
2112   my @requiredFields = (
2113     'alert',
2114     'notification',
2115   );
2116
2117   my $result = _checkRequiredFields \@requiredFields, \%alertlog;
2118
2119   return -1, "AddAlertlog: $result" if $result;
2120
2121   # Timestamp record
2122   $alertlog{timestamp} = Today2SQLDatetime;
2123
2124   return $self->_addRecord('alertlog', %alertlog);
2125 } # AddAlertlog
2126
2127 sub DeleteAlertlog($) {
2128   my ($self, $condition) = @_;
2129
2130   return
2131     unless $condition;
2132
2133   if ($condition =~ /all/i) {
2134     return $self->_deleteRecord('alertlog');
2135   } else {
2136     return $self->_deleteRecord('alertlog', $condition);
2137   } # if
2138 } # DeleteAlertlog
2139
2140 sub FindAlertlog(;$$$$$) {
2141   my ($self, $alert, $system, $notification, $start, $page) = @_;
2142
2143   $alert        ||= '';
2144   $system       ||= '';
2145   $notification ||= '';
2146
2147   my $condition  = "alert like '%$alert%'";
2148      $condition .= ' and ';
2149      $condition .= "system like '%$system%'";
2150      $condition .= ' and ';
2151      $condition .= "notification like '%$notification%'";
2152      $condition .= " order by timestamp desc";
2153
2154   if (defined $start) {
2155     $page ||= 10;
2156     $condition .= " limit $start, $page";
2157   } # unless
2158
2159   return $self->_getRecords('alertlog', $condition);
2160 } # FindAlertLog
2161
2162 sub GetAlertlog($) {
2163   my ($self, $alert) = @_;
2164
2165   return unless $alert;
2166
2167   my @records = $self->_getRecords('alertlog', "alert='$alert'");
2168
2169   if ($records[0]) {
2170     return %{$records[0]};
2171   } else {
2172     return;
2173   } # if
2174 } # GetAlertlog
2175
2176 sub UpdateAlertlog($%) {
2177   my ($self, $alert, %update) = @_;
2178
2179   return $self->_updateRecord(
2180     'alertlog',
2181     "alert='$alert'",
2182     %update
2183   );
2184 } # UpdateAlertlog
2185
2186 sub AddNotification(%) {
2187   my ($self, %notification) = @_;
2188
2189   my @requiredFields = (
2190     'name',
2191     'alert',
2192     'cond'
2193   );
2194
2195   my $result = _checkRequiredFields \@requiredFields, \%notification;
2196
2197   return -1, "AddNotification: $result" if $result;
2198
2199   return $self->_addRecord('notification', %notification);
2200 } # AddNotification
2201
2202 sub DeleteNotification($) {
2203   my ($self, $name) = @_;
2204
2205   return $self->_deleteRecord('notification', "name='$name'");
2206 } # DeletePackage
2207
2208 sub FindNotification(;$$) {
2209   my ($self, $name, $cond, $ordering) = @_;
2210
2211   $name ||= '';
2212
2213   my $condition  = "name like '%$name%'";
2214      $condition .= " and $cond"
2215        if $cond;
2216
2217   return $self->_getRecords('notification', $condition);
2218 } # FindNotification
2219
2220 sub GetNotification($) {
2221   my ($self, $name) = @_;
2222
2223   return unless $name;
2224
2225   my @records = $self->_getRecords('notification', "name='$name'");
2226
2227   if ($records[0]) {
2228     return %{$records[0]};
2229   } else {
2230     return;
2231   } # if
2232 } # GetNotification
2233
2234 sub UpdateNotification($%) {
2235   my ($self, $name, %update) = @_;
2236
2237   return $self->_updateRecord(
2238     'notification',
2239     "name='$name'",
2240     %update
2241   );
2242 } # UpdateNotification
2243
2244 sub AddVobStorage(%) {
2245   my ($self, %vobstorage) = @_;
2246
2247   my @requiredFields = (
2248     'tag',
2249   );
2250
2251   my $result = _checkRequiredFields \@requiredFields, \%vobstorage;
2252
2253   return -1, "AddVobStorage: $result" if $result;
2254
2255   # Timestamp record
2256   $vobstorage{timestamp} = Today2SQLDatetime;
2257
2258   return $self->_addRecord('vobstorage', %vobstorage);
2259 } # AddVobStorage
2260
2261 sub AddViewStorage(%) {
2262   my ($self, %viewstorage) = @_;
2263
2264   my @requiredFields = (
2265     'tag',
2266   );
2267
2268   my $result = _checkRequiredFields \@requiredFields, \%viewstorage;
2269
2270   return -1, "AddViewStorage: $result" if $result;
2271
2272   # Timestamp record
2273   $viewstorage{timestamp} = Today2SQLDatetime;
2274
2275   return $self->_addRecord('viewstorage', %viewstorage);
2276 } # AddViewStorage
2277
2278 1;
2279
2280 =pod
2281
2282 =head1 CONFIGURATION AND ENVIRONMENT
2283
2284 DEBUG: If set then $debug is set to this level.
2285
2286 VERBOSE: If set then $verbose is set to this level.
2287
2288 TRACE: If set then $trace is set to this level.
2289
2290 =head1 DEPENDENCIES
2291
2292 =head2 Perl Modules
2293
2294 L<Carp>
2295
2296 L<DBI>
2297
2298 L<FindBin>
2299
2300 L<Net::Domain|Net::Domain>
2301
2302 =head2 ClearSCM Perl Modules
2303
2304 =begin man
2305
2306  DateUtils
2307  Display
2308  GetConfig
2309  Mail
2310
2311 =end man
2312
2313 =begin html
2314
2315 <blockquote>
2316 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
2317 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
2318 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
2319 <a href="http://clearscm.com/php/scm_man.php?file=lib/Mail.pm">Mail</a><br>
2320 </blockquote>
2321
2322 =end html
2323
2324 =head1 BUGS AND LIMITATIONS
2325
2326 There are no known bugs in this module
2327
2328 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
2329
2330 =head1 LICENSE AND COPYRIGHT
2331
2332 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
2333
2334 =cut