--- projects/cms/source/reports/rrdgraphing/graph.pl	2002/05/18 18:15:59	1.2
+++ projects/cms/source/reports/rrdgraphing/graph.pl	2002/05/21 15:01:43	1.5
@@ -26,31 +26,78 @@
 # Generates graphs from rrd databases for i-scream data.
 #
 # $Author: tdb $
-# $Id: graph.pl,v 1.2 2002/05/18 18:15:59 tdb Exp $
+# $Id: graph.pl,v 1.5 2002/05/21 15:01:43 tdb Exp $
 #------------------------------------------------------------
 
 ## TODO
 # possibly make more configurable?
 #  -- allow configurable periods of graphs
 #  -- comments, types, etc
-#  -- move all to external config file
 
+my($version) = '$Id: graph.pl,v 1.5 2002/05/21 15:01:43 tdb Exp $';
+
 $| = 1;
+
 use strict;
+use Getopt::Std;
 use RRDs;
 
-# Base directory for images
-# (a directory will be constructed for each host under this)
-my($imgdir) = "/home/pkg/iscream/public_html/graphs";
+# define variables that will be read from the config
+# nb. keep this insync with the config file!
+use vars qw{ 
+    $imgdir $rrddir                     
+    $maxrrdage $maximgage $deleterrds $deleteimgs
+    $hex_slash $hex_underscore  
+    $rrdstep $retry_wait
+    $verbose $quiet
+};
 
-# Location of RRD databases
-my($rrddir) = "/u1/i-scream/databases";
+# default locate of the config file
+my($configfile) = "rrdgraphing.conf";
 
-# / converted to a decimal then hex'd
-my($hex_slash) = "_2f";
-# _ converted to a decimal then hex'd
-my($hex_underscore) = "_5f";
-        
+# check for command line arguments
+my(%opts);
+my($ret) = getopts('hvqVc:', \%opts);
+
+# if invalid argument given, $ret will not be 1
+&usage() if $ret != 1;
+
+# first process the arguments which might mean we exit now
+
+# -h is usage
+if($opts{h}) {
+    &usage();
+}
+# -V is version
+if($opts{V}) {
+    print "graph.pl version: $version\n";
+    exit(1);
+}
+
+# Then try getting the config
+
+# -c specifies the config file location
+if($opts{c}) {
+    $configfile = $opts{c};
+}
+# suck in the config
+&log("reading config from $configfile\n");
+do $configfile;
+
+# Then any options we might want to override the config with
+
+# -v is verbose
+if($opts{v}) {
+    $verbose = $opts{v};
+}
+# -q is verbose
+if($opts{q}) {
+    $quiet = $opts{q};
+    # if we're meant to be quiet, we can hardly be verbose!
+    $verbose = 0;
+}
+
+
 # Read the contents of the base directory
 # and pull out the list of subdirectories (except . and .. :)
 opendir(DIR, $rrddir);
@@ -68,6 +115,23 @@ foreach my $machine (@rrddirlist) {
     # See what rrd we have, and generate the graphs accordingly
     foreach my $rrd (@rrdlist) {
         chomp $rrd;
+        # stat the file
+        my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+         $ctime,$blksize,$blocks) = stat("$rrddir/$machine/$rrd");
+        # check if it's old enough to be deleted
+        if((time - $mtime) > $maxrrdage) {
+            # do we delete the rrd, or just ignore it?
+            if($deleterrds) {
+                # if so, delete it
+                unlink("$rrddir/$machine/$rrd");
+                &log("deleted old rrd $rrddir/$machine/$rrd\n");
+            }
+            else {
+                &log("ignored old rrd $rrddir/$machine/$rrd\n");
+            }
+            # no more processing required for this rrd
+            next;
+        }
         if($rrd =~ /^(cpu)\.rrd$/) {
             my(@data);
             my(@rawdata);
@@ -163,8 +227,63 @@ foreach my $machine (@rrddirlist) {
             &makegraph($machine, $baserrd, $comment, \@data, \@rawdata);
         }
     }
+    # have a last check, maybe we can remove the directory now?
+    # (only if we're deleting stuff)
+    if($deleterrds) {
+        # Read the contents of the directory
+        opendir(DIR, "$rrddir/$machine");
+        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
+        closedir DIR;
+        if($#dirlist == -1) {
+            rmdir "$rrddir/$machine";
+            &log("deleting empty rrd directory $rrddir/$machine\n");
+        }
+    }
 }
 
