#!perl
$|=1;
my
$CHECK_DOMAIN
=
'www.google.com'
;
my
$UPDATE_ARCHIVE
= (
$ARGV
[0] &&
$ARGV
[0] eq
'--update-archive'
) ? 1 : 0;
if
(CTWS_Testing::has_environment()) { plan
tests
=> 418; }
else
{ plan
skip_all
=>
"Environment not configured"
; }
ok(
my
$obj
= CTWS_Testing::getObj(),
"got object"
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory removed'
);
my
$dirname
= dirname(
$obj
->mainstore);
unlink
(
$dirname
)
if
(
$dirname
&& -d
$dirname
&&
$dirname
!~ /^\.$/);
my
$rc
;
my
@files
;
my
@expectedFiles
;
my
$expectedDir
;
my
$EXPECTEDPATH
= File::Spec->catfile(
't'
,
'_EXPECTED'
);
my
$zip
= File::Spec->catfile(
't'
,
'expected.zip'
);
if
(-f
$zip
) {
my
$ae
= Archive::Extract->new(
archive
=>
$zip
);
ok(
$ae
->extract(
to
=>
$EXPECTEDPATH
),
'extracted expected files'
);
}
else
{
ok(0);
}
my
$page
= CTWS_Testing::getPages();
my
$dir
=
$obj
->directory();
my
$SOURCE
=
$obj
->templates();
my
$TARGET
= File::Spec->catfile(
't'
,
'_TEMPLATES'
);
my
@source
= CTWS_Testing::listFiles(
$SOURCE
);
for
my
$f
(
@source
) {
my
$source
= File::Spec->catfile(
$SOURCE
,
$f
);
my
$target
= File::Spec->catfile(
$TARGET
,
$f
);
mkpath( dirname(
$target
) );
copy(
$source
,
$target
)
if
(-f
$source
);
}
my
$images
= File::Spec->catfile(
$TARGET
,
'images'
);
rmtree(
$images
);
$obj
->templates(
$TARGET
);
$obj
->directory(
$dir
.
'/_write_basics'
),
$page
->_write_basics();
check_dir_contents(
"[_write_basics]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._write_basics'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_missing_in_action'
),
$page
->_missing_in_action();
check_dir_contents(
"[_missing_in_action]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._missing_in_action'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
my
$store0
=
$page
->{parent}->mainstore();
my
$store1
=
't/data/cpanstats-%s.json'
;
$page
->{parent}->mainstore(
$store1
);
my
$data
=
$page
->storage_read(
'test'
);
is(
$data
->{lastid},182,
'got lastid'
);
is(
$data
->{testers}{
"Paul Schinder (SCHINDER)"
}{
'first'
},199908,
'got testers first'
);
is(
$data
->{testers}{
"Paul Schinder (SCHINDER)"
}{
'last'
}, 199909,
'got testers last'
);
my
@versions
=
sort
{versioncmp(
$b
,
$a
)}
keys
%{
$page
->{perls}};
$page
->{versions} = \
@versions
;
$page
->{
$_
} =
$data
->{
$_
}
for
(
qw(stats dists fails perls pass platform osys osname build counts count xrefs xlast)
);
$page
->{parent}->mainstore(
$store0
);
$obj
->directory(
$dir
.
'/_build_osname_matrix'
),
$page
->_build_osname_matrix();
check_dir_contents(
"[_build_osname_matrix]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_osname_matrix'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_platform_matrix'
),
$page
->_build_platform_matrix();
check_dir_contents(
"[_build_platform_matrix]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_platform_matrix'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_report_cpan'
),
$page
->_report_cpan();
check_dir_contents(
"[_report_cpan]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._report_cpan'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_monthly_stats'
),
$page
->_build_monthly_stats();
check_dir_contents(
"[_build_monthly_stats]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_monthly_stats'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_report_interesting'
),
$page
->_report_interesting();
check_dir_contents(
"[_report_interesting]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._report_interesting'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_monthly_stats_files'
),
$page
->_build_monthly_stats_files();
check_dir_contents(
"[_build_monthly_stats_files]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_monthly_stats_files'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_failure_rates'
),
$page
->_build_failure_rates();
check_dir_contents(
"[_build_failure_rates]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_failure_rates'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_performance_stats'
),
$page
->_build_performance_stats();
check_dir_contents(
"[_build_performance_stats]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_performance_stats'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_write_index'
),
$page
->_write_index();
check_dir_contents(
"[_write_index]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._write_index'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_osname_leaderboards'
),
$page
->_build_osname_leaderboards();
check_dir_contents(
"[_build_osname_leaderboards]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_osname_leaderboards'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
$obj
->directory(
$dir
.
'/_build_noreports'
),
$page
->build_noreports();
check_dir_contents(
"[_build_noreports]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes._build_noreports'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
SKIP: {
skip
"Can't see a network connection"
, 130
if
(pingtest(
$CHECK_DOMAIN
));
$obj
->directory(
$dir
.
'/update_full'
),
$page
->update_full();
check_dir_contents(
"[update_full]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes.update_full'
),
);
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
my
$graph
= CTWS_Testing::getGraphs();
CTWS_Testing::saveFiles(
$dir
.
'/graphs'
);
$obj
->directory(
$dir
.
'/graphs'
),
my
$status
=
$graph
->create();
SKIP: {
skip
"Google Chart API returned an error"
, 10
if
(
$status
);
check_dir_contents(
"[graphs]"
,
$obj
->directory,
File::Spec->catfile(
$EXPECTEDPATH
,
'56writes.graphs'
),
);
}
ok( CTWS_Testing::cleanDir(
$obj
),
'directory cleaned'
);
};
if
(
$UPDATE_ARCHIVE
){
my
$zip
= Archive::Zip->new();
$zip
->addTree(
$EXPECTEDPATH
);
my
$f
= File::Spec->catfile(
't'
,
'expected-NEW.zip'
);
diag
"CREATING NEW ZIP FILE: $f"
;
unlink
$f
if
-f
$f
;
$zip
->writeToFileNamed(
$f
) == Archive::Zip::AZ_OK
or diag
"==== ERROR WRITING TO $f ===="
;
}
ok( CTWS_Testing::whackDir(
$obj
),
'directory removed'
);
ok( rmtree(
$EXPECTEDPATH
),
'expected dir removed'
);
ok( rmtree(
$TARGET
),
'template dir removed'
);
exit
;
sub
eq_or_diff_files {
my
(
$f1
,
$f2
,
$desc
,
$filter
) =
@_
;
my
$s1
= -f
$f1
? slurp(
$f1
) :
undef
;
&$filter
(
$s1
)
if
$filter
;
my
$s2
= -f
$f2
? slurp(
$f2
) :
undef
;
&$filter
(
$s2
)
if
$filter
;
return
(
defined
(
$s1
) &&
defined
(
$s2
) )
? eq_or_diff(
$s1
,
$s2
,
$desc
)
: ok( 0,
"$desc - both files exist [missing "
.(
defined
(
$s2
) ?
$f1
:
$f2
).
"]"
)
;
}
sub
check_dir_contents {
my
(
$diz
,
$dir
,
$expectedDir
) =
@_
;
my
@files
= CTWS_Testing::listFiles(
$dir
);
my
@expectedFiles
= CTWS_Testing::listFiles(
$expectedDir
);
ok(
scalar
(
@files
),
"got files [$dir]"
);
ok(
scalar
(
@expectedFiles
),
"got expectedFiles [$expectedDir]"
);
eq_or_diff( \
@files
, \
@expectedFiles
,
"$diz file listings match"
);
my
$count
= 3;
for
my
$f
(
@files
){
my
$fGot
= File::Spec->catfile(
$dir
,
$f
);
my
$fExpected
= File::Spec->catfile(
$expectedDir
,
$f
);
if
(
$f
=~ /\.(html?|txt|js|css|json|ya?ml|ini|cgi|csv)$/i) {
next
if
(
$f
eq
'newdistros/2015.html'
);
$count
++;
my
$ok
= eq_or_diff_files(
$fGot
,
$fExpected
,
"$diz diff $f"
,
sub
{
if
(
$_
[0]) {
$_
[0] =~ s!CPAN-Testers-WWW-Statistics-\d.\d{2}!==DISTRO==!gmi;
$_
[0] =~ s!<td class=
"timestamp\d"
>.*?</td>!<td class=
"timestamp"
>==TIMESTAMP==</td>!gsi;
$_
[0] =~ s!<span class=
"timestamp\d"
>.*?</span>!<span class=
"timestamp"
>==TIMESTAMP==</span>!gsi;
$_
[0] =~ s!\b20\d{10}\b!==TIMESTAMP==!gsi;
$_
[0] =~ s!\b20\d{6}\b!==TIMESTAMP==!gsi;
$_
[0] =~ s!\b20\d{4}\b!==TIMESTAMP==!gsi;
$_
[0] =~ s!\b20\d{2}\-\d{2}\-\d{2}T\d{2}:\d{2}:\d{2}\b!==TIMESTAMP==!gsi;
$_
[0] =~ s/\d{4}\s*(\-|to)\s*\d{4}/==DATERANGE==/gmi;
$_
[0] =~ s/(\n\r|\r\n)/\n/gs;
}
$_
[0];
}
);
next
if
$ok
;
}
next
unless
$UPDATE_ARCHIVE
;
if
(-f
$fExpected
) {
unlink
(
$fExpected
); }
else
{ mkpath( dirname(
$fExpected
) ) ; }
copy(
$fGot
,
$fExpected
);
}
return
unless
$UPDATE_ARCHIVE
;
for
my
$f
(
@expectedFiles
){
my
$fGot
= File::Spec->catfile(
$dir
,
$f
);
my
$fExpected
= File::Spec->catfile(
$expectedDir
,
$f
);
next
if
(-f
$fGot
);
unlink
(
$fExpected
);
my
$dGot
= dirname(
$fGot
);
my
$dExpected
= dirname(
$fExpected
);
while
(!-d
$dGot
) {
last
if
(
$dGot
eq
$dir
);
last
if
(-d
$dGot
);
$dGot
= dirname(
$dGot
);
$dExpected
= dirname(
$dExpected
);
}
}
}
sub
pingtest {
my
$domain
=
shift
or
return
0;
my
$cmd
= $^O =~ /solaris/i ?
"ping -s $domain 56 1"
:
$^O =~ /dos|os2|mswin32|netware|cygwin/i ?
"ping -n 1 $domain "
:
"ping -c 1 $domain >/dev/null 2>&1"
;
system
(
$cmd
);
my
$retcode
= $? >> 8;
return
$retcode
;
}