# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 01.t'
# 03.t
END {print "not ok 1\n" unless $loaded;}
use Test::Simple tests =>
48;
use lib ("./t");
use Mail::Digest::Tools qw(:all);
use Test::_Test_MDT;
use File::Copy;
use Cwd;
my $startdir = cwd(); # startdir is dir where Makefile.PL is located
$loaded = 1;
ok($loaded); # 1
use strict;
use warnings;
our (%digest_structure, %digest_output_format);
# variables imported from $data_file
our %unix = map {$_, 1}
qw| Unix linux darwin freebsd netbsd openbsd mirbsd cygwin solaris |;
my $data_file = 'samples/digest.data';
require $data_file;
# test of digests.data info and existence of key directories
# see 01.t
my (%pw32u_config_in, %pw32u_config_out);
my @intersect;
my ($k,$v);
while ( ($k, $v) = each %{$digest_structure{'pw32u'}} ) {
$pw32u_config_in{$k} = $v;
}
while ( ($k, $v) = each %{$digest_output_format{'pw32u'}} ) {
$pw32u_config_out{$k} = $v;
}
my ($digs, %log);
my ($pw32u_digdir, $pw32u_thrdir);
$pw32u_digdir = "$pw32u_config_out{'dir_digest'}";
$pw32u_thrdir = "$pw32u_config_out{'dir_threads'}";
########## Test of process_new_digests() on pw32u ##########
# predict names and number of threads files to be created
# (by observation)
my (@pw32u_tp);
if ($unix{$^O}) { # 3/11/2004 revision
@pw32u_tp = sort {lc($a) cmp lc($b)} (
'Net::SSH::Perl.thr.txt',
'Perl and delphi interaction query.thr.txt',
'qx broken on Win98.thr.txt',
);
} elsif ($^O eq 'MSWin32') {
@pw32u_tp = sort {lc($a) cmp lc($b)} (
'NetSSHPerl.thr.txt',
'Perl and delphi interaction query.thr.txt',
'qx broken on Win98.thr.txt',
);
} else {
die "Mail::Digest::Tools not available for operating system $^O: $!";
}
ok(@pw32u_tp == 3, 'Predict 3 threads from pw32u');# 2
# 0th element in value: by observation, predict number of messages in
# each thread file created
# 1st element in value: by observation, predict number of paragraphs in each
# message in each thread file created
my %pw32u_tp = (
$pw32u_tp[0] => [ 7, [ 10, 6, 5, 6, 6, 4, 10 ] ],
$pw32u_tp[1] => [ 4, [ 12, 6, 6, 6 ] ],
$pw32u_tp[2] => [ 6, [ 8, 6, 5, 6, 8, 8 ] ],
);
# predict message numbers found within each thread file created
# (by observation)
my %pw32u_messp = (
$pw32u_tp[0] => [ qw|
001_0001_0001
001_0002_0001
001_0002_0003
001_0002_0004
001_0002_0005
001_0002_0006
001_0002_0013
| ],
$pw32u_tp[1] => [ qw|
001_0001_0002
001_0001_0003
001_0002_0002
001_0002_0014
| ],
$pw32u_tp[2] => [ qw|
001_0002_0007
001_0002_0008
001_0002_0009
001_0002_0010
001_0002_0011
001_0002_0012
| ],
);
# determine number of digests needing processing
opendir DIG, $pw32u_digdir or die "Couldn't open directory $pw32u_digdir: $!";
$log{'digs'} = scalar(
grep { /$pw32u_config_in{'grep_formula'}/ } readdir DIG);
closedir DIG or die "Couldn't close directory $pw32u_digdir: $!";
ok($log{'digs'} == 2, '2 pw32u digests found before processing'); # 3
# verify log files are empty or do not yet exist
my $dl = $pw32u_config_out{'digests_log'};
my $dr = $pw32u_config_out{'digests_read'};
my $drf = $pw32u_config_out{'digests_read_flag'};
my $tt = $pw32u_config_out{'todays_topics'};
$log{'log'}{'size'}[0] = (-f $dl) ? (-s $dl) : 0;
$log{'read'}{'size'}[0] = ( (-f $dr) and $drf) ? (-s $dr) : undef;
$log{'topics'}{'size'}[0] = (-f $tt) ? (-s $tt) : 0;
$log{'log'}{'records'}[0] = (-f $dl) ? count_records($dl, "\n") : 0;
$log{'read'}{'records'}[0] = ((-f $dr) and $drf) ? count_records($dr, "\n\n") : 0;
$log{'topics'}{'records'}[0] = (-f $tt) ? count_records($tt, "\n\n") : 0;
ok($log{'log'}{'records'}[0] == 0, 'digests_log currently empty'); # 4
ok($log{'read'}{'records'}[0] == 0, 'digests_read currently empty'); # 5
ok($log{'topics'}{'records'}[0] == 0, 'todays_topics currently empty'); # 6
# run Mail::Digest::tools function
process_new_digests(\%pw32u_config_in, \%pw32u_config_out);
# test whether log files have grown in size
$log{'log'}{'size'}[1] = (-s $dl);
$log{'read'}{'size'}[1] = ( (-f $dr) and $drf) ? (-s $dr) : undef;
$log{'topics'}{'size'}[1] = (-s $tt);
ok($log{'log'}{'size'}[1] > $log{'log'}{'size'}[0]);# 7
ok( # 8
(
(
! defined $log{'read'}{'size'}[0]
and
! defined $log{'read'}{'size'}[1]
)
or
(
(
defined $log{'read'}{'size'}[0]
and
defined $log{'read'}{'size'}[1]
)
and
(
$log{'read'}{'size'}[1] > $log{'read'}{'size'}[0]
)
)
), 'digests read for pw32u has grown'
);
ok($log{'topics'}{'size'}[1] > $log{'topics'}{'size'}[0],# 9
'todays topics for pw32u has grown');
# test whether log files have grown by correct number of records
$log{'log'}{'records'}[1] = (-f $dl) ? count_records($dl, "\n") : 0;
$log{'read'}{'records'}[1] = ((-f $dr) and $drf) ? count_records($dr, "\n\n") : 0;
$log{'topics'}{'records'}[1] = (-f $tt) ? count_records($tt, "\n\n") : 0;
ok($log{'log'}{'records'}[0] + $log{'digs'} == # 10
$log{'log'}{'records'}[1],
'digests_log grew by predicted number of records');
ok( # 11
(
(
! defined $log{'read'}{'size'}[0]
and
! defined $log{'read'}{'size'}[1]
)
or
(
(
defined $log{'read'}{'size'}[0]
and
defined $log{'read'}{'size'}[1]
)
and
(
$log{'read'}{'records'}[0] + $log{'digs'} + 1 ==
$log{'read'}{'records'}[1]
)
)
), 'digests_read grew by predicted number of records'
);
ok($log{'topics'}{'records'}[0] + $log{'digs'} == # 12
$log{'topics'}{'records'}[1],
'todays_topics grew by predicted number of records');
# test whether correct number of threads files have been created
chdir $pw32u_thrdir or die "Couldn't change to pw32u threads dir: $!";
opendir DIR, $pw32u_thrdir or die "Couldn't open dir: $!";
my @pw32u_tc = sort {lc($a) cmp lc($b)} grep {/\.thr\.txt$/} readdir DIR;
closedir DIR or die "Couldn't close dir: $!";
ok(@pw32u_tc == 3, '3 threads created from pw32u');# 13
# test whether thread files have names predicted
ok($pw32u_tp[0] eq $pw32u_tc[0], 'Net::SSH::Perl.thr.txt');# 14
ok($pw32u_tp[1] eq $pw32u_tc[1], 'Perl and delphi interaction query.thr.txt');# 15
ok($pw32u_tp[2] eq $pw32u_tc[2], 'qx broken on Win98.thr.txt');# 16
#my $lcpw = List::Compare->new(\@pw32u_tp, \@pw32u_tc);
#ok( ($lcpw->get_intersection()) == @pw32u_tp,
# 'all pw32u threads predicted have been created');
@intersect = get_intersection(\@pw32u_tp, \@pw32u_tc);
ok(@intersect == @pw32u_tp, # 17
'all pw32u threads predicted have been created');
# test whether thread files have predicted message count
my $tmd = $pw32u_config_out{'thread_msg_delimiter'};
ok(${$pw32u_tp{$pw32u_tp[0]}}[0] == verify_message_count(# 18
$pw32u_tc[0], $tmd));
ok(${$pw32u_tp{$pw32u_tp[1]}}[0] == verify_message_count(# 19
$pw32u_tc[1], $tmd));
ok(${$pw32u_tp{$pw32u_tp[2]}}[0] == verify_message_count(# 20
$pw32u_tc[2], $tmd));
# test whether messages in thread files are correct and appear in
# predicted sequence
ok( compare_arrays(\@{$pw32u_messp{$pw32u_tp[0]}}, # 21
get_message_numbers_created($pw32u_tc[0], $tmd) ) );
ok( compare_arrays(\@{$pw32u_messp{$pw32u_tp[1]}}, # 22
get_message_numbers_created($pw32u_tc[1], $tmd) ) );
ok( compare_arrays(\@{$pw32u_messp{$pw32u_tp[2]}}, # 23
get_message_numbers_created($pw32u_tc[2], $tmd) ) );
# test whether messages in thread files have predicted number of paragraphs
ok( compare_arrays(${$pw32u_tp{$pw32u_tp[0]}}[1], # 24
get_paragraph_count($pw32u_tp[0], $tmd) ) );
ok( compare_arrays(${$pw32u_tp{$pw32u_tp[1]}}[1], # 25
get_paragraph_count($pw32u_tp[1], $tmd) ) );
ok( compare_arrays(${$pw32u_tp{$pw32u_tp[2]}}[1], # 26
get_paragraph_count($pw32u_tp[2], $tmd) ) );
chdir $startdir or die "Couldn't change back to $startdir: $!";
# run Mail::Digest::tools function reply_to_digest_message()
my $digest_number = 2;
my $digest_entry = 14;
my $directory_for_reply = "$startdir/t/samples/pw32u/Threads";
my $full_reply_file = reply_to_digest_message(
\%pw32u_config_in,
\%pw32u_config_out,
$digest_number,
$digest_entry,
$directory_for_reply,
);
# make sure appropriately named reply file was created and that it has the
# correct number of paragraphs
my $rtsf = defined $pw32u_config_in{'reply_to_style_flag'} ? 1 : 0;
my $reply_file_predicted =
"$directory_for_reply/Perl and delphi interaction query.reply.txt";
my $total_paragraphs_predicted = 3 + $rtsf;
my $text_paragraphs_replied_to_predicted = 5;
ok(-f $reply_file_predicted); # 27
ok($total_paragraphs_predicted == # 28
get_paragraph_count_reply($reply_file_predicted) );
ok($text_paragraphs_replied_to_predicted == # 29
get_paragraphs_replied_to_count($reply_file_predicted, $rtsf) );
#######################################################################
# below: tests of repair_message_order()
# problem for testing: repair_message_order() overwrites its files
# so I'll have to store the wrongly-ordered files somewhere, make predictions
# as to the outcome, then move the files into the directory where the function
# will actually be called
# then, examine those new files to see if they match the predictions
my ($need_fix_dir, @need_fix_files, $dir_threads_orig, $repair_dir);
my (@pw32u_fp, %pw32u_fp, %pw32u_fmessp);
my (@pw32u_fc);
$need_fix_dir = "$startdir/t/needfix/pw32u";
chdir $need_fix_dir or die "Couldn't change to $need_fix_dir: $!";
opendir DIR, $need_fix_dir or die "Couldn't open $need_fix_dir: $!";
@need_fix_files = grep {/\.fix\.thr\.txt$/} readdir DIR;
closedir DIR or die "Couldn't close $need_fix_dir: $!";
foreach my $nff (@need_fix_files) {
copy $nff, "$startdir/t/repair/pw32u/$nff" or die "Couldn't copy fix file: $!";
}
chdir $startdir or die "Couldn't change back to $startdir: $!";
$dir_threads_orig = $pw32u_config_out{'dir_threads'};
$pw32u_config_out{'dir_threads'} = "$startdir/t/repair/pw32u";
@pw32u_fp = ( qw|
Perl_and_delphi_interaction_query.fix.thr.txt
qx_broken_on_Win98.fix.thr.txt
|);
%pw32u_fp = (
$pw32u_fp[0] => [ 4, [ 12, 6, 6, 6 ] ],
$pw32u_fp[1] => [ 6, [ 8, 6, 5, 6, 8, 8 ] ],
);
%pw32u_fmessp = (
$pw32u_fp[0] => [ qw|
001_0001_0002
001_0001_0003
001_0002_0002
001_0002_0014
| ],
$pw32u_fp[1] => [ qw|
001_0002_0007
001_0002_0008
001_0002_0009
001_0002_0010
001_0002_0011
001_0002_0012
| ],
);
# run Mail::Digest::Tools function repair_message_order()
repair_message_order (
\%pw32u_config_in,
\%pw32u_config_out,
{ year => 2000, month => 01, day => 01 },
);
# test whether correct number of threads files have been fixed
$repair_dir = "$startdir/t/repair/pw32u";
chdir $repair_dir or die "Couldn't change to pw32u threads dir: $!";
opendir DIR, $repair_dir or die "Couldn't open dir: $!";
@pw32u_fc = sort {lc($a) cmp lc($b)} grep {/\.fix\.thr\.txt$/} readdir DIR;
closedir DIR or die "Couldn't close dir: $!";
ok(@pw32u_fc == 2, '2 threads fixed from pw32u');# 30
# test whether fixed files have names predicted
ok($pw32u_fp[0] eq $pw32u_fc[0], 'Perl_and_delphi_interaction_query.thr.txt');# 31
ok($pw32u_fp[1] eq $pw32u_fc[1], 'qx_broken_on_Win98.fix.thr.txt');# 32
@intersect = get_intersection(\@pw32u_fp, \@pw32u_fc);
ok(@intersect == @pw32u_fp, # 33
'all pw32u fixed threads predicted have been created');
# test whether thread files have predicted message count
ok(${$pw32u_fp{$pw32u_fp[0]}}[0] == verify_message_count(# 34
$pw32u_fc[0], $tmd));
ok(${$pw32u_fp{$pw32u_fp[1]}}[0] == verify_message_count(# 35
$pw32u_fc[1], $tmd));
# test whether messages in thread files are correct and appear in
# predicted sequence
ok( compare_arrays(\@{$pw32u_fmessp{$pw32u_fp[0]}}, # 36
get_message_numbers_created($pw32u_fc[0], $tmd) ) );
ok( compare_arrays(\@{$pw32u_fmessp{$pw32u_fp[1]}}, # 37
get_message_numbers_created($pw32u_fc[1], $tmd) ) );
# test whether messages in thread files have predicted number of paragraphs
ok( compare_arrays(${$pw32u_fp{$pw32u_fp[0]}}[1], # 38
get_paragraph_count($pw32u_fp[0], $tmd) ) );
ok( compare_arrays(${$pw32u_fp{$pw32u_fp[1]}}[1], # 39
get_paragraph_count($pw32u_fp[1], $tmd) ) );
chdir $startdir or die "Couldn't change back to $startdir: $!";
#######################################################################
# below: tests of consolidate_threads_single()
my ($consol_in_dir, $consol_out_dir, @consol_test, $consol_predict,
@consol_tp, @consol_messp, @consol_tc, @consol_messc);
$consol_in_dir = "$startdir/t/consol/in/pw32u";
$consol_out_dir = "$startdir/t/consol/out/pw32u";
$pw32u_config_out{'dir_threads'} = $consol_out_dir;
@consol_test = (
'qx_broken_on_Win98.thr.txt',
'qx_broken_on_Win98_second_thread.thr.txt',
);
$consol_predict = 'qx_broken_on_Win98.thr.txt';
chdir $consol_in_dir or die "Couldn't change to $consol_in_dir: $!";
foreach my $orig (@consol_test) {
copy $orig, "$consol_out_dir/$orig"
or die "Could not copy $orig for test of consolidation: $!";
}
@consol_tp = ( 6, [ 8, 6, 5, 6, 8, 8 ] );
@consol_messp = ( qw|
001_0002_0007
001_0002_0008
001_0002_0009
001_0002_0010
001_0002_0011
001_0002_0012
|);
# run Mail::Digest::Tools function consolidate_threads_single()
consolidate_threads_single(
\%pw32u_config_in,
\%pw32u_config_out,
\@consol_test
);
chdir $consol_out_dir or die "Couldn't change to pw32u threads dir: $!";
opendir DIR, $consol_out_dir or die "Couldn't open dir: $!";
@consol_tc = sort {lc($a) cmp lc($b)} grep {/\.thr\.txt$/} readdir DIR;
closedir DIR or die "Couldn't close dir: $!";
# test whether correct number of threads files have been fixed
ok(@consol_tc == 1, '1 thread consolidated from pw32u');# 40
# test whether consolidated file has been correctly named
ok($consol_predict eq $consol_tc[0], 'qx broken on Win98.thr.txt');# 41
# test whether consolidated file has predicted message count
ok($consol_tp[0] == verify_message_count(# 42
$consol_tc[0], $tmd));
# test whether messages in consolidated file have predicted number of paragraphs
ok( compare_arrays($consol_tp[1], # 43
get_paragraph_count($consol_tc[0], $tmd) ) );
#######################################################################
# below: tests of delete_deletables()
my (@del_predicted, @del_created, @del_verified);
foreach my $orig (@consol_test) {
push(@del_predicted, $orig . '.DELETABLE');
};
@del_predicted = sort {lc($a) cmp lc($b)} @del_predicted;
opendir DIR, $consol_out_dir or die "Couldn't open dir: $!";
@del_created = sort {lc($a) cmp lc($b)}
map {"$consol_out_dir/$_"}
grep {/\.thr\.txt\.DELETABLE$/}
readdir DIR;
closedir DIR or die "Couldn't close dir: $!";
# test whether correct number of deletable files were created
ok(@del_predicted == @del_created, 'correct number of deletables');# 44
ok(@del_created == 2, 'correct number of deletables');# 45
# test whether deletable files were correctly named
ok($del_predicted[0] eq $del_created[0]);# 46
ok($del_predicted[1] eq $del_created[1]);# 47
# run Mail::Digest::Tools function delete_deletables()
delete_deletables(\%pw32u_config_out);
# verify that deletables have been deleted
opendir DIR, $consol_out_dir or die "Couldn't open dir: $!";
@del_verified = grep {/\.DELETABLE$/} readdir DIR;
closedir DIR or die "Couldn't close dir: $!";
ok(@del_verified == 0, 'no deletable files left');# 48
######################################################################
# restore original conditions
chdir $startdir or die "Couldn't change back to $startdir: $!";
$pw32u_config_out{'dir_threads'} = $dir_threads_orig;