#! /usr/bin/perl -w
$ID = q$Id: afsdb-reports,v 1.19 2005/02/04 05:07:56 eagle Exp $;
#
# afsdb-reports -- Generate nightly reports from the AFS database.
#
# Orignally written by Neil Crellin <neilc@stanford.edu>
# Rewritten by Russ Allbery <rra@stanford.edu>
#          and Jonathan Pilat <jonpilat@stanford.edu>
# Copyright 1998, 2001, 2004, 2005
#     Board of Trustees, Leland Stanford Jr. University
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# Run a sequence of nightly reports on the AFS database and mail the results.

##############################################################################
# Site configuration
##############################################################################

# Address to which to mail the nightly database reports (minor spam blocking).
$ADDRESS = 'afs-reports' . '@stanford.edu';

##############################################################################
# Modules and declarations
##############################################################################

require 5.005;

use strict;
use vars qw($ADDRESS $ID @REPORTS);

use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);
use Stanford::LSDB::AFSDB;

##############################################################################
# Reports
##############################################################################

# To write a new report, add a new record to this array including the header,
# the SQL to execute, and a reference to the sub that retrieves the results
# from a statement handle and prints out the report.
@REPORTS = (
[
    'Off-line volumes',
    q{select volname, server, part from volumes
          where status = 'Off-line'
          order by volname},
    sub { printf "%-31s on %8s %8s is off-line\n", @_ }
],
[
    'Volumes with more than one million accesses',
    q{select volname, accesses from volumes
          where accesses > 1000000
          order by accesses desc},
    sub {
        my ($volume, $accesses) = @_;
        1 while $accesses =~ s/^(\d+)(\d{3})/$1,$2/;
        printf "%-31s %10s accesses\n", $volume, $accesses;
    }
],
[
    'Volumes with stray ghosts',
    q{select volname, server, part from volumes a
          where type = 'RW'
            and exists
                (select volname from volume_count b
                    where b.volname = a.volname
                      and count > 1)
          order by volname},
    sub { printf "%-31s on %8s %8s\n", @_ }
],
[
    'Partitions with more than 1000 volumes',
    q{select server, part, count, type from partition_count
          where count > 1000
          order by server, part},
    sub { printf "%8s %8s contains %4d %s volumes\n", @_ }
],
[
    'Volumes for which mountpoints are not currently stored',
    q{select volname from volumes a
          where type = 'RW'
            and not exists
                (select volname from mountpoints b
                    where b.volname = a.volname)
          order by volname},
    sub { print @_, "\n" }
],
[
    'Volumes containing new unreleased changes',
    q{select a.volname from unreleased_changes a
          where not exists
              (select b.volname from old_unreleased_changes b
                   where a.volname = b.volname)
          order by a.volname},
    sub { print @_, "\n" }
],
[
    'Volumes containing new changes to unreleased changes',
    q{select a.volname from unreleased_changes a
          where exists
              (select b.volname from old_unreleased_changes b
                   where a.volname = b.volname)
            and exists
              (select c.volname from previous_volumes c, volumes d
                   where c.volname = d.volname
                     and a.volname = c.volname
                     and c.updated < d.updated
                     and c.type = 'RW')
         order by a.volname},
    sub { print @_, "\n" }
],
[
    'Volumes containing unreleased changes',
    q{select volname from unreleased_changes order by volname},
    sub { print @_, "\n" }
],
[
    'Replicated volumes released',
    q{select distinct a.volname, to_char(b.updated, 'YYYY-MM-DD HH24:MI:SS')
          from volumes a, volumes b
          where a.roid = b.volid
            and a.type = 'RW'
            and b.type = 'RO'
            and b.volname in
                (select c.volname from volumes c, previous_volumes d
                    where c.volid = d.volid
                      and d.type = 'RO'
                      and c.updated > d.updated)
          order by a.volname},
    sub { printf "%-22s released at %s\n", @_ }
],
[
    'Volumes renamed',
    q{select a.volname, b.volname from previous_volumes a, volumes b
          where a.volid = b.volid
            and a.type = 'RW'
            and a.volname != b.volname
          order by a.volname},
    sub { printf "%-31s renamed to %s\n", @_ }
],
[
    'Volumes newly added',
    q{select volname, server, part, used, quota from volumes a
          where (a.type = 'RW' or a.type = 'RO') 
            and not exists
              (select volname from previous_volumes b
                   where b.volname = a.volname)
          order by volname},
    sub {
        my @data = @_;
        $data[3] /= 1000;
        $data[4] /= 1000;
        printf "%-31s on %8s %8s, %7.2fMB of %7.2fMB\n", @data;
    }
],
[
    'Volumes deleted',
    q{select volname, server, part, used, quota from previous_volumes a
          where (a.type = 'RW' or a.type = 'RO') 
            and not exists
              (select volname from volumes b where b.volname = a.volname)
          order by volname},
    sub {
        my @data = @_;
        $data[3] /= 1000;
        $data[4] /= 1000;
        printf "%-31s on %8s %8s, %7.2fMB of %7.2fMB\n", @data;
    }
],
[
    'RW volumes relocated',
    q{select a.volname, a.server, a.part, b.server, b.part
          from previous_volumes a, volumes b
          where a.volname = b.volname
            and a.type = 'RW'
            and not (a.server = b.server and a.part = b.part)
          order by a.server, a.part, a.volname},
    sub { printf "%-22s moved from %8s %8s to %8s %8s\n", @_ }
],
[
    'Volumes which grew more than 200MB',
    q{select a.volname, b.server, b.part, a.used, b.used
          from previous_volumes a, volumes b
          where a.volid = b.volid
            and a.type = 'RW'
            and ((b.used - a.used) > 200000)
          order by (b.used - a.used) desc},
    sub {
        my @data = @_;
        $data[3] /= 1000;
        $data[4] /= 1000;
        printf "%-31s (%8s %8s) was %7.2fMB now %7.2fMB\n", @data;
    }
]);

