view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

#########################

# ------ pragmas + requires
require "ctime.pl";
use Test::More;
use Date::Format;
use Date::LastModified;
use Cwd;
use Date::Parse;
use File::Spec;
use File::stat;
eval {
    use DBI;
};
use strict;
use warnings;


# ------ define variables
my $dbh        = "";    # DBI object
my %dbi        = ();    # DBI databases
my $dbi_params = "";    # DBI database parameters hashref
my $dlm        = "";    # Date::LastModified object
my $file       = "";    # current filename
my $now        = "";    # current time for testing
my $num_dbs    = 0;     # number of database types to test
my $num_tests  = 0;     # number of tests to perform
my $sql        = "";    # SQL to manually accessing DB to check results
my $stat       = "";    # stat() results on $new_file
my $stat_time  = "";    # (printable) last-modified time from $stat
my $sth        = "";    # DBI statement handle
my $tmpdir              # temp dir for test files
 = File::Spec->tmpdir();


# ------ since we can load, prepare test directories
$tmpdir = "$tmpdir/Date-LastModified";
if (!-d $tmpdir) {
    if (-e $tmpdir) {
        unlink($tmpdir)
         || die "can't remove '$tmpdir' because: $!\n";
    }
    mkdir($tmpdir)
     || die "can't make directory '$tmpdir' because: $!\n";
    chmod(0700, $tmpdir)
     || die "can't change mode of '$tmpdir' to 0700 because: $!\n";
}
$now = time();
sub test_make_dir {
    my $name = shift;   # directory name + name of newest file in dir
    my $time = shift;   # modification + access time for dir

    mkdir("$tmpdir/$name")
     || die "can't make $name because: $!\n";
    open(OFH, ">$tmpdir/$name/file-new")
     || die "can't create $name/file-new because: $!\n";
    close(OFH)
     || die "can't close $name/file-new because: $!\n";
    open(OFH, ">$tmpdir/$name/old-file-1")
     || die "can't create $name/old-file-1 because: $!\n";
    close(OFH)
     || die "can't close $name/old-file-1 because: $!\n";
    utime($time - 60, $time - 60, "$tmpdir/$name/old-file-1")
     || die "can't change time on old-file-1 because: $!\n";
    open(OFH, ">$tmpdir/$name/old-file-2")
     || die "can't create $name/old-file-2 because: $!\n";
    close(OFH)
     || die "can't close $name/old-file-2 because: $!\n";
    utime($time - 120, $time - 120, "$tmpdir/$name/old-file-2")
     || die "can't change time on old-file-2 because: $!\n";
    utime($time, $time, "$tmpdir/$name/file-new")
     || die "can't change time on $name/file-new because: $!\n";
    utime($time, $time, "$tmpdir/$name")
     || die "can't change time on $name because: $!\n";
}
if (!-d "$tmpdir/dir-new") {
    test_make_dir("dir-new", $now);
    test_make_dir("dir-mid", $now - 24 * 60 * 60);       # 1 day old
    test_make_dir("dir-old", $now - 24 * 60 * 60 * 365); # 1 year old
}
$stat = stat("$tmpdir/dir-new/file-new")
 or die "can't stat $tmpdir/dir-new/file-new because: $!\n";
$stat_time = ctime($stat->mtime);


