[Bps-public-commit] r11343 - in SVN-PropDB: bin

[clkao at bestpractical.com]

Author: clkao
Date: Tue Apr  1 19:39:20 2008
New Revision: 11343

Added:
   SVN-PropDB/bin/run_test_yml.pl
Modified:
   SVN-PropDB/lib/Prophet/Test/Arena.pm

Log:
helper for test::arena to run a recorded test.


Added: SVN-PropDB/bin/run_test_yml.pl
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/run_test_yml.pl	Tue Apr  1 19:39:20 2008
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+use strict;
+use Prophet::Test::Arena;
+
+Prophet::Test::Arena->run_from_yaml;
+
+
+=head1 NAME
+
+run_test_yml - rerun recorded test
+
+=head1 SYNOPSIS
+
+  prove -l t/generalized_sync_n_merge.t
+  perl -Ilib bin/run_test_yml.pl RECORDED-TEST.yml
+
+=head1 DESCRIPTION
+
+You can also copy this file to a .t file, and append the yml content into the
+C<__DATA__> section.
+
+=cut
+

Modified: SVN-PropDB/lib/Prophet/Test/Arena.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Test/Arena.pm	(original)
+++ SVN-PropDB/lib/Prophet/Test/Arena.pm	Tue Apr  1 19:39:20 2008
@@ -6,8 +6,10 @@
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors(qw/chickens record_callback history/);
 
+use Prophet::Test::Participant;
 use Acme::MetaSyntactic;
 use Prophet::Test;
+use YAML::Syck ();
 
 sub setup {
     my $self  = shift;
@@ -18,6 +20,54 @@
     $self->chickens(@chickens);
 }
 
+sub run_from_yaml {
+    my $self = shift;
+    my @c = caller(0);
+    no strict 'refs';
+    my $fh = *{$c[0].'::DATA'};
+
+    return $self->run_from_yamlfile(@ARGV) unless fileno($fh);
+
+    local $/;
+    $self->run_from_data(YAML::Syck::Load( <$fh> ));
+}
+
+sub run_from_yamlfile {
+    my ($self, $file) = @_;
+    $self->run_from_data(YAML::Syck::LoadFile( $file ));
+}
+
+sub run_from_data {
+    my ($self, $data) = @_;
+
+    Test::More::plan( tests => scalar @{ $data->{recipe}} );
+    my $arena = Prophet::Test::Arena->new(
+        { record_callback => sub {
+                my ( $name, $action, $args ) = @_;
+                return;
+            },
+        }
+    );
+    $arena->setup($data->{chickens});
+
+    my $record_map;
+
+    for (@{$data->{recipe}}) {
+        my ($name, $action, $args) = @$_;
+        my ($chicken) = grep { $_->name eq $name } @{ $arena->chickens };
+        if ($args->{record}) {
+            $args->{record} = $record_map->{ $args->{record} };
+    }
+        my $next_result = $args->{result};
+
+        as_user($chicken->name, sub { $chicken->take_one_step($action, $args ) });
+
+        if ($args->{result}) {
+            $record_map->{ $next_result } = $args->{result};
+        }
+    }
+}
+
 sub step {
     my $self = shift;
     my $step_name = shift || undef;