Date-LastModified

 view release on metacpan or  search on metacpan

bin/dlmup.PL  view on Meta::CPAN

use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//i;
open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!";
$Config{'startperl'} -w
#
!GROK!THIS!

print OUT <<'!NO!SUBS!';
# Update 0+ files from Date::LastModified config.

test-dlmup.pl  view on Meta::CPAN

# ------ missing input file
$output = join(" ", `bin/dlmup -f$tmpdir/datelastmod-1file.cfg "Last updated \\w+ \\d+, \\d+" "%B %e, %Y" never-exist.zed 2>&1`);
like($output, qr/can't open 'never-exist.zed' because/,
 "missing input file");


# ------ can't create output file
create_test_file("unwritable.html.dlmup");
chmod(0400, "unwritable.html.dlmup")
 || die "can't chmod 0400 unwritable.html.dlmup because: $!\n";
$output = join(" ", `bin/dlmup -f$tmpdir/datelastmod-1file.cfg "Last updated \\w+ \\d+, \\d+" "%B %e, %Y" unwritable.html 2>&1`);
like($output, qr/can't create 'unwritable.html.dlmup' because/,
 "can't create output file");


# ------ fail on first of multiple files
$output = join(" ", `bin/dlmup -f$tmpdir/datelastmod-1file.cfg "Last updated \\w+ \\d+, \\d+" "%B %e, %Y" unwritable.html never-exist.zed 2>&1`);
like($output, qr/can't create 'unwritable.html.dlmup' because/,
 "fail on first of multiple files (part 1)");
unlike($output, qr/can't open 'never-exist.zed'/,

test.pl  view on Meta::CPAN

# ------ 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")

test.pl  view on Meta::CPAN

# ------ 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}