Beta Shell v2.0

File Manager

Name	Size	Perms	Modified	Actions
[ .. / .. ]
DondeEstan.pm	332 B	-rw-r--r--	2014-11-03 18:39:14	Edit Del
Loops	-	drwxr-xr-x	2022-02-23 11:31:13	Del
Loops.pm	7.19 KB	-rw-r--r--	2014-11-03 18:39:14	Edit Del
Sequence.pm	3.7 KB	-rw-r--r--	2020-02-01 16:21:39	Edit Del
Editing: Loops.pm (7.19 KB)

# vim: ts=2 sw=2 expandtab

package POE::Test::Loops;
$POE::Test::Loops::VERSION = '1.360';
use warnings;
use strict;

use File::Spec;
use File::Path;
use File::Find;

use constant TEST_BLOCK_FOR_WHICH => 0x01;
use constant TEST_BLOCK_FOR_WRONG => 0x02;
use constant TEST_BLOCK_FOR_RIGHT => 0x04;
use constant TEST_BLOCK_BEGIN     => 0x08;

### Find the test libraries.

use lib qw(./lib ../lib);
use POE::Test::DondeEstan;
my $source_base = POE::Test::DondeEstan->marco();

### Generate loop tests.

sub generate {
  my ($dir_base, $loops, $flag_verbose) = @_;

  foreach my $loop (@$loops) {
    my $loop_dir = lc($loop);
    $loop_dir =~ s/::/_/g;

    my $fqmn = _find_event_loop_file($loop);
    unless ($fqmn) {
      $flag_verbose and print "Couldn't find a loop for $loop ...\n";
      next;
    }

    $flag_verbose and print "Found $fqmn\n";

    my $loop_cfg = _get_loop_cfg($fqmn);
    unless (defined $loop_cfg and length $loop_cfg) {
      $loop_cfg = (
				"sub skip_tests { return }"
			);
    }

    my $source = (
			"#!/usr/bin/perl -w\n" .
			"\n" .
			"use strict;\n" .
			"\n" .
			"use lib qw(--base_lib--);\n" .
			"use Test::More;\n" .
			"use POSIX qw(_exit);\n" .
			"\n" .
			"--loop_cfg--\n" .
			"\n" .
			"BEGIN {\n" .
			"  if (my \$why = skip_tests('--test_name--')) {\n" .
			"    plan skip_all => \$why\n" .
			"  }\n" .
			"}\n" .
			"\n" .
			"# Run the tests themselves.\n" .
			"require '--base_file--';\n" .
			"\n" .
			"_exit 0 if \$^O eq 'MSWin32';\n" .
			"CORE::exit 0;\n"
		);

		# Full directory where source files are found.

    my $dir_src = File::Spec->catfile($source_base, "Loops");
    my $dir_dst = File::Spec->catfile($dir_base, $loop_dir);

		# Gather the list of source files.
		# Each will be used to generate a real test file.

    opendir BASE, $dir_src or die $!;
    my @base_files = grep /\.pm$/, readdir(BASE);
    closedir BASE;

		# Initialize the destination directory.  Clear or create as needed.

    $dir_dst =~ tr[/][/]s;
    $dir_dst =~ s{/+$}{};

    rmtree($dir_dst);
    mkpath($dir_dst, 0, 0755);

		# For each source file, generate a corresponding one in the
		# configured destination directory.  Expand various bits to
		# customize the test.

    foreach my $base_file (@base_files) {
      my $test_name = $base_file;
      $test_name =~ s/\.pm$//;

      my $full_file = File::Spec->catfile($dir_dst, $base_file);
      $full_file =~ s/\.pm$/.t/;

			# These hardcoded expansions are for the base file to be required,
			# and the base library directory where it'll be found.

      my $expanded_src = $source;
      $expanded_src =~ s/--base_file--/$base_file/g;
      $expanded_src =~ s/--base_lib--/$dir_src/g;
      $expanded_src =~ s/--loop_cfg--/$loop_cfg/g;
      $expanded_src =~ s/--test_name--/$test_name/g;

			# Write with lots of error checking.

      open EXPANDED, ">$full_file" or die $!;
      print EXPANDED $expanded_src;
      close EXPANDED or die $!;
    }
  }
}

sub _find_event_loop_file {
  my $loop_name = shift;

  my $loop_module;
  if ($loop_name =~ /^POE::/) {
    $loop_module = File::Spec->catfile(split(/::/, $loop_name)) . ".pm";
  }
  else {
    $loop_name =~ s/::/_/g;
    $loop_module = File::Spec->catfile("POE", "Loop", $loop_name) .  ".pm";
  }

  foreach my $inc (@INC) {
    my $fqmn = File::Spec->catfile($inc, $loop_module);
    next unless -f $fqmn;
    return $fqmn;
  }

  return;
}

