new gps-maintain.pl: for approval

Rewrite of gps-maintain.pl. No new features just a slightly better structure.
Maintained command line switches and operation, though a little quirky when not using -v or -delete, just falls through. The usage help strings also need somce attention, I got lazy.

I was unable to test this against a 'real' database, I injected a few records and watched it go. The process is simple enough that there should be no problems.

And of course, feel free to send it to /dev/null if it does not meet the needs/direction of the project.

Regards,
Michael

--- snip ----
#!/usr/bin/perl
# gps-maintain.pl Database maintenance script for gps
# (C) Michael Moritz
#
# 0.? 2005-02-14 complete rewrite
# 0.3 2004-09-14 included patch by Xin LI :
# replaced hardcoded dbname 'greylist' with
# value from config
# 0.2 2004-07-06 added age only functionality [mimo]

use strict;
use Getopt::Long qw(:config permute);
use DBI;

my @args = ();
my $configFile = ''; # i assume this will be defaulted at
# some point?
my %gpsConfig = ();

$SIG{__WARN__} = sub {
if ( $_[0] =~ /^Unknown option:/ ) {
# getopt triggered an unknown option
my $message = lc($_[0]); chomp($message);
usage("error: $message" );
return;
} else {
# handle warning as usual
warn @_;
}
};

#
# sub usage( string $message )
#
# display usage help and optionally display $message
#
sub usage {
my $message = shift;
my $bin = `basename $0`; chomp($bin);

if ( $message ) {
print STDOUT "$message\n";
}

print STDOUT "usage: $bin [options] -age=seconds \n";
print STDOUT "\n";
print STDOUT "options:\n";
print STDOUT " -age \t ..... [required]\n";
print STDOUT " -lt \t .....\n";
print STDOUT " -eq \t .....\n";
print STDOUT " -delete\t .....\n";
print STDOUT " -v,verbose\t .....\n";
print STDOUT " -debug \t shows variable dump-type-things and ... stuff.\n";
print STDOUT "\n";

exit 1;
}

#
# sub parseGpsConfigFile( string $filename )
#
# open and parse gps configuration file
# -- logic mainly untouched from original version
#
sub parseGpsConfigFile {
my $filename = shift;
my %gpsConfig = ();

open(CONFIG, "<$filename" ) or
die "can't open $filename: $!";

while ( ) {
chomp; # no newline
s/#.*//; # no comments
s/^\s+//; # no leading white
s/\s+$//; # no trailing white
next unless length; # anything left?
my ($var, $value) = split(/\s*=\s*/, $_, 2);

# sqlite fix/hack whatever you would like to deem it.
if ( (lc($var) eq 'dbtype') and (lc($value) eq 'sqlite') ) {
$value = 'SQLite'; # driver name is case sensitive
}

$gpsConfig{$var} = $value;
}
close(CONFIG);

# fix up the sqlite path/dbname stuff
if ( $gpsConfig{'dbtype'} eq 'SQLite' ) {
if ( !exists($gpsConfig{'db_sqlite_dbdir'}) ) {
# i don't like using die, it's output can be
# ugly and terse for non-programmers, but oh
# well.
die("error: database driver 'sqlite' specified but required 'db_sqlite_dbdir' option not specified in $filename.");
}
$gpsConfig{'dbname'} = $gpsConfig{'db_sqlite_dbdir'}.'/'.$gpsConfig{'db_dbname'};
}

return %gpsConfig;
}

