package tests::functional::TestSchemaFixture;
use strict;
use Lire::Config::Build qw/ac_info ac_path/;
use Lire::ReportParser::ReportBuilder;
use Lire::Utils qw/create_file file_content/;
use File::Basename qw/dirname/;
use File::Path qw/mkpath rmtree/;
use File::Copy;
use Lire::PluginManager;
use Lire::Test::Mock;
use IO::Dir;
use Cwd 'realpath';
use Carp;
use tests::helpers::TestExtendedAnalyzer;
use tests::helpers::TestDerivedAnalyzer;
use tests::helpers::TestDlfConverter;
use POSIX qw/tzset/;
sub init {
my $self = $_[0];
$self->{'_tsh_testsdir'} = realpath(dirname( __FILE__ ) . "/..");
$self->{'_tsh_converter_init'} =
ac_path( 'sysconfdir', 'PACKAGE' ) . "/converters/test_newapi";
$self->{'_tsh_address_file'} =
ac_path( 'sysconfdir', 'PACKAGE' ) . "/address.cf";
$self->{'_tsh_moduledir'} =
ac_info( 'LR_PERL5LIB' ) . "/tests/helpers";
return $self;
}
sub tests_datadir {
return "$_[0]->{'_tsh_testsdir'}/data";
}
sub set_up_test_schemas {
my $self = $_[0];
foreach my $s ( $self->_find_xml_specs( "$self->{'_tsh_testsdir'}/schemas" ))
{
$self->install_xml_spec( "schema", "test", $s );
}
my $default_file =
ac_path( 'datadir', 'PACKAGE' ) . '/templates/test_default.xml';
$self->create_test_file( $default_file,
file_content( $self->tests_datadir() . "/test_report_cfg.xml" ) );
return;
}
sub set_up_test_store {
my $self = $_[0];
my $testdir = realpath( dirname(__FILE__) . '/..' );
system( "cd " . $self->homedir()
. "; tar xf $testdir/data/test_store.tar" );
die "tar failed: $?" if $?;
$self->{'storedir'} = $self->homedir() . '/test_store';
return;
}
sub set_up_test_another_analyser {
my $self = $_[0];
my $analyser = new_proxy Lire::Test::Mock( 'Lire::DlfAnalyser' );
$analyser->set_result( 'name' => 'another',
'title' => 'Another Catogoriser',
'description' => '<para>A fake Categoriser</para>',
'src_schema' => 'test-derived',
'dst_schema' => 'test-extended',
'analyse' => '' );
Lire::PluginManager->register_plugin( $analyser );
my $pluginsdir = $self->homedir() . "/.lire/plugins";
mkpath( [ $pluginsdir ], 0, 0755 );
create_file( "$pluginsdir/another_init", <<EOS );
{
package myanalyser;
no warnings 'redefine';
use base qw/Lire::DlfAnalyser/;
sub new { return bless {}, shift }
sub name { return 'another' }
sub title { return 'Another Categoriser' }
sub description { return "<para>A fake Categoriser</para>" }
sub src_schema { return 'test-derived' };
sub dst_schema { return 'test-extended' };
sub analyse {}
}
package main;
use Lire::PluginManager;
Lire::PluginManager->register_plugin( new myanalyser() );
EOS
return;
}
sub set_up_test_analysers {
my $self = $_[0];
Lire::PluginManager->register_plugin( new tests::helpers::TestExtendedAnalyzer() );
Lire::PluginManager->register_plugin( new tests::helpers::TestDerivedAnalyzer() );
mkpath( [ $self->{'_tsh_moduledir'} ], 0, 0755 );
copy ( "$self->{'_tsh_testsdir'}/helpers/TestDerivedAnalyzer.pm",
"$self->{'_tsh_moduledir'}/TestDerivedAnalyzer.pm" );
copy ( "$self->{'_tsh_testsdir'}/helpers/TestExtendedAnalyzer.pm",
"$self->{'_tsh_moduledir'}/TestExtendedAnalyzer.pm" );
my $pluginsdir = $self->homedir() . "/.lire/plugins";
mkpath( [ $pluginsdir ], 0, 0755 );
create_file( "$pluginsdir/analysers_init", <<EOS );
use Lire::PluginManager;
use tests::helpers::TestDerivedAnalyzer;
use tests::helpers::TestExtendedAnalyzer;
Lire::PluginManager->register_plugin( new tests::helpers::TestDerivedAnalyzer() );
Lire::PluginManager->register_plugin( new tests::helpers::TestExtendedAnalyzer() );
EOS
}
sub set_up_test_specs {
my $self = $_[0];
# This is the time zone in which the report with which we compare
# was created.
$self->{'saved_tz'} = $ENV{'TZ'};
$ENV{'TZ'} = 'EST';
tzset();
foreach my $s ( $self->_find_xml_specs( "$self->{'_tsh_testsdir'}/filters/test" ))
{
$self->install_xml_spec( "filter", "test", $s );
}
foreach my $s ( $self->_find_xml_specs( "$self->{'_tsh_testsdir'}/reports/test" ))
{
$self->install_xml_spec( "report", "test", $s );
}
}
sub set_up_test2dlf {
my $self = $_[0];
my $perl = ac_info( 'PERL' );
my $perllib = ac_info( 'LR_PERL5LIB' );
my $dlf_converter = ac_path( "libexecdir", "PACKAGE" ) . "/convertors/test2dlf";
$self->create_test_file( $dlf_converter, <<SCRIPT );
#! $perl -w
use strict;
use lib '$perllib';
use Lire::Program qw/:dlf/;
use Lire::Utils qw/file_content/;
init_dlf_converter( 'test' );
print file_content( '$self->{'_tsh_testsdir'}/data/test.dlf' );
end_dlf_converter( 24, 24, 0 );
SCRIPT
chmod( 0755, $dlf_converter) == 1
or croak "failed to set execute permissions on $dlf_converter";
rename $self->{'_tsh_address_file'}, "$self->{'_tsh_address_file'}.bak"
or croak "failed to rename $self->{'_tsh_address_file'}";
$self->create_test_file( $self->{'_tsh_address_file'}, "test test\n" );
return;
}
sub set_up_TestDlfConverter {
my $self = $_[0];
Lire::PluginManager->register_plugin( new tests::helpers::TestDlfConverter() );
$self->create_test_file( $self->{'_tsh_converter_init'}, <<EOF );
use tests::helpers::TestDlfConverter;
return new tests::helpers::TestDlfConverter();
EOF
mkpath( [ $self->{'_tsh_moduledir'} ], 0, 0755 );
copy ( "$self->{'_tsh_testsdir'}/helpers/TestDlfConverter.pm",
"$self->{'_tsh_moduledir'}/TestDlfConverter.pm" );
}
sub _find_xml_specs {
my ( $self, $dir ) = @_;
my $dir_h = new IO::Dir( $dir )
or croak "failed to opendir $dir: $!";
return map { $dir . "/$_" } grep { /\.xml$/ } $dir_h->read();
}
sub tear_down {
my $self = $_[0];
if ( exists $self->{'saved_tz'} ) {
# Perl has the bright idea of warning when
# one assigns undef to an environment variable ?!?
$ENV{'TZ'} = defined $self->{'saved_tz'} ? $self->{'saved_tz'} : '';
tzset();
}
if ( -f "$self->{'_tsh_address_file'}.bak" ) {
rename "$self->{'_tsh_address_file'}.bak", $self->{'_tsh_address_file'}
or croak "failed to rename $self->{'_tsh_address_file'}";
}
rmtree( [ $self->{'_tsh_moduledir'}], 0, 0 );
}
sub check_xml_report_from_string {
my ($self, $e_report_filename, $gen_report ) = @_;
my $parser = new Lire::ReportParser::ReportBuilder();
my $report_e = $parser->parsefile( $e_report_filename );
my $report_t = $parser->parse( $gen_report );
$self->_cmp_report( $report_e, $report_t );
}
sub check_xml_report {
my ( $self, $e_report_filename, $gen_report_filename ) = @_;
my $parser = new Lire::ReportParser::ReportBuilder;
my $report_e = $parser->parsefile( $e_report_filename );
my $report_t = $parser->parsefile( $gen_report_filename );
# system( "cp -r $gen_report_filename /tmp/" . $self->name() . ".xml" );
$self->_cmp_report( $report_e, $report_t );
}
sub _cmp_report {
my ($self, $report_e, $report_t ) = @_;
# The difference in these fields are normal
$report_t->date( $report_e->date );
$report_t->generator( $report_e->generator() );
delete $report_e->{'_id_cache'};
$self->assert_deep_equals( $report_e, $report_t );
}
1;
syntax highlighted by Code2HTML, v. 0.9.1