The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Prophet::Test::Participant;
{
  $Prophet::Test::Participant::VERSION = '0.751';
}
use Any::Moose;
use Prophet::Test;
use Test::Exception;

has name => (
    is  => 'rw',
    isa => 'Str',
);

has arena => (
    is       => 'rw',
    isa      => 'Prophet::Test::Arena',
    weak_ref => 1,
);

sub BUILD {
    my $self = shift;
    as_user( $self->name, sub { call_func( [qw(init)] ) } );
    as_user( $self->name,
        sub { call_func_ok( [qw(search --type Bug --regex .)] ) } );

}

use List::Util qw(shuffle);

my @CHICKEN_DO =
  qw(create_record create_record delete_record  update_record update_record update_record update_record update_record sync_from_peer sync_from_peer noop);

sub take_one_step {
    my $self   = shift;
    my $action = shift || ( shuffle(@CHICKEN_DO) )[0];
    my $args   = shift;
    @_ = ( $self, $args );
    goto $self->can($action);
}

sub _random_props {
    my @prop_values = qw(A B C D E);
    my @prop_keys   = qw(1 2 3 4 5);

    return ( map { "--" . $prop_keys[$_] => $prop_values[$_] } ( 0 .. 4 ) );

}

sub _permute_props {
    my %props = (@_);
    @props{ keys %props } = shuffle( values %props );

    for ( keys %props ) {
        if ( int( rand(10) < 2 ) ) {
            delete $props{$_};
        }
    }

    if ( int( rand(10) < 3 ) ) {
        $props{ int( rand(5) ) + 1 } = chr( rand(5) + 65 );
    }

    return %props;
}

sub noop {
    my $self = shift;
    ok( 1, $self->name . ' - NOOP' );
}

sub delete_record {
    my $self = shift;
    my $args = shift;
    $args->{record} ||= get_random_local_record();

    return unless ( $args->{record} );
    $self->record_action( 'delete_record', $args );
    call_func_ok( [ qw(delete --type Scratch --uuid), $args->{record} ] );

}

sub create_record {
    my $self = shift;
    my $args = shift;
    @{ $args->{props} } = _random_props() unless $args->{props};

    my ( $ret, $out, $err ) =
      call_func_ok( [ qw(create --type Scratch --), @{ $args->{props} } ] );

    #    ok($ret, $self->name . " created a record");
    if ( $out =~ /Created\s+(.*?)\s+(\d+)\s+\((.*)\)/i ) {
        $args->{result} = $3;
    }
    $self->record_action( 'create_record', $args );
}

sub update_record {
    my $self = shift;
    my $args = shift;

    $args->{record} ||= get_random_local_record();
    return unless ( $args->{'record'} );

    my ( $ok, $stdout, $stderr ) =
      call_func( [ qw(show --type Scratch --uuid), $args->{record} ] );

    my %props = map { split( /: /, $_, 2 ) } split( /\n/, $stdout );
    delete $props{id};

    %{ $args->{props} } = _permute_props(%props) unless $args->{props};
    %props = %{ $args->{props} };

    call_func_ok(
        [
            qw(update --type Scratch --uuid),
            $args->{record}, '--', map { '--' . $_ => $props{$_} } keys %props
        ],
        $self->name . " updated a record"
    );

    $self->record_action( 'update_record', $args );

}

sub sync_from_peer {
    my $self = shift;
    my $args = shift;

    my $from = $args->{from} ||=
      ( shuffle( grep { $_->name ne $self->name } $self->arena->chickens ) )[0]
      ->name;

    $self->record_action( 'sync_from_peer', $args );

    @_ = (
        [
            'merge',                     '--prefer',
            'to',                        '--from',
            repo_uri_for($from),         '--to',
            repo_uri_for( $self->name ), '--force'
        ],
        $self->name . " sync from " . $from . " ran ok!"
    );
    goto \&call_func_ok;

}

sub get_random_local_record {
    my ( $ok, $stdout, $stderr ) =
      call_func( [qw(search --type Scratch --regex .)] );
    my $update_record =
      ( shuffle( map { $_ =~ /'uuid': '(\S*?)'/ } split( /\n/, $stdout ) ) )
      [0];
    return $update_record;
}