sub _get_loop_cfg {
  my $fqmn = shift;

  my ($in_test_block, @test_source);

  open SOURCE, "<$fqmn" or die $!;
  while (<SOURCE>) {
    # Not in a test block.
    unless ($in_test_block) {

      # Proper =for syntax.
      if (/^=for\s+poe_tests\s+(\S.*?)$/) {
        push @test_source, $1;
        $in_test_block = TEST_BLOCK_FOR_RIGHT;
        next;
      }

      # Not sure which =for syntax is in use.
      if (/^=for\s+poe_tests\s*$/) {
        $in_test_block = TEST_BLOCK_FOR_WHICH;
        next;
      }

      if (/^=begin\s+(poe_tests)\s*$/) {
        $in_test_block = TEST_BLOCK_BEGIN;
        next;
      }

      # Some random line.  Do nothing.
      next;
    }

    # Which test block format are we in?
    if ($in_test_block & TEST_BLOCK_FOR_WHICH) {
      # If the following line is blank, then we're probably in the
      # wrong, multi-line kind originally documented and now
      # deprecated.
      if (/^\s*$/) {
        $in_test_block = TEST_BLOCK_FOR_WRONG;
        next;
      }

      # The following line is not blank, so it appears we're in a
      # properly formatted =for paragraph.
      $in_test_block = TEST_BLOCK_FOR_RIGHT;
      push @test_source, $_;
      next;
    }

    # The =begin syntax ends with an =end.
    if ($in_test_block & TEST_BLOCK_BEGIN) {
      if (/^=end\s*poe_tests\s*$/) {
        $in_test_block = 0;
        next;
      }

      # Be helpful?
      die "=cut not the proper way to end =begin poe_tests" if /^=cut\s*$/;

      push @test_source, $_;
      next;
    }

    # The proper =for syntax ends on a blank line.
    if ($in_test_block & TEST_BLOCK_FOR_RIGHT) {
      if (/^$/) {
        $in_test_block = 0;
        next;
      }

      # Be helpful?
      die "=cut not the proper way to end =for poe_tests" if /^=cut\s*$/;

      push @test_source, $_;
      next;
    }

    # The wrong =for syntax ends on =cut.
    if ($in_test_block & TEST_BLOCK_FOR_WRONG) {
      if (/^=cut\s*$/) {
        $in_test_block = 0;
        next;
      }

      # Be helpful?
      die "=end not the proper way to end =for poe_tests" if /^=end/;

      push @test_source, $_;
      next;
    }

    die "parser in unknown state: $in_test_block";
  }

  shift @test_source while @test_source and $test_source[0] =~ /^\s*$/;
  pop @test_source while @test_source and $test_source[-1] =~ /^\s*$/;

  return join "", @test_source;
}

1;

__END__

=head1 NAME

POE::Test::Loops - Reusable tests for POE::Loop authors

=head1 SYNOPSIS

	#!/usr/bin/perl -w

	use strict;
	use Getopt::Long;
	use POE::Test::Loops;

	my ($dir_base, $flag_help, @loop_modules, $flag_verbose);
	my $result = GetOptions(
		'dirbase=s' => \$dir_base,
		'loop=s' => \@loop_modules,
		'verbose' => \$flag_verbose,
		'help' => \$flag_help,
	);

	if (
		!$result or !$dir_base or $flag_help or !@loop_modules
	) {
		die(
			"$0 usage:\n",
			"  --dirbase DIR   (required) base directory for tests\n",
			"  --loop MODULE   (required) loop modules to test\n",
			"  --verbose   show some extra output\n",
			"  --help   you're reading it\n",
		);
	}

	POE::Test::Loops::generate($dir_base, \@loop_modules, $flag_verbose);
	exit 0;

=head1 DESCRIPTION

POE::Test::Loops contains one function, generate(), which will
generate all the loop tests for one or more POE::Loop subclasses.

The L</SYNOPSIS> example is a version of L<poe-gen-tests>, which is a
stand-alone utility to generate the actual tests.  L<poe-gen-tests>
also documents the POE::Test::Loops system in more detail.

=head1 FUNCTIONS

=head2 generate( $DIRBASE, \@LOOPS, $VERBOSE )

Generates the loop tests.  DIRBASE is the (relative) directory in
which a subdirectory for each of the LOOPS is created.  If VERBOSE is
set to a TRUE value some progress reporting is printed.

	POE::Test::Loops::generate(
		"./t",
		[ "POE::Loop::Yours" ],
		1,
	);

=head1 SEE ALSO

L<POE::Loop> and L<poe-gen-tests>.

=head1 AUTHOR & COPYRIGHT

See L<poe-gen-tests>.

=cut