lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / Test / DlfAnalyserTestCase.pm

package Lire::Test::DlfAnalyserTestCase;

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::DlfAnalyserTestCase - Base class for writing DlfAnalyser unit tests

=head1 SYNOPSIS

  use base qw/ Lire::Test::DlfAnalyserTestCase /;

  use MyAnalyser;
  use File::Basename;

  sub create_analyser {
    return new MyAnalyser();
  }

  sub schemasdir {
    return dirname( __FILE__ ) .  "../..";
  }

  sub registration_file {
    return dirname( __FILE__ ) .  "../../myanalyser_init";
  }

=head1 DESCRIPTION

This is a Test::Unit::TestCase subclass which can be used to easily
write tests for DlfAnalyser. 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 DlfAnalyser test fixtures be setup.

=head2 registration_file()

This should return the script that is responsible for registring the
analyser 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 analyser. This will be added to the lr_schemas_path
configuration variable.

=cut

sub schemasdir {
    die "schemasdir() unimplemented in ", ref $_[0], "\n";
}

=pod

=head2 create_analyser()

This should return an instance of the Lire::DlfAnalyser instance to
test.

=cut

sub create_analyser {
    die "create_analyser() unimplemented in ", ref $_[0], "\n";
}

sub tear_down {
    my $self = $_[0];

    my $analyser = $self->create_analyser();
    Lire::PluginManager->unregister_plugin( 'dlf_analyser', $analyser->name())
        if Lire::PluginManager->has_plugin( 'dlf_analyser', $analyser->name());

    $self->SUPER::tear_down();

    return;
}

=pod 

=head1 Mock Converter Process

=head2 create_mock_process( [ $store ])

This method will return a MockDlfAnalyserProcess which can be use to
help test the DlfAnalyser. All values to write_dlf() and error(), are
saved and can be queried through the dlf() and errors() methods. Note
that the dlf() method returns an array reference of array reference.
The first element in the inner arrays is the dlf and the other
elements are the related DLF id, if any.

The mock process analyser_instance() method which returns the DlfAnalyser
created by create_analyser() and associated to its instance.

The optional $store parameter should be a Lire::DlfStore instance that
will be available through the dlf_store() method.

=cut

sub create_mock_process {
    my ( $self, $store ) = @_;

    return
      new Lire::Test::MockDlfAnalyserProcess( $self->create_analyser(),
                                              $store
                                            );
}

=pod

=head1 DEFAULT TESTS

=head2 test_api()

Make sure that all methods required by Lire::DlfAnalyser are
implemented. It also tests that the src_schema() and dst_schema() are
available.

It checks that description() formats correctly as DocBook.

=head2 test_registration_file()

Checks that the registration script correctly registers the
analyser with the PluginManager.

=cut

sub test_registration_file {
    my $self = $_[0];

    $self->{'cfg'}{'lr_schemas_path'} = [ $self->schemasdir() ];

    my $analyser = $self->create_analyser();
    $self->error( "$analyser should be a Lire::DlfAnalyser" )
      unless $analyser->isa( 'Lire::DlfAnalyser' );

    eval file_content( $self->registration_file() );
    $self->error( $@ ) if $@;

    $self->assert( Lire::PluginManager->has_plugin( 'dlf_analyser',
                                                    $analyser->name() ),
                   $analyser->name() . " wasn't registered" );
}

sub test_api {
    my $self = $_[0];

    $self->{'cfg'}{'lr_schemas_path'} = [ $self->schemasdir() ];

    my $analyser = $self->create_analyser();
    $self->error( "$analyser should be a Lire::DlfAnalyser" )
      unless $analyser->isa( 'Lire::DlfAnalyser' );

    $self->assert_not_null( $analyser->name(),
                            "name() returned undef" );
    $self->assert_not_null( $analyser->title(),
                            "title() returned undef" );

    my @warn = ();
    local $SIG{__WARN__} = sub { my $msg = join "", @_;
                                 push @warn, $msg;
                                 $self->annotate( $msg ) };
    $self->assert_not_null( $analyser->description(),
                            "description() returned undef" );
    eval { dbk2txt( $analyser->description() ) };
    $self->fail( "error while formatting description: $@" )
      if $@;

    $self->assert( ! @warn, "there were DocBook warnings" );

    $self->assert( Lire::DlfSchema->has_schema( $analyser->src_schema() ),
                   "non-existent src_schema: " . $analyser->src_schema() );

    $self->assert( Lire::DlfSchema->has_schema( $analyser->dst_schema() ),
                   "non-existent dst_schema: " . $analyser->dst_schema() );
}

package Lire::Test::MockDlfAnalyserProcess;

use base qw/Lire::DlfAnalyserProcess/;

use Lire::Utils qw/ check_param check_object_param /;

sub new {
    my ( $class, $analyser, $store ) = @_;

    check_object_param( $analyser, 'analyser', 'Lire::DlfAnalyser' );
    check_object_param( $store, 'store', 'Lire::DlfStore' )
      if defined $store;


    my $self = bless { '_errors' => [],
                       '_dlf' => [],
                       '_analyser_instance' => $analyser,
                       '_store' => $store,
                       '_dlf_count' => 0,
                       '_error_count' => 0,
                       '_period' => 'all',
                     }, $class;

    return $self;
}

sub write_dlf {
    my ( $self, $dlf, $related_tos ) = @_;

    check_object_param( $dlf, 'dlf', 'HASH' );

    my $rec = [ { %$dlf } ];
    push @$rec, @$related_tos if defined $related_tos;
    push @{$self->{'_dlf'}}, $rec;

    $self->{'_dlf_count'}++;

    return;
}

sub dlf {
    return $_[0]{'_dlf'};
}

sub error {
    my ( $self, $error ) = @_;

    check_param( $error, 'error' );

    push @{$self->{'_errors'}}, $error;
    $self->{'_error_count'}++;

    return;
}

sub errors {
    return $_[0]{'_errors'};
}

sub analyser_instance {
    return $_[0]->{'_analyser_instance'};
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

Lire::Test::TestCase(3pm), Lire::DlfAnalyser(3pm)

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: DlfAnalyserTestCase.pm,v 1.3 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