package DTS_UT::Model::UnitTest;
=pod
=head1 NAME
DTS_UT::Model::UnitTest - class that represents the test to be executed with DTS packages.
=head2 DESCRIPTION
C<DTS_UT::Model::UnitTest> is the test that will be executed again the desired DTS package(s).
This class is based in C<Test::More> and C<Test::Builder> features. C<Test::Builder> is specially necessary because
of the methods C<output> and C<reset> that will change, respectivally, the default output (STDOUT) to a file and will
reset the tests and results from previous execution.
The file where the output will be redirected is a temporary file (see L<File::Temp>) that will be removed as soon the
test is finished and results read.
Since C<Test::Builder> object is a singleton, at the end of each test it's state must be reseted to start a new test
without changing it's results.
With such implementation, C<DTS_UT::Model::UnitTest> can be executed N times against DTS packages without exporting
lots of subroutines of C<Test::More> into main namespace. By using a temporary file for test output, it can be used
with environments like mod_perl once it avoids doing system calls by calling the perl program to execute the test and
read the output.
=head2 EXPORTS
Nothing.
=cut
use strict;
use warnings;
use Test::More;
use Win32::SqlServer::DTS::Application;
use File::Temp;
use base qw(Class::Accessor);
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_ro_accessors(qw(temp_dir dtsapp flat_file_conns exec_pkgs));
=head2 METHODS
=head3 new
Expects as a parameter an hash reference like defined in L<Win32::SqlServer::DTS::Application>.
Returns a C<DTS_UT::Model::UnitTest> object.
=cut
sub new {
my $class = shift;
my $self = { temp_dir => shift, credential => shift };
$self->{dtsapp} = Win32::SqlServer::DTS::Application->new( $self->{credential} );
bless $self, $class;
return $self;
}
=head3 run_test
Executes the test agains a given DTS package.
Expects as parameter the name of a DTS package.
Returns the complete pathname of the temporary file where the results of the test are written. B<Beware> that if the
C<DTS_UT::Model::UnitTest> goes out of scope (and it's reclaimed by garbage collector), the temporary file will be
removed automatically!
=cut
sub run_test {
my $self = shift;
my $pkg_name = shift;
my $package = $self->get_dtsapp()->get_db_package(
{
id => '',
version_id => '',
name => $pkg_name,
package_password => ''
}
);
$self->fetch_flat_file_conns($package);
$self->fetch_execute_pkgs($package);
my $test_builder = Test::More->builder();
my $temp_file = File::Temp->new( DIR => $self->get_temp_dir() );
# keeps a reference until method run_test is called again or the object is destroyed. This will
# garantee that the temporary file will be removed when there are no more references to it.
$self->{_tempfile} = $temp_file;
$test_builder->output( $temp_file->filename() );
# $test_builder->failure_output( \*STDOUT );
plan tests => $package->count_connections() + 6 +
( $package->count_execute_pkgs() * 2 ) +
( $package->count_datapumps() * 8 ) +
( ( scalar( @{ $self->get_flat_file_conns() } ) ) * 4 ) + 1;
ok( !$package->log_to_server, 'Log to SQL Server should be disable' );
ok( defined( $package->get_log_file ), 'Log to flat file is enable' );
ok( !$package->use_event_log,
'Write completion status on Event log should be disable' );
ok(
$package->use_explicit_global_vars,
'Global variable are explicit declared'
);
cmp_ok( $package->count_connections, '>=', 2,
'Package must have at least two connections' );
cmp_ok( $package->count_datapumps, '>=', 1,
'Package must have at least one datapump task' );
$self->test_conn_auto_cfg($package);
$self->test_datapumps($package);
$self->test_execute_pkgs($package)
if ( $package->count_execute_pkgs() > 0 );
$self->test_flat_file_conns($package);
$self->test_exec_pkg_auto_conf($package);
$self->test_pkg_log_auto_conf($package);
$test_builder->reset();
return $temp_file->filename();
}
=head3 "Private" methods
=over
=item *
test_flat_file_conns
=item *
fetch_flat_file_conns
=item *
fetch_execute_pkgs
=item *
test_execute_pkgs
=item *
test_pkg_log_auto_conf
=item *
test_exec_pkg_auto_conf
=item *
test_datapumps
=item *
test_conn_auto_cfg
=item *
fetch_conns
=back
=cut
sub test_flat_file_conns {
my $self = shift;
my $package = shift;
my $conn_name;
foreach my $conn ( @{ $self->get_flat_file_conns() } ) {
$conn_name = 'Flat file connection "' . $conn->get_name() . '"';
my $oledb = $conn->get_oledb();
foreach my $prop_name ( keys( %{$oledb} ) ) {
CASE: {
if ( $oledb->{$prop_name}->{name} eq 'Row Delimiter' ) {
is( $oledb->{$prop_name}->{value},
"\r\n",
"$conn_name row delimiter must be CRLF characters" );
last CASE;
}
if ( $oledb->{$prop_name}->{name} eq 'Text Qualifier' ) {
is( $oledb->{$prop_name}->{value},
'', "$conn_name text qualifier should be empty" );
last CASE;
}
if ( $oledb->{$prop_name}->{name} eq 'Column Delimiter' ) {
is( $oledb->{$prop_name}->{value}, '|',
"$conn_name column delimiter must be a pipe character"
);
last CASE;
}
if ( $oledb->{$prop_name}->{name} eq 'File Type' ) {
is( $oledb->{$prop_name}->{value},
'ASCII', "$conn_name file enconding must be ASCII" );
last CASE;
}
}
}
}
}
sub fetch_flat_file_conns {
my $self = shift;
my $package = shift;
my @flat_file_conns;
my $iterator = $package->get_connections();
while ( my $conn = $iterator->() ) {
push( @flat_file_conns, $conn )
if ( $conn->get_provider() eq 'DTSFlatFile' );
}
$self->{flat_file_conns} = \@flat_file_conns;
}
sub fetch_execute_pkgs {
my $self = shift;
my $package = shift;
my @tasks_list;
my $iterator = $package->get_execute_pkgs();
while ( my $exec_pkg = $iterator->() ) {
$exec_pkg->kill_sibling();
push( @tasks_list, $exec_pkg );
}
$self->{exec_pkgs} = \@tasks_list;
}
sub test_execute_pkgs {
my $self = shift;
my $package = shift;
my $package_name;
foreach my $execute_pkg ( @{ $self->get_exec_pkgs() } ) {
$package_name =
'Execute Package task "' . $execute_pkg->get_name() . '"';
is( $execute_pkg->get_package_id(),
'', "$package_name must have Package ID empty" );
}
}
sub test_pkg_log_auto_conf {
my $self = shift;
my $package = shift;
my $log_auto_conf = 0;
my $dyn_iterator = $package->get_dynamic_props();
while ( my $dyn_prop = $dyn_iterator->() ) {
my $assign_iterator = $dyn_prop->get_assignments();
while ( my $assignment = $assign_iterator->() ) {
my $target = $assignment->get_destination();
$log_auto_conf = 1
if ( $target->changes('Package')
and ( $target->get_destination() eq 'LogFileName' ) );
}
}
ok( $log_auto_conf, 'Package log file configuration is automatic' );
}
sub test_exec_pkg_auto_conf {
my $self = shift;
my $package = shift;
my %exec_pkg_map;
foreach my $exec_pkg ( @{ $self->get_exec_pkgs() } ) {
$exec_pkg_map{ $exec_pkg->get_name() } =
{ ServerName => 0, ServerPassword => 0, ServerUserName => 0 };
}
my $dyn_iterator = $package->get_dynamic_props();
while ( my $dyn_prop = $dyn_iterator->() ) {
my $assign_iterator = $dyn_prop->get_assignments();
while ( my $assignment = $assign_iterator->() ) {
my $target = $assignment->get_destination();
if ( $target->changes('Task') ) {
if ( exists( $exec_pkg_map{ $target->get_taskname() } ) ) {
CASE: {
my $name = $target->get_taskname();
my $dest = $target->get_destination();
if ( $dest eq 'ServerName' ) {
$exec_pkg_map{$name}->{ServerName} = 1;
last CASE;
}
if ( $dest eq 'ServerPassword' ) {
$exec_pkg_map{$name}->{ServerPassword} = 1;
last CASE;
}
if ( $dest eq 'ServerUserName' ) {
$exec_pkg_map{$name}->{ServerUserName} = 1;
last CASE;
}
}
}
}
}
}
foreach my $exec_pkg ( keys(%exec_pkg_map) ) {
my $total;
map { $total += $_; } ( values( %{ $exec_pkg_map{$exec_pkg} } ) );
is( $total, 3,
'Auto configuration is done for '
. $exec_pkg
. ' Execute Package task' );
}
}
sub test_datapumps {
my $self = shift;
my $package = shift;
my $iterator = $package->get_datapumps();
while ( my $datapump = $iterator->() ) {
$datapump->kill_sibling();
my $datapump_name = 'Datapump "' . $datapump->get_name() . '"';
ok(
(
defined( $datapump->get_exception_file() )
and ( $datapump->get_exception_file() ne '' )
),
$datapump_name . ' uses an exception file for logging'
);
ok( !$datapump->use_single_file_7(),
$datapump_name
. ' does not use SQL 7 file format for logging (warning)' );
ok( defined( $datapump->use_source_row_file() ),
$datapump_name . ' uses Source Row File logging (warning)' );
ok( defined( $datapump->use_destination_row_file() ),
$datapump_name . ' uses Destination Row File logging (warning)' );
ok( $datapump->use_fast_load(),
$datapump_name . ' uses Fast Load (warning)' );
ok( $datapump->use_check_constraints(),
$datapump_name . ' uses Check Constraints (warning)' );
ok( $datapump->always_commit(),
$datapump_name . ' uses Always Commit At Final Batch (warning)' );
cmp_ok( $datapump->get_commit_size(),
'>=', 1000,
$datapump_name . ' uses Insert Commit Size >= 1000 (warning)' );
}
}
sub test_conn_auto_cfg {
my $self = shift;
my $package = shift;
my $conns_ref = $self->fetch_conns( $package->get_connections() );
my $dyn_iterator = $package->get_dynamic_props();
while ( my $dyn_prop = $dyn_iterator->() ) {
my $assign_iterator = $dyn_prop->get_assignments();
while ( my $assignment = $assign_iterator->() ) {
my $target = $assignment->get_destination();
if ( $target->changes('Connection') ) {
if ( exists( $conns_ref->{ $target->get_conn_name() } ) ) {
if ( $conns_ref->{ $target->get_conn_name() }->[0] eq
'SQLOLEDB' )
{
CASE: {
my $dest = $target->get_destination();
my $name = $target->get_conn_name();
if ( $dest eq 'Catalog' ) {
$conns_ref->{$name}->[2]->{catalog} = 1;
last CASE;
}
if ( $dest eq 'DataSource' ) {
$conns_ref->{$name}->[2]->{datasource} = 1;
last CASE;
}
if ( $dest eq 'UserID' ) {
$conns_ref->{$name}->[2]->{userid} = 1;
last CASE;
}
if ( $dest eq 'Password' ) {
$conns_ref->{$name}->[2]->{password} = 1;
last CASE;
}
}
}
else {
if ( $target->get_destination() eq 'DataSource' ) {
$conns_ref->{ $target->get_conn_name() }->[1] = 1;
}
}
}
}
}
}
foreach my $conn ( keys %{$conns_ref} ) {
if ( $conns_ref->{$conn}->[0] eq 'SQLOLEDB' ) {
map { $conns_ref->{$conn}->[1] += $_ }
values( %{ $conns_ref->{$conn}->[2] } );
( $conns_ref->{$conn}->[1] == 4 )
? ( $conns_ref->{$conn}->[1] = 1 )
: ( $conns_ref->{$conn}->[1] = 0 );
}
ok( $conns_ref->{$conn}->[1],
"Connection \"$conn\" automatic configuration done by a Dynamic Property task"
);
}
}
sub fetch_conns {
my $self = shift;
my $iterator = shift;
my %conns;
while ( my $conn = $iterator->() ) {
$conns{ $conn->get_name() } = [ $conn->get_provider(), 0 ];
if ( $conns{ $conn->get_name() }->[0] eq 'SQLOLEBD' ) {
$conns{ $conn->get_name() }->[2] =
{ userid => 0, password => 0, datasource => 0, catalog => 0 }
}
}
return \%conns;
}
=head1 SEE ALSO
=over
=item *
L<DTS_UT::Test::Harness::Straps::Parameter>
=item *
L<Win32::SqlServer::DTS::Application>
=item *
L<Test::More>
=item *
L<Test::Builder>
=item *
L<File::Temp>
=back
=head1 AUTHOR
Alceu Rodrigues de Freitas Junior, E<lt>arfreitas@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008 by Alceu Rodrigues de Freitas Junior
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
1;