##############################################################################
# Main routine
##############################################################################

# Read in command-line options.
my ($help, $mail, $version);
Getopt::Long::config ('no_ignore_case', 'bundling');
GetOptions ('help|h'    => \$help,
            'mail|m'    => \$mail,
            'version|v' => \$version) or exit 1;
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $0);
} elsif ($version) {
    my $version = join (' ', (split (' ', $ID))[1..3]);
    $version =~ s/,v\b//;
    $version =~ s/(\S+)$/($1)/;
    $version =~ tr%/%-%;
    print $version, "\n";
    exit;
}

# Clean up $0 for error reporting.
$0 =~ s%.*/%%;

# If sending the report via mail, open a pipe to sendmail and switch our
# default out over.
if ($mail) {
    my $date = strftime ('%Y-%m-%d', localtime time);
    open (MAIL, '| /usr/lib/sendmail -t -oi -oem')
        or die "$0: cannot fork sendmail: $!\n";
    print MAIL "From: root\n";
    print MAIL "To: $ADDRESS\n";
    print MAIL "Subject: AFS daily report ($date)\n\n";
    select MAIL;
}

# Connect to the database.
my $dbh = Stanford::LSDB::AFSDB->connect
    or die "$0: cannot connect to database\n";

# Run each query.  Only print out the section heading if there is anything to
# report.
for (@REPORTS) {
    my ($heading, $query, $report) = @$_;
    my $sth = $dbh->prepare ($query);
    $sth->execute;
    my @data = $sth->fetchrow_array;
    if (@data) {
        print "$heading\n\n";
        &$report (@data);
        while (@data = $sth->fetchrow_array) {
            &$report (@data);
        }
        print "\n";
    }
}
$dbh->disconnect;

##############################################################################
# Documentation
##############################################################################

=head1 NAME

afsdb-reports - Generate nightly reports from the AFS database

=head1 SYNOPSIS

afsdb-reports [B<-hmv>]

=head1 DESCRIPTION

Run a series of nightly reports from the data in the AFS database and print
the results to standard out, or mail them to afs-reports at stanford.edu if
the B<-m> option is specified.

The reports are all contained in this script.  To add a new report, add a
new entry to the @REPORTS array at the top of the script, specifying the
heading, the SQL query to run, and a reference to a sub to process and print
out each line of the results.  The sub will be called repeatedly for every
returned row and be passed all of the data elements returned by the query
for each row as parameters.

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script to
C<perldoc -t>).

=item B<-m>, B<--mail>

Mail the report to afs-reports at stanford.edu rather than printing it to
standard output.

=item B<-v>, B<--version>

Print the version of B<afsdb-reports> and exit.

=back

=head1 AUTHORS

Orignally written by Neil Crellin <neilc@stanford.edu>.  Rewritten by Russ
Allbery <rra@stanford.edu> and Jonathan Pilat <jonpilat@stanford.edu> to use
Oracle and the Stanford::LSDB::AFSDB module, to include all of the reports
in the script, and to simplify, improve, and optimize the SQL.

=head1 COPYRIGHT AND LICENSE

Copyright 1998, 2001, 2004, 2005 Board of Trustees, Leland Stanford
Jr. University.

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

The current version of this program is available from the AFS reporting
database software page at L<http://www.eyrie.org/~eagle/software/afsdb/>.

=cut