# ------ request database parameters for each known database
sub test_dbi_params {
    my $name     = shift;       # friendly name of database
    my $dbi_name = shift;       # DBI's name for database
    my $db       = "";          # database name
    my $params   = {};          # database parameters

    print "$name database name, or (none) if no $name: ";
    $db = <STDIN>;
    if ($db !~ m/^\s*$/) {
        chomp($db);
        $params->{"dbi"}      = "dbi:$dbi_name:$db";
        print "$name username: ";
        $_ = <STDIN>;
        chomp;
        $params->{"username"} = $_;
        print "$name password: ";
        $_ = <STDIN>;
        chomp;
        $params->{"password"} = $_;

test.pl  view on Meta::CPAN

     $dbi{"Oracle"}->{"username"}, $dbi{"Oracle"}->{"password"});
    test_dbi_error(DBI::errstr);
    $sth = $dbh->prepare($sql);
    test_dbi_error($sth->errstr);
    $sth->execute();
    test_dbi_error($sth->errstr);
    ($dbi{"Oracle"}->{"last"}) = $sth->fetchrow_array();
    test_dbi_error($sth->errstr);
    $sth->finish();
    ($dbi{"Oracle"}->{"last"}) = str2time($dbi{"Oracle"}->{"last"});
}
if (exists($dbi{"SQLite"})) {
    $sql =<<endSQL;
 SELECT
  $dbi{SQLite}->{column}
 FROM
  $dbi{SQLite}->{table}
 ORDER BY
  $dbi{SQLite}->{column}
  DESC
endSQL
    $dbh = DBI->connect($dbi{"SQLite"}->{"dbi"},
     $dbi{"SQLite"}->{"username"}, $dbi{"SQLite"}->{"password"});
    test_dbi_error(DBI::errstr);
    $sth = $dbh->prepare($sql);
    test_dbi_error($sth->errstr);
    $sth->execute();
    test_dbi_error($sth->errstr);
    ($dbi{"SQLite"}->{"last"}) = $sth->fetchrow_array();
    test_dbi_error($sth->errstr);
    $sth->finish();
    ($dbi{"SQLite"}->{"last"}) = str2time($dbi{"SQLite"}->{"last"});
}


# ------ calculate number of tests needed
$num_tests = 20;
if (exists($dbi{"mysql"})) {
    $num_tests += 4;
}
if (exists($dbi{"Oracle"})) {
    $num_tests += 4;
}
if (exists($dbi{"SQLite"})) {
    $num_tests += 4;
}
if ($num_dbs > 1) {
    $num_tests++;
}
plan(tests => $num_tests);


# ------ database test file generators
sub test_db_make_one_file {
    my $file = shift;           # database config file name
    my $code = shift;           # coderef to run on file

    open(OFH, ">$file") || die "can't create $file because: $!\n";
    &$code();
    close(OFH) || die "can't close $file because: $!\n";
    chmod(0600, $file) || die "can't chmod $file because: $!\n";
}
sub test_db_make_files {
    my $db     = shift;         # database info
    my $name   = shift;         # database name
    my $create = "";            # code to create file contents

    # ------ create database info cache file
    $create = sub {
        print OFH<<endPRINT;
$db->{dbi}
$db->{username}
$db->{password}
$db->{table}
$db->{column}
endPRINT
    };
    test_db_make_one_file("$tmpdir/dbi-$name-cache", $create);

    # ------ config for one database resource, user+pass sent directly
    $create = sub {
        print OFH<<endPRINT;
dlm_dbi = $db->{dbi},$db->{username},$db->{password},$db->{table},$db->{column}
endPRINT
    };
    test_db_make_one_file("$tmpdir/datelastmod-dbi-$name-1.cfg", $create);

    # ------ create password file
    $create = sub {
        print OFH <<endPASSFILE;
DbUsername $db->{username}
DbPassword $db->{password}
endPASSFILE
    };
    test_db_make_one_file("$tmpdir/dbi-$name-passwd", $create);

    # ------ config file for one database resource, using password file
    $create = sub {
        print OFH<<endPRINT;
dlm_dbi = $db->{dbi},$tmpdir/dbi-$name-passwd,$db->{table},$db->{column}
endPRINT
    };
    test_db_make_one_file("$tmpdir/datelastmod-dbi-$name-1indir.cfg", $create);

    # ------ config file for database resource newer than other resource
    $create = sub {
        print OFH<<endPRINT;
dlm_dbi = $db->{dbi},$db->{username},$db->{password},$db->{table},$db->{column}
dlm_file = $tmpdir/dir-old/file-new
endPRINT
    };
    test_db_make_one_file("$tmpdir/datelastmod-dbi-$name-newdb.cfg", $create);

    # ------ config file for database resource older than other resource
    $create = sub {
        print OFH<<endPRINT;
dlm_dbi = $db->{dbi},$db->{username},$db->{password},$db->{table},$db->{column}
dlm_file = $tmpdir/dir-new/file-new
endPRINT
    };
    test_db_make_one_file("$tmpdir/datelastmod-dbi-$name-olddb.cfg", $create);