#
# sub saveArgument( mixed $arg )
#
# store arguments passed from the command line which do not
# appear to be options.
#
sub saveArgument {
$args[++$#args] = shift;
}

#
# END SUBS
#

if ( $#ARGV == -1 ) {
# no command line options, show usage
usage();
}

# parse command line options
my %opts = ( 'verbose' => 0, 'debug' => 0 );

#
# note: ordering here is important. verbose|v will toggle the value
# of $opts{'verbose'} for -verbose and -v, were you to swap them to
# v|verbose the value $opts{'v'} would be set and all my tests against
# $opts{'verbose'} will fail, this goes for delete as well.
#
GetOptions( \%opts,
'verbose|v',
'debug',
'delete|d',
'eq=i',
'lt=i',
'age=i',
'h|?|help' => \&usage,
'<>' => \&saveArgument
);

if ( $#args < 0 ) {
usage('error: must specify the location of your configuration file. ');
}

# pop first extra arg off of @args and assume it's
# our configuration file.
$configFile = shift(@args);

# verify that required opt --age was provided
if ( !exists($opts{'age'}) ) {
usage('error: must specify required option value \'--age\'');
}

# verify that we only have '-lt' or '-gt' option
if ( exists($opts{'lt'}) && exists($opts{'eq'}) ) {
usage('error: please only specify \'-lt\' OR \'-eq\'');
}

# load and parse gps configuration file
%gpsConfig = parseGpsConfigFile( $configFile );

if ( $opts{'debug'} ) {
# display results of getopt pass
print STDERR ">>> BEGIN DEBUG DUMP <<<\n\n";
print STDERR "Getopt::Long Results\n";
print STDERR "--\n";
foreach my $key ( keys %opts ) {
print STDERR "$key\t= $opts{$key}\n";
}
print STDERR "\nExtra arguments:\n";
for( my $i=0;$i<=$#args; $i++) {
print STDERR " $i: $args[$i]\n";
}

# display results of parseGpsConfigFile()
print STDERR "\n";
print STDERR "Configuration values from: $configFile\n";
foreach my $key ( keys %gpsConfig ) {
print STDERR "$key \t= $gpsConfig{$key}\n";
}
print STDERR "\n>>> END DEBUG DUMP <<<\n\n";
}

# build sql query criteria
my $sql_clause = "";
my $uts = time() - $opts{'age'};

if ( exists($opts{'lt'}) ) {
# ??
$sql_clause = " WHERE uts < $uts AND count < $opts{'lt'}";
} elsif ( exists($opts{'eq'}) ) {
# ??
$sql_clause = " WHERE uts < $uts AND count = $opts{'eq'}";
}

if ( $opts{'verbose'} ) { print STDOUT "sql clause: $sql_clause\n"; }

# perform database operation
my $dsn = sprintf('DBI:%s:%s', $gpsConfig{'dbtype'}, $gpsConfig{'dbname'});
my $user = $gpsConfig{'db_username'};
my $pass = $gpsConfig{'db_password'};

if ( $opts{'verbose'} ) {
print STDOUT "using dsn: $dsn\n";
print STDOUT "username : $user\n";
print STDOUT "password : \n";
}

my $dbh = DBI->connect($dsn, $user, $pass ) or die('error: unable to establish a connection with the database.\n\t'.DBI->errstr);

if ( $opts{'verbose'} ) { print STDOUT "db: connection established\n"; }

# here we go ...
if ( $opts{'verbose'} ) {
# display entries before (if) they are removed
my $queryStr = "SELECT * FROM triplet $sql_clause";
print STDOUT "$gpsConfig{'dbtype'}: $queryStr\n";

my $sth = $dbh->prepare($queryStr) or
die("$gpsConfig{'dbtype'}: unable to prepare statement: ".$dbh->errstr);

$sth->execute() or
die("$gpsConfig{'dbtpye'}: unable to execute statement: ".$sth->errstr);

my $count = 1;
while ( my @data = $sth->fetchrow_array() ) {
print STDOUT "$count: ";
my $i = 0;
while($i < 5) {
print STDOUT $data[$i].", ";
$i++;
}
$count++;
print STDOUT "\n";
}

$sth->finish;
}

# and i'll see you on the darkside of the moon ...
if ( $opts{'delete'} ) {
my $queryStr = "DELETE FROM triplet $sql_clause";
my $affectedRows = $dbh->do( $queryStr ) or
die("$gpsConfig{'dbtype'}: error removing records: ".$dbh->errstr);
print STDOUT "Successfully removed $affectedRows row(s).\n";
}

$dbh->disconnect();

if ( $opts{'verbose'} ) { print STDOUT "db: disconnected.\n"; }

exit 0;