The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Foorum::Manual::Tutorial5 - Tutorial 5: How to write test cases For Foorum

Test

Test, test, test!

Reference

   * L<Test::Simple>
   * L<Test::More>
   * L<Test::Harness>
   * L<Test::LongString>

Controller

We are not going to use Test::WWW::Mechanize::Catalyst for this moment. Sure, I think we will add it later.

Model, esp. Schema

We are going to move all schema related code into ResultSet/ scope because it's easy to test without $c in Model/.

Some explanation in Foorum::Test under t/lib:

   * we use DBD::SQLite to test all schema function since it's very simple.

  sub schema {
      # override live cache
      $Foorum::Schema::cache = cache();
   
      # create the database
      my $db_file = "$path/test.db";
      my $schema
          = Foorum::Schema->connect( "dbi:SQLite:$db_file", '', '',
          { AutoCommit => 1, RaiseError => 1, PrintError => 1 },
          );
   
      return $schema;
  }

   * we use File::Cache as test cache backend. and with namespace: 'FoorumTest'

  sub cache {
      return $cache if ($cache);
   
      $cache = Cache::FileCache->new(
          {   namespace          => 'FoorumTest',
              default_expires_in => 300,
          }
      );
   
      return $cache;
  }

with this two things, the test case wouldn't affect the product site.

filter_word.t code explanation:

  #!/usr/bin/perl
   
  use strict;
  use warnings;
  use Test::More;
   
  ### Code Exp.
  ### To be sane, we skip if DBD::SQLite is not installed.
  BEGIN {
      eval { require DBI }
          or plan skip_all => "DBI is required for this test";
      eval { require DBD::SQLite }
          or plan skip_all => "DBD::SQLite is required for this test";
      plan tests           => 3;
  }
   
  ### Code Exp.
  ### load Foorum::TestUtils to get schema and cache
  use FindBin;
  use lib "$FindBin::Bin/../lib";
  use Foorum::TestUtils qw/schema cache base_path/;
  my $schema = schema();
  my $cache  = cache();
   
  ### Code Exp.
  ### Test with Foorum::ResultSet::FilterWord
  my $filter_word_res = $schema->resultset('FilterWord');
   
  ### Code Exp.
  ### to make test case moving smoothly, we just create some test data
  ### After test case is done, we need remove those data
  # create
  $filter_word_res->create(
      {   word => 'system',
          type => 'username_reserved'
      }
  );
  $filter_word_res->create(
      {   word => 'fuck',
          type => 'bad_word'
      }
  );
  $filter_word_res->create(
      {   word => 'asshole',
          type => 'offensive_word'
      }
  );
   
  ### Code Exp.
  ### Make sure exist cache wouldn't affect our test cases.
  $cache->remove("filter_word|type=username_reserved");
  $cache->remove("filter_word|type=bad_word");
  $cache->remove("filter_word|type=offensive_word");
   
  ### Code Exp.
  ### Check sub get_data in Foorum::ResultSet::FilterWord
  my @data = $filter_word_res->get_data('username_reserved');
   
  ### Code Exp.
  ### ok what we get cantains the one we created.
  ok( grep { $_ eq 'system' } @data, "get 'username_reserved' OK" );
   
  ### Code Exp.
  ### check sub has_bad_word in Foorum::ResultSet::FilterWord
  my $has_bad_word = $filter_word_res->has_bad_word("oh, fuck you!");
  is( $has_bad_word, 1, 'has_bad_word OK' );
   
  ### Code Exp.
  ### check sub convert_offensive_word in Foorum::ResultSet::FilterWord
  my $return_text = $filter_word_res->convert_offensive_word("kick your asshole la, dude!");
  like( $return_text, qr/\*/, 'convert_offensive_word OK' ); #\ #/
   
  ### Code Exp.
  ### Make our DB as the same as before we run it. so that we can run it many times
  END {
      # Keep Database the same from original
      use File::Copy ();
      my $base_path = base_path();
      File::Copy::copy( "$base_path/t/lib/Foorum/backup.db",
          "$base_path/t/lib/Foorum/test.db" );
  }
   
  1;

View Esp. TT

Generally we don't write any test cases for TT. but if we want to write one, that's still possible.

check t/templates/wrapper.t

  #!/usr/bin/perl
   
  use strict;
  use warnings;
  use Test::More;
   
  BEGIN {
      my $has_test_longstring
          = eval "use Test::LongString; 1;";    ## no critic (ProhibitStringyEval)
      $has_test_longstring or plan skip_all => "Test::LongString is required for this test";
      plan tests => 2;
  }
   
  use FindBin;
  use lib "$FindBin::Bin/../lib";
  use Foorum::TestUtils qw/tt2/;
  my $tt2 = tt2();
   
  my $var = {
      title   => 'TestTitle',
      RSS_URL => 'httpRSS_URL',
  };
   
  my $ret;
  $tt2->process( 'wrapper.html', $var, \$ret );
   
  contains_string( $ret, 'TestTitle', '[% title %] ok' );
  like_string(
      $ret,
      qr/application\/rss\+xml(.*?)href\=\"httpRSS_URL\"/,
      '[% RSS_URL %] OK'
  );

Others

Like Foorum::Formatter or Foorum::Utils, we just write normal test cases as told in Test::More.

Example: (t/formatter/textile.t)

  #!/usr/bin/perl
   
  use strict;
  use warnings;
  use Test::More;
   
  BEGIN {
      eval { require Text::Textile }
          or plan skip_all => "Text::Textile is required for this test";
   
      plan tests => 3;
  }
   
  use Foorum::Formatter qw/filter_format/;
   
  my $text = <<TEXT;
  h1. Heading
   
  A _simple_ demonstration of Textile markup.
   
  * One
  * Two
  * Three
   
  "More information":http://www.textism.com/tools/textile is available.
  TEXT
   
  my $html = filter_format( $text, { format => 'textile' } );
   
  like( $html, qr/h1/, 'h1 OK' );
  like( $html, qr/li/, '*,* OK' );
  like( $html, qr/\<a href=/,
      '"More information":http://www.textism.com/tools/textile OK' );

SEE ALSO

Foorum::Manual::Tutorial1, Foorum::Manual::Tutorial2, Foorum::Manual::Tutorial3, Foorum::Manual::Tutorial4