+if($deleteimgs) {
+    # Read the contents of the graphs directory
+    # and pull out the list of subdirectories (except . and .. :)
+    opendir(DIR, $imgdir);
+    my(@imgdirlist) = grep { -d "$imgdir/$_" && !/^\.$/ && !/^\.\.$/ } readdir(DIR);
+    closedir DIR;
+
+    # look through each directoty, as they might
+    # contain images for a particular machine
+    foreach my $machine (@imgdirlist) {
+        # Read the contents of the directory
+        opendir(DIR, "$imgdir/$machine");
+        my(@imglist) = grep { /\.png$/ && -f "$imgdir/$machine/$_" } readdir(DIR);
+        closedir DIR;
+
+        # See what rrd we have, and generate the graphs accordingly
+        foreach my $img (@imglist) {
+            chomp $img;
+            # stat the img
+            my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+             $ctime,$blksize,$blocks) = stat("$imgdir/$machine/$img");
+            # check if it's old enough to be deleted
+            if((time - $mtime) > $maximgage) {
+                # if so, delete it
+                unlink("$imgdir/$machine/$img");
+                &log("deleted old image $imgdir/$machine/$img\n");
+            }
+        }
+        # have a last check, maybe we can remove the directory now?
+        # Read the contents of the directory
+        opendir(DIR, "$imgdir/$machine");
+        my(@dirlist) = grep { !/^\.$/ && !/^\.\.$/ } readdir(DIR);
+        closedir DIR;
+        if($#dirlist == -1) {
+            rmdir "$imgdir/$machine";
+            &log("deleted empty image directory $imgdir/$machine\n");
+        }
+    }
+}
+
+exit(0);
+
+
 #
 # subroutine to make some graphs
 #
@@ -190,6 +309,7 @@ sub makegraph() {
     if(! -d "$imgdir/$machine") {
         # not sure on this umask, but it seems to work?
         mkdir "$imgdir/$machine", 0777;
+        &log("created directory $imgdir/$machine\n");
     }
     my(@rrdcmd);
     foreach my $dataitem (@data) {
@@ -211,19 +331,24 @@ sub makegraph() {
     push @rrdcmd, @rawcmd;
     RRDs::graph ("$imgdir/$machine/$type-3h.png", "--start=-10800", @rrdcmd);
     my($err_3h) = RRDs::error;
-    print STDERR "Error generating 3h graph for $machine/$type: $err_3h\n" if $err_3h;
+    &log("created $imgdir/$machine/$type-3h.png\n") unless $err_3h;
+    &error("Error generating 3h graph for $machine/$type: $err_3h\n") if $err_3h;
     RRDs::graph ("$imgdir/$machine/$type-1d.png", "--start=-86400", @rrdcmd);
     my($err_1d) = RRDs::error;
-    print STDERR "Error generating 1d graph for $machine/$type: $err_1d\n" if $err_1d;
+    &log("created $imgdir/$machine/$type-1d.png\n") unless $err_1d;
+    &error("Error generating 1d graph for $machine/$type: $err_1d\n") if $err_1d;
     RRDs::graph ("$imgdir/$machine/$type-1w.png", "--start=-604800", @rrdcmd);
     my($err_1w) = RRDs::error;
-    print STDERR "Error generating 1w graph for $machine/$type: $err_1w\n" if $err_1w;
+    &log("created $imgdir/$machine/$type-1w.png\n") unless $err_1w;
+    &error("Error generating 1w graph for $machine/$type: $err_1w\n") if $err_1w;
     RRDs::graph ("$imgdir/$machine/$type-1m.png", "--start=-2678400", @rrdcmd);
     my($err_1m) = RRDs::error;
-    print STDERR "Error generating 1m graph for $machine/$type: $err_1m\n" if $err_1m;
+    &log("created $imgdir/$machine/$type-1m.png\n") unless $err_1m;
+    &error("Error generating 1m graph for $machine/$type: $err_1m\n") if $err_1m;
     RRDs::graph ("$imgdir/$machine/$type-1y.png", "--start=-31536000", @rrdcmd);
     my($err_1y) = RRDs::error;
-    print STDERR "Error generating 1y graph for $machine/$type: $err_1y\n" if $err_1y;
+    &log("created $imgdir/$machine/$type-1y.png\n") unless $err_1y;
+    &error("Error generating 1y graph for $machine/$type: $err_1y\n") if $err_1y;
     return;
 }
 
@@ -249,4 +374,29 @@ sub get_colour {
     else {
         return "#000066";
     }
+}
+
+# prints out usage information then exits
+sub usage() {
+    print "Usage: graph.pl [options]\n";
+    print "Options\n";
+    print "  -c config        Specifies the configuration file\n";
+    print "                    default: rrdgraphing.conf\n";
+    print "  -v               Be verbose about what's happening\n";
+    print "  -q               Be quiet, even supress errors\n";
+    print "  -V               Print version number\n"; 
+    print "  -h               Prints this help page\n";
+    exit(1);
+}       
+
+# prints a log message if verbose is turned on
+sub log() {
+    my($msg) = @_;
+    print $msg if $verbose;
+}
+
+# prints an error message unless quiet is turned on
+sub error() {
+    my($msg) = @_;
+    print STDERR $msg unless $quiet;
 }