libwiki-toolkit-perl 0.85-1 / usr / share / perl5 / Wiki / Toolkit / TestLib.pm

package Wiki::Toolkit::TestLib;

use 5.006; #by perlver
use strict;
use Carp "croak";
use Wiki::Toolkit;
use Wiki::Toolkit::TestConfig;
use DBI;

use vars qw( $VERSION @wiki_info );
$VERSION = '0.05';

=head1 NAME

Wiki::Toolkit::TestLib - Utilities for writing Wiki::Toolkit tests.

=head1 DESCRIPTION

When 'perl Makefile.PL' is run on a Wiki::Toolkit distribution,
information will be gathered about test databases etc that can be used
for running tests. Wiki::Toolkit::TestLib gives convenient access to this
information.

=head1 SYNOPSIS

  use strict;
  use Wiki::Toolkit::TestLib;
  use Test::More;

  my $iterator = Wiki::Toolkit::TestLib->new_wiki_maker;
  plan tests => ( $iterator->number * 6 );

  while ( my $wiki = $iterator->new_wiki ) {
      # put some test data in
      # run six tests
  }

Each time you call C<< ->next >> on your iterator, you will get a
fresh blank wiki object. The iterator will iterate over all configured
search and storage backends.

The Lucy search backend will be configured to index three metadata fields:
address, category, and locale.

=cut

my %configured = %Wiki::Toolkit::TestConfig::config;

my %datastore_info;

foreach my $dbtype (qw( MySQL Pg SQLite )) {
    if ( $configured{$dbtype}{dbname} ) {
        my %config = %{ $configured{$dbtype} };
        my $store_class = "Wiki::Toolkit::Store::$dbtype";
        my $setup_class = "Wiki::Toolkit::Setup::$dbtype";
        eval "require $store_class";
        if ( $@ ) {
            warn "Couldn't require $store_class: $@\n";
            warn "Will skip $dbtype tests.\n";
            next;
        }
        my $dsn = $store_class->_dsn( @config{ qw( dbname dbhost dbport ) } );
        my $err;
        if ( $err = _test_dsn( $dsn, $config{dbuser}, $config{dbpass} ) ) {
            warn "connecting to test $dbtype database failed: $err\n";
            warn "will skip $dbtype tests\n";
            next;
        }
        $datastore_info{$dbtype} = {
                                     class  => $store_class,
                                     setup_class => $setup_class,
                                     params => {
                                                 dbname => $config{dbname},
                                                 dbuser => $config{dbuser},
                                                 dbpass => $config{dbpass},
                                                 dbhost => $config{dbhost},
                                               },
                                     dsn    => $dsn
                                   };
    }
}

my %dbixfts_info;
# DBIxFTS only works with MySQL.
if ( $configured{dbixfts} && $configured{MySQL}{dbname} ) {
    my %config = %{ $configured{MySQL} };
    $dbixfts_info{MySQL} = {
                             db_params => {
                                            dbname => $config{dbname},
                                            dbuser => $config{dbuser},
                                            dbpass => $config{dbpass},
                                            dbhost => $config{dbhost},
                                          },
                           };
}

my %sii_info;
# Test the MySQL SII backend, if we can.
if ( $configured{search_invertedindex} && $configured{MySQL}{dbname} ) {
    my %config = %{ $configured{MySQL} };
    $sii_info{MySQL} = {
                         db_class  => "Search::InvertedIndex::DB::Mysql",
                         db_params => {
                                        -db_name    => $config{dbname},
                                        -username   => $config{dbuser},
                                        -password   => $config{dbpass},
                                        -hostname   => $config{dbhost} || "",
                                        -table_name => 'siindex',
                                        -lock_mode  => 'EX',
                                      },
                       };
}

# Test the Pg SII backend, if we can.  It's not in the main S::II package.
eval { require Search::InvertedIndex::DB::Pg; };
my $sii_pg = $@ ? 0 : 1;
if (    $configured{search_invertedindex}
     && $configured{Pg}{dbname}
     && $sii_pg
   ) {
    my %config = %{ $configured{Pg} };
    $sii_info{Pg} = {
                      db_class  => "Search::InvertedIndex::DB::Pg",
                      db_params => {
                                     -db_name    => $config{dbname},
                                     -username   => $config{dbuser},
                                     -password   => $config{dbpass},
                                     -hostname   => $config{dbhost},
                                     -table_name => 'siindex',
                                     -lock_mode  => 'EX',
                                   },
                    };
}

