#!/usr/bin/perl -w
#
# +------------+
# | WARNING! |
# +------------+
#
# The code in this script is only meant to perform
# an installation test.
#
# It is not meant for production purposes, since it uses
# some NON-DOCUMENTED features.
# ^^^^^^^^^^^^^^
#
# To perform a test with a real database, use the script
# in the "examples" directory
use strict;
use DBI;
use DBIx::SQLCrosstab 1.17;
use DBIx::SQLCrosstab::Format 0.07;
my $othertest = shift;
my $col_names = [ 'country', 'location',
'pers#employee#f', 'pers#employee#m','pers#employee',
'pers#contractor#m', 'pers#contractor', 'pers',
'sales#employee#m', 'sales#employee',
'sales#contractor#m', 'sales#contractor',
'sales#consultant#f', 'sales#consultant', 'sales',
'dev#employee#m', 'dev#employee',
'dev#consultant#f', 'dev#consultant',
'dev', 'total' ];
my $records = [
[ 'Germany', 'Berlin', 5500, 0, 5500, 0, 0, 5500, 0, 0, 0, 0, 0, 0, 0,
6000, 6000, 0, 0, 6000, 11500 ],
[ 'Germany', 'Bonn', 0, 0, 0, 0, 0, 0, 5000, 5000, 0, 0, 0, 0, 5000, 0,
0, 0, 0, 0, 5000 ],
[ 'Germany', 'Munich', 0, 5000, 5000, 0, 0, 5000, 0, 0, 0, 0, 5500, 5500,
5500, 0, 0, 0, 0, 0, 10500 ],
[ 'Germany', 'zzzz', 5500, 5000, 10500, 0, 0, 10500, 5000, 5000, 0, 0,
5500, 5500, 10500, 6000, 6000, 0, 0, 6000, 27000 ],
[ 'Italy', 'Rome', 0, 6000, 6000, 0, 0, 6000, 0, 0, 0, 0, 0, 0, 0,
0, 0, 6000, 6000, 6000, 12000 ],
[ 'Italy', 'zzzz', 0, 6000, 6000, 0, 0, 6000, 0, 0, 0, 0, 0, 0, 0, 0,
0, 6000, 6000, 6000, 12000 ],
[ 'UK', 'London', 0, 0, 0, 5000, 5000, 5000, 0, 0, 5500, 5500,
0, 0, 5500, 0, 0, 0, 0, 0, 10500 ],
[ 'UK', 'zzzz', 0, 0, 0, 5000, 5000, 5000, 0, 0, 5500, 5500, 0, 0,
5500, 0, 0, 0, 0, 0, 10500 ],
[ 'zzzz', 'zzzz', 5500, 11000, 16500, 5000, 5000, 21500, 5000,
5000, 5500, 5500, 5500, 5500, 16000, 6000,
6000, 6000, 6000, 12000, 49500 ]
];
my $params = {
dbh => {dsn=>"dbi:ExampleP:test"},
op => [[ 'SUM', 'salary' ] ],
# op_col => 'salary',
title => 'DBIx::SQLCrosstab test',
records => $records,
col_names => $col_names,
title_in_header=> 1,
add_colors => 1,
col_total => 1,
col_sub_total => 1,
commify => 1,
rows => [
{ col => 'country' },
{ col => 'loc', alias => 'location' }
],
cols => [
{
id => 'dept_id',
value => 'dept',
from => 'depts'
},
{
id => 'cat_id',
value => 'category',
from => 'categories'
},
{
id => 'gender',
col_list => [ {id=>'f'}, {id =>'m'}],
from => 'person'
},
],
from => "",
};
my $xt;
my $xt_stub;
eval {$xt = DBIx::SQLCrosstab::Format->new($params)} ;
eval {$xt_stub = DBIx::SQLCrosstab::Format->new('STUB')};
#
# Notice: the tests MUST run in this given sequence.
#
# Calling a later test without passing the
# initial ones will make eveything fail.
my @tests = (qw(creation stub_create set_param
save_params load_params
recs query recs_stub query_stub
table table_stub bare_table
xml xml_stub yaml
struct_hoh struct_losh struct_hoh
struct_loh struct_lol ));
eval {require YAML;};
if ($@) {
@tests = grep { $_ ne 'yaml' } @tests;
}
my %all_tests = (
creation => sub { defined $xt },
stub_create => sub { defined $xt_stub },
set_param => sub { $xt_stub->set_param(dbh => $params->{dbh})},
save_params => sub { $xt->save_params("test/test_params") },
load_params => sub { $xt_stub->load_params("test/test_params") },
recs => sub { $xt->get_recs },
query => sub { $xt->{query} },
recs_stub => sub { $xt_stub->get_recs },
query_stub => sub { $xt_stub->{query} },
table => sub { $xt->as_html },
table_stub => sub { $xt_stub->as_html },
bare_table => sub { $xt->as_bare_html },
xml => sub { $xt->as_xml },
xml_stub => sub { $xt_stub->as_xml },
struct_lol => sub { $xt->as_perl_struct('lol') },
struct_loh => sub { $xt->as_perl_struct('loh') },
struct_losh => sub { $xt->as_perl_struct('losh') },
struct_hoh => sub { $xt->as_perl_struct('hoh') },
yaml => sub { $xt->as_yaml()},
failure => sub { DBIx::SQLCrosstab::seterr(
'This test MUST fail - Testing error reporting function')},
# to activate this latest test, call the script as
# $ perl test.pl failure
);
if ($othertest) {
push @tests, $othertest if exists $all_tests{$othertest};
}
my $total_tests = @tests;
my $passed = 0;
my $executed = 0;
my $failed = 0;
for my $test (@tests) {
$executed++;
printf "%s%s ", $test, '.' x (15 - length($test));
if ( &{$all_tests{$test}} ) {
$passed++;
print "ok\n";
}
else {
print "not ok ($DBIx::SQLCrosstab::errstr)\n";
$failed++;
}
last unless $xt;
}
printf "%-14s: %2d\n%-14s: %2d\n%-14s: %2d\n%-14s: %2d\n",
"tests", $total_tests,
"executed", $executed,
"passed", $passed,
"failed", $failed, ;
if ($passed == $total_tests) {
print "all tests passed\n";
print "If DBD::SQLite is installed, you can try now an extended test\n";
print "Do you want to try the extended test? (Y/n) [Y] ";
my $agreement = <>;
chomp $agreement;
if ( $agreement =~ /^\s*y?\s*$/i){
do "test/test_extended.pl"
}
else {
print "You may run the test manually after the installation is completed\n";
}
}
else {
printf "%4.2f%s passed, %4.2f%s failed\n",
$passed / ($total_tests) * 100, '%',
$failed / ($total_tests) * 100, '%' ;
print "Object not created - Additional tests not performed\n"
unless $xt;
}