sub dump_state {
    my $self = shift;
    my $cli  = Prophet::CLI->new();

    my $state;

    my $records =
      Prophet::Collection->new( handle => $cli->handle, type => 'Scratch' );
    my $merges = Prophet::Collection->new(
        handle => $cli->handle,
        type   => $Prophet::Replica::MERGETICKET_METATYPE
    );
    my $resolutions = Prophet::Collection->new(
        handle => $cli->app_handle->handle->resolution_db_handle,
        type   => '_prophet_resolution'
    );

    $records->matching( sub     {1} );
    $resolutions->matching( sub {1} );
    $merges->matching( sub      {1} );

    %{ $state->{records} } = map { $_->uuid => $_->get_props } $records->items;
    %{ $state->{merges} }  = map { $_->uuid => $_->get_props } $merges->items;
    %{ $state->{resolutions} } =
      map { $_->uuid => $_->get_props } $resolutions->items;

    return $state;

}

sub dump_history { }

sub record_action {
    my ( $self, $action, @arg ) = @_;
    $self->arena->record( $self->name, $action, @arg );
}

use Test::Exception;

sub call_func_ok {
    my @args = @_;
    my @ret;
    lives_and {
        @ret = call_func(@args);
        diag(
            "As " . $ENV{'PROPHET_EMAIL'} . " " . join( ' ', @{ $args[0] } ) );
        ok( 1, join( " ", $ENV{'PROPHET_EMAIL'}, @{ $args[0] } ) );
    };
    return @ret;
}

sub call_func {
    Carp::cluck unless ref $_[0];

    my @args = @{ shift @_ };
    my $cli  = Prophet::CLI->new();

    my $str = '';
    open my $str_fh, '>', \$str;

    my $old_fh = select($str_fh);

    my $ret;
    if ( my $p = SVN::Pool->can('new_default') ) {
        $p->('SVN::Pool');
    }

    $ret = $cli->run_one_command(@args);
    select($old_fh) if defined $old_fh;

    return ( $ret, $str, undef );
}

__PACKAGE__->meta->make_immutable;
no Any::Moose;

1;

__END__

=pod

=head1 NAME

Prophet::Test::Participant

=head1 VERSION

version 0.751

=head1 AUTHORS

=over 4

=item *

Jesse Vincent <jesse@bestpractical.com>

=item *

Chia-Liang Kao <clkao@bestpractical.com>

=item *

Christine Spang <christine@spang.cc>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2009 by Best Practical Solutions.

This is free software, licensed under:

  The MIT (X11) License

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://rt.cpan.org/Public/Dist/Display.html?Name=Prophet>.

=head1 CONTRIBUTORS

=over 4

=item *

Alex Vandiver <alexmv@bestpractical.com>

=item *

Casey West <casey@geeknest.com>

=item *

Cyril Brulebois <kibi@debian.org>

=item *

Florian Ragwitz <rafl@debian.org>

=item *

Ioan Rogers <ioanr@cpan.org>

=item *

Jonas Smedegaard <dr@jones.dk>

=item *

Kevin Falcone <falcone@bestpractical.com>

=item *

Lance Wicks <lw@judocoach.com>

=item *

Nelson Elhage <nelhage@mit.edu>

=item *

Pedro Melo <melo@simplicidade.org>

=item *

Rob Hoelz <rob@hoelz.ro>

=item *

Ruslan Zakirov <ruz@bestpractical.com>

=item *

Shawn M Moore <sartak@bestpractical.com>

=item *

Simon Wistow <simon@thegestalt.org>

=item *

Stephane Alnet <stephane@shimaore.net>

=item *

Unknown user <nobody@localhost>

=item *

Yanick Champoux <yanick@babyl.dyndns.org>

=item *

franck cuny <franck@lumberjaph.net>

=item *

robertkrimen <robertkrimen@gmail.com>

=item *

sunnavy <sunnavy@bestpractical.com>

=back

=cut