package Lire::Test::DlfConverterTestCase; use strict; use base qw/ Lire::Test::TestCase /; use Lire::DlfSchema; use Lire::PluginManager; use Lire::Utils qw/file_content/; use Lire::ReportParser::AsciiDocBookFormatter qw/dbk2txt/; =pod =head1 NAME Lire::Test::DlfConverterTestCase - Base class for writing DLfConverter unit tests =head1 SYNOPSIS use base qw/ Lire::Test::DlfConverterTestCase /; use MyConverter; use File::Basename; sub create_converter { return new MyConverter(); } sub schemasdir { return dirname( __FILE__ ) . "../.."; } sub registration_file { return dirname( __FILE__ ) . "../../myconverter_init"; } =head1 DESCRIPTION This is a Test::Unit::TestCase subclass which can be used to easily write tests for DlfConverter. This class implements what is needed to provide the necessary fixture in the set_up() and tear_down(). It provides two base tests: test_api() and test_registration_file(). The test class needs to implement three methods to help complete the fixture. =head1 FIXTURES These are the methods that subclasses will usually override to provide the necessary data so that the DlfConverter test fixtures be setup. =head2 registration_file() This should return the script that is responsible for registring the converter with the Lire::PluginManager. This is used by the default test_registration_file(). =cut sub registration_file { die "registration_file() unimplemented in ", ref $_[0], "\n"; } =pod =head2 schemasdir() This method should returns the directory which hold the schemas used by the converter. This will be added to the lr_schemas_path configuration variable if set_up_path() is called. =cut sub schemasdir { die "schemasdir() unimplemented in ", ref $_[0], "\n"; } =pod =head2 create_converter() This should return an instance of the Lire::DlfConverter instance to test. =cut sub create_converter { die "create_converter() unimplemented in ", ref $_[0], "\n"; } =pod =head2 set_up_path() This will add the schemasdir to the 'lr_schemas_path'. =cut sub set_up_path { my $self = $_[0]; $self->{'cfg'}{'lr_schemas_path'} = [ $self->schemasdir() ]; return; } sub tear_down { my $self = $_[0]; my $converter = $self->create_converter(); Lire::PluginManager->unregister_plugin( 'dlf_converter', $converter->name()) if Lire::PluginManager->has_plugin( 'dlf_converter', $converter->name()); $self->SUPER::tear_down(); return; } =pod =head1 Mock Converter Process =head2 create_mock_process() This method will return a MockDlfConverterProcess which can be use to help test the DlfConverter. All values to write_dlf(), error(), ignore_log_line() and save_log_line() are saved and can be queried through the dlf( 'schema' ), errors(), ignored() and saved() methods. The mock process also has a converter() method which returns the DlfConverter created by create_converter() and associated to its instance. =cut sub create_mock_process { my $self = $_[0]; return new Lire::Test::MockDlfConverterProcess( $self->create_converter() ); } =pod =head1 DEFAULT TESTS =head2 test_api() Make sure that all methods required by Lire::DlfConverter are implemented. It also tests that the schemas returned by schemas() are available. It checks that description() formats correctly as DocBook. =cut sub test_api { my $self = $_[0]; $self->set_up_path(); my $converter = $self->create_converter(); $self->error( "$converter should be a Lire::DlfConverter" ) unless $converter->isa( 'Lire::DlfConverter' ); $self->assert_not_null( $converter->name(), "name() returned undef" ); $self->assert_not_null( $converter->title(), "title() returned undef" ); my @warn = (); local $SIG{__WARN__} = sub { my $msg = join "", @_; push @warn, $msg; $self->annotate( $msg ) }; $self->assert_not_null( $converter->description(), "description() returned undef" ); eval { dbk2txt( $converter->description() ) }; $self->fail( "error while formatting description: $@" ) if $@; $self->assert( ! @warn, "there were DocBook warnings" ); my @schemas = $converter->schemas(); $self->assert_num_not_equals( 0, scalar @schemas ); foreach my $schema ( @schemas ) { $self->assert( Lire::DlfSchema->has_schema( $schema ), "non-existent schema: " . $schema ); } } =pod =head2 test_registration_file() Checks that the registration script correctly registers the converter with the PluginManager. =cut sub test_registration_file { my $self = $_[0]; $self->set_up_path(); my $converter = $self->create_converter(); $self->error( "$converter should be a Lire::DlfConverter" ) unless $converter->isa( 'Lire::DlfConverter' ); eval file_content( $self->registration_file() ); $self->error( $@ ) if $@; $self->assert( Lire::PluginManager->has_plugin( 'dlf_converter', $converter->name() ), $converter->name() . " wasn't registered" ); } package Lire::Test::MockDlfConverterProcess; use base qw/Lire::DlfConverterProcess/; use Lire::Utils qw/ check_param check_object_param /; use Carp; sub new { my ( $class, $converter ) = @_; check_object_param( $converter, 'converter', 'Lire::DlfConverter' ); my $self = bless { '_errors' => [], '_saved' => [], '_dlf' => {}, '_ignored' => [], '_converter' => $converter, }, $class; $self->_init_counters(); foreach my $schema ( $converter->schemas() ) { $self->{'_dlf'}{$schema} = []; } return $self; } sub write_dlf { my ( $self, $schema, $dlf ) = @_; check_param( $schema, 'schema' ); check_object_param( $dlf, 'dlf', 'HASH' ); croak "schema '$schema' wasn't defined by '", $self->{'_converter'}->name(), "' converter" unless exists $self->{'_dlf'}{$schema}; push @{$self->{'_dlf'}{$schema}}, { %$dlf }; $self->{'_dlf_count'}++; return; } sub dlf { my ( $self, $schema ) = @_; check_param( $schema, 'schema' ); croak "schema '$schema' wasn't defined by '", $self->{'_converter'}->name(), "' converter" unless exists $self->{'_dlf'}{$schema}; return $self->{'_dlf'}{$schema}; } sub error { my ( $self, $error, $line ) = @_; check_param( $error, 'error' ); push @{$self->{'_errors'}}, [ $error, $line ]; $self->{'_error_count'}++; return; } sub errors { return $_[0]{'_errors'}; } sub save_log_line { my ( $self, $line ) = @_; check_param( $line, 'line' ); push @{$self->{'_saved'}}, $line; $self->{'_saved_count'}++; return; } sub saved { return $_[0]{'_saved'}; } sub ignore_log_line { my ( $self, $line, $reason ) = @_; check_param( $line, 'line' ); push @{$self->{'_ignored'}}, [ $line, $reason ]; $self->{'_ignored_count'}++; return; } sub ignored { return $_[0]{'_ignored'}; } sub converter { return $_[0]{'_converter'}; } # keep perl happy 1; __END__ =pod =head1 SEE ALSO Lire::Test::TestCase(3pm), Lire::DlfConverter(3pm) =head1 AUTHOR Francis J. Lacoste =head1 VERSION $Id: DlfConverterTestCase.pm,v 1.20 2006/07/23 13:16:31 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org This file is part of Lire. Lire is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program (see COPYING); if not, check with http://www.gnu.org/copyleft/gpl.html. =cut