# Also test the default DB_File backend, if we have S::II installed at all.
if ( $configured{search_invertedindex} ) {
    $sii_info{DB_File} = {
                  db_class  => "Search::InvertedIndex::DB::DB_File_SplitHash",
                  db_params => {
                                 -map_name  => 't/sii-db-file-test.db',
                                 -lock_mode  => 'EX',
                               },
                         };
}

my ( $plucene_path, $lucy_path );
# Test with Plucene and Lucy if possible.
if ( $configured{plucene} ) {
    $plucene_path = "t/plucene";
}
if ( $configured{lucy} ) {
    $lucy_path = "t/lucy";
}

# @wiki_info describes which searches work with which stores.

# Database-specific searchers.
push @wiki_info, { datastore_info => $datastore_info{MySQL},
                   dbixfts_info   => $dbixfts_info{MySQL} }
    if ( $datastore_info{MySQL} and $dbixfts_info{MySQL} );
push @wiki_info, { datastore_info => $datastore_info{MySQL},
                   sii_info       => $sii_info{MySQL} }
    if ( $datastore_info{MySQL} and $sii_info{MySQL} );
push @wiki_info, { datastore_info => $datastore_info{Pg},
                   sii_info       => $sii_info{Pg} }
    if ( $datastore_info{Pg} and $sii_info{Pg} );

# All stores are compatible with the default S::II search, and with Plucene,
# and with Lucy, and with no search.
foreach my $dbtype ( qw( MySQL Pg SQLite ) ) {
    push @wiki_info, { datastore_info => $datastore_info{$dbtype},
                       sii_info       => $sii_info{DB_File} }
        if ( $datastore_info{$dbtype} and $sii_info{DB_File} );
    push @wiki_info, { datastore_info => $datastore_info{$dbtype},
                       plucene_path   => $plucene_path }
        if ( $datastore_info{$dbtype} and $plucene_path );
    push @wiki_info, { datastore_info => $datastore_info{$dbtype},
                       lucy_path   => $lucy_path }
        if ( $datastore_info{$dbtype} and $lucy_path );
    push @wiki_info, { datastore_info => $datastore_info{$dbtype} }
        if $datastore_info{$dbtype};
}

=head1 METHODS

=over 4

=item B<new_wiki_maker>

  my $iterator = Wiki::Toolkit::TestLib->new_wiki_maker;

=cut

sub new_wiki_maker {
    my $class = shift;
    my $count = 0;
    my $iterator = \$count;
    bless $iterator, $class;
    return $iterator;
}

=item B<number>

  use Test::More;
  my $iterator = Wiki::Toolkit::TestLib->new_wiki_maker;
  plan tests => ( $iterator->number * 6 );

Returns the number of new wikis that your iterator will be able to give you.

=cut

sub number {
    return scalar @wiki_info;
}

=item B<new_wiki>

  my $wiki = $iterator->new_wiki;

Returns a fresh blank wiki object, or false if you've used up all the
configured search and storage backends.

=cut

sub new_wiki {
    my $self = shift;
    return undef if $$self > $#wiki_info;
    my $details = $wiki_info[$$self];
    my %wiki_config;

    # Set up and clear datastore.
    my %datastore_info = %{ $details->{datastore_info } };
    my $setup_class =  $datastore_info{setup_class};
    eval "require $setup_class";
    {
      no strict "refs";
      &{"$setup_class\:\:cleardb"}( $datastore_info{params} );
      &{"$setup_class\:\:setup"}( $datastore_info{params} );
    }
    my $class =  $datastore_info{class};
    eval "require $class";
    $wiki_config{store} = $class->new( %{ $datastore_info{params} } );

    # Set up and clear search object (if required).
    if ( $details->{dbixfts_info} ) {
        my %fts_info = %{ $details->{dbixfts_info} };
        require Wiki::Toolkit::Store::MySQL;
        my %dbconfig = %{ $fts_info{db_params} };
        my $dsn = Wiki::Toolkit::Store::MySQL->_dsn( $dbconfig{dbname},
                                                     $dbconfig{dbhost}  );
        my $dbh = DBI->connect( $dsn, $dbconfig{dbuser}, $dbconfig{dbpass},
                       { PrintError => 0, RaiseError => 1, AutoCommit => 1 } )
            or croak "Can't connect to $dbconfig{dbname} using $dsn: " . DBI->errstr;
        require Wiki::Toolkit::Setup::DBIxFTSMySQL;
        Wiki::Toolkit::Setup::DBIxFTSMySQL::setup(
                                 @dbconfig{ qw( dbname dbuser dbpass dbhost ) }
                                                 );
        require Wiki::Toolkit::Search::DBIxFTS;
        $wiki_config{search} = Wiki::Toolkit::Search::DBIxFTS->new( dbh => $dbh );
    } elsif ( $details->{sii_info} ) {
        my %sii_info = %{ $details->{sii_info} };
        my $db_class = $sii_info{db_class};
        eval "use $db_class";
        my %db_params = %{ $sii_info{db_params} };
        my $indexdb = $db_class->new( %db_params );
        require Wiki::Toolkit::Setup::SII;
        Wiki::Toolkit::Setup::SII::setup( indexdb => $indexdb );
        $wiki_config{search} = Wiki::Toolkit::Search::SII->new(indexdb =>$indexdb);
    } elsif ( $details->{plucene_path} ) {
        require Wiki::Toolkit::Search::Plucene;
        my $dir = $details->{plucene_path};
        unlink <$dir/*>; # don't die if false since there may be no files
        if ( -d $dir ) {
            rmdir $dir or die $!;
        }
        mkdir $dir or die $!;
        $wiki_config{search} = Wiki::Toolkit::Search::Plucene->new( path => $dir );
    } elsif ( $details->{lucy_path} ) {
        require Wiki::Toolkit::Search::Lucy;
        require File::Path;
        my $dir = $details->{lucy_path};
        File::Path::rmtree( $dir, 0, 1 ); #  0 = verbose, 1 = safe
        mkdir $dir or die $!;
        $wiki_config{search} = Wiki::Toolkit::Search::Lucy->new(
            path => $dir,
            metadata_fields => [ "address", "category", "locale" ] );
    }

    # Make a wiki.
    my $wiki = Wiki::Toolkit->new( %wiki_config );
    $$self++;
    return $wiki;
}

=item B<configured_databases>

  my @configured_databases = $iterator->configured_databases;

  Returns the @configured_databases array detailing configured test databases.
  Useful for very low-level testing only.

=cut

sub configured_databases {
    my @configured_databases;
    foreach my $dbtype (qw( MySQL Pg SQLite )) {
        push @configured_databases, $datastore_info{$dbtype}
            if $datastore_info{$dbtype};
    }
    return @configured_databases;
}

sub _test_dsn {
    my ( $dsn, $dbuser, $dbpass ) = @_;
    my $dbh = eval {
        DBI->connect($dsn, $dbuser, $dbpass, {RaiseError => 1});
    };
    return $@;
}

=back

=head1 SEE ALSO

L<Wiki::Toolkit>

=head1 AUTHOR

Kake Pugh (kake@earth.li).

=head1 COPYRIGHT

     Copyright (C) 2003-2004 Kake Pugh.  All Rights Reserved.
     Copyright (C) 2008 the Wiki::Toolkit team. All Rights Reserved.

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 CAVEATS

If you have the L<Search::InvertedIndex> backend configured (see
L<Wiki::Toolkit::Search::SII>) then your tests will raise warnings like

  (in cleanup) Search::InvertedIndex::DB::Mysql::lock() -
    testdb is not open. Can't lock.
  at /usr/local/share/perl/5.6.1/Search/InvertedIndex.pm line 1348

or

  (in cleanup) Can't call method "sync" on an undefined value
    at /usr/local/share/perl/5.6.1/Tie/DB_File/SplitHash.pm line 331
    during global destruction.

in unexpected places. I don't know whether this is a bug in me or in
L<Search::InvertedIndex>.

=cut

1;