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

use base qw/Test::More Exporter/;
our @EXPORT = qw/as_alice as_bob as_charlie as_david as_user
  repo_uri_for replica_last_rev replica_uuid_for ok_added_revisions replica_uuid
  database_uuid database_uuid_for serialize_conflict serialize_changeset
  in_gladiator diag run_command set_editor set_editor_script load_record
  last_script_stdout last_script_stderr last_script_exit_code
  /;

use Cwd qw/getcwd/;
use File::Path 'rmtree';
use File::Spec;
use File::Temp qw/tempdir tempfile/;
use Params::Validate ':all';
use Prophet::Util;

use Prophet::CLI;

our $REPO_BASE = File::Temp::tempdir();
Test::More->import;
diag("Replicas can be found in $REPO_BASE");

# by default, load no configuration file
$ENV{PROPHET_APP_CONFIG} = '';

{
    no warnings 'redefine';
    require Test::More;

    sub Test::More::diag {    # bad bad bad # convenient convenient convenient
        Test::More->builder->diag(@_)
          if ( $Test::Harness::Verbose || $ENV{'TEST_VERBOSE'} );
    }
}

our $EDIT_TEXT = sub {shift};
do {
    no warnings 'redefine';
    *Prophet::CLI::Command::edit_text = sub {
        my $self = shift;
        $EDIT_TEXT->(@_);
    };
};


sub set_editor {
    $EDIT_TEXT = shift;
}


sub set_editor_script {
    my ( $self, $script ) = @_;

    delete $ENV{'VISUAL'};    # Proc::InvokeEditor checks this first
    $ENV{'EDITOR'} =
      "$^X " . Prophet::Util->catfile( getcwd(), 't', 'scripts', $script );
    Test::More::diag "export EDITOR=" . $ENV{'EDITOR'} . "\n";
}

sub import_extra {
    my $class = shift;
    my $args  = shift;

    Test::More->export_to_level(2);

    # Now, clobber Test::Builder::plan (if we got given a plan) so we
    # don't try to spit one out *again* later
    if ( $class->builder->has_plan ) {
        no warnings 'redefine';
        *Test::Builder::plan = sub { };
    }

    delete $ENV{'PROPHET_APP_CONFIG'};
    $ENV{'PROPHET_EMAIL'} = 'nobody@example.com';
}


sub in_gladiator (&) {
    my $code = shift;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $types;
    eval { require Devel::Gladiator; };
    if ($@) {
        warn 'Devel::Gladiator not found';
        return $code->();
    }
    for ( @{ Devel::Gladiator::walk_arena() } ) {
        $types->{ ref($_) }--;
    }

    $code->();
    for ( @{ Devel::Gladiator::walk_arena() } ) {
        $types->{ ref($_) }++;
    }
    map { $types->{$_} || delete $types->{$_} } keys %$types;

}


sub repo_path_for {
    my $username = shift;
    return File::Spec->catdir( $REPO_BASE => $username );
}

sub config_file_for {
    my $username = shift;

    return File::Spec->catdir( $REPO_BASE, $username, 'config' );
}


sub repo_uri_for {
    my $username = shift;

    my $path = repo_path_for($username);

    return 'file://' . $path;
}


sub replica_uuid {
    my $self = shift;
    my $cli  = Prophet::CLI->new();
    return $cli->handle->uuid;
}


sub database_uuid {
    my $self = shift;
    my $cli  = Prophet::CLI->new();
    return eval { $cli->handle->db_uuid };
}


sub replica_last_rev {
    my $cli = Prophet::CLI->new();
    return $cli->handle->latest_sequence_no;
}


our %REPLICA_UUIDS;
our %DATABASE_UUIDS;

sub as_user {
    my $username = shift;
    my $coderef  = shift;
    local $ENV{'PROPHET_REPO'}       = repo_path_for($username);
    local $ENV{'PROPHET_EMAIL'}      = $username . '@example.com';
    local $ENV{'PROPHET_APP_CONFIG'} = config_file_for($username);

    my $ret = $coderef->();

    $REPLICA_UUIDS{$username}  = replica_uuid();
    $DATABASE_UUIDS{$username} = database_uuid();

    return $ret;
}


sub replica_uuid_for {
    my $user = shift;
    return $REPLICA_UUIDS{$user};
}


sub database_uuid_for {
    my $user = shift;
    return $DATABASE_UUIDS{$user};
}


sub ok_added_revisions (&$$) {
    my ( $code, $num, $msg ) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $last_rev = replica_last_rev();
    $code->();
    is( replica_last_rev(), $last_rev + $num, $msg );
}


sub serialize_conflict {
    my ($conflict_obj) = validate_pos( @_, { isa => 'Prophet::Conflict' } );
    my $conflicts;
    for my $change ( @{ $conflict_obj->conflicting_changes } ) {
        $conflicts->{meta} = { original_source_uuid =>
              $conflict_obj->changeset->original_source_uuid };
        $conflicts->{records}->{ $change->record_uuid } =
          { change_type => $change->change_type, };

        for my $propchange ( @{ $change->prop_conflicts } ) {
            $conflicts->{records}->{ $change->record_uuid }->{props}
              ->{ $propchange->name } = {
                source_old => $propchange->source_old_value,
                source_new => $propchange->source_new_value,
                target_old => $propchange->target_value
              }

        }
    }
    return $conflicts;
}


sub serialize_changeset {
    my ($cs) = validate_pos( @_, { isa => 'Prophet::ChangeSet' } );

    return $cs->as_hash;
}


our $CLI_CLASS = 'Prophet::CLI';

sub run_command {
    my $output = '';
    my $error  = '';

    my $original_stdout = *STDOUT;
    my $original_stderr = *STDERR;
    open( my $out_handle, '>', \$output );
    open( my $err_handle, '>', \$error );
    *STDOUT = $out_handle;
    *STDERR = $err_handle;
    $|++;    # autoflush

    my $ret = eval {
        local $SIG{__DIE__} = 'DEFAULT';
        $CLI_CLASS->new->run_one_command(@_);
    };
    warn $@ if $@;

    # restore to originals
    *STDOUT = $original_stdout;
    *STDERR = $original_stderr;

    return wantarray ? ( $output, $error ) : $output;
}

{


    my $connection;

    sub load_record {
        my $type = shift;
        my $uuid = shift;
        require Prophet::Record;
        $connection ||= Prophet::CLI->new->handle;
        my $record =
          Prophet::Record->new( handle => $connection, type => $type );
        $record->load( uuid => $uuid );
        return $record;
    }
}


sub as_alice (&)  { as_user( alice   => shift ) }
sub as_bob (&)    { as_user( bob     => shift ) }
sub as_charlie(&) { as_user( charlie => shift ) }
sub as_david(&)   { as_user( david   => shift ) }

# END {
#     for (qw(alice bob charlie david)) {

#         #     as_user( $_, sub { rmtree [ $ENV{'PROPHET_REPO'} ] } );
#     }
# }

1;

__END__

=pod

=head1 NAME

Prophet::Test

=head1 VERSION

version 0.751

=head1 FUNCTIONS

=head2 set_editor($code)

Sets the subroutine that Prophet should use instead of
C<Prophet::CLI::Command::edit_text> (as this routine invokes an interactive
editor) to $code.

=head2 set_editor_script SCRIPT

Sets the editor that Proc::InvokeEditor uses.

This should be a non-interactive script found in F<t/scripts>.

=head2 in_gladiator($code)

Run the given code using L<Devel::Gladiator>.

=head2 repo_path_for($username)

Returns a path on disk for where $username's replica is stored.

=head2 repo_uri_for($username)

Returns a file:// URI for $USERNAME'S replica (with the correct replica type
prefix).

=head2 replica_uuid

Returns the UUID of the test replica.

=head2 database_uuid

Returns the UUID of the test database.

=head2 replica_last_rev

Returns the sequence number of the last change in the test replica.

=head2 as_user($username, $coderef)

Run this code block as $username.  This routine sets up the %ENV hash so that
when we go looking for a repository, we get the user's repo.

=head2 replica_uuid_for($username)

Returns the UUID of the given user's test replica.

=head2 database_uuid_for($username)

Returns the UUID of the given user's test database.

=head2 ok_added_revisions( { CODE }, $numbers_of_new_revisions, $msg)

Checks that the given code block adds the given number of changes to the test
replica. $msg is optional and will be printed with the test if given.

=head2 serialize_conflict($conflict_obj)

Returns a simple, serialized version of a L<Prophet::Conflict> object suitable
for comparison in tests.

The serialized version is a hash reference containing the following keys:    
  meta => { original_source_uuid => 'source_replica_uuid' }
  records => {
      'record_uuid' => {
          change_type => 'type',                   
          props => {
              propchange_name => {
                  source_old => 'old_val',                     
                  source_new => 'new_val',                       
                  target_old => 'target_val',                      
              }
          }                 
      },
      another_record_uuid' => {
          change_type => 'type',
          props => {
              propchange_name => {
                  source_old => 'old_val',
                  source_new => 'new_val',
                  target_old => 'target_val',
              }             
          }
      },
  }

=head2 serialize_changeset($changeset_obj)

Returns a simple, serialized version of a L<Prophet::ChangeSet> object suitable
for comparison in tests (a hash).

=head2 run_command($command, @args)

Run the given command with (optionally) the given args using a new
L<Prophet::CLI> object. Returns the standard output of that command in scalar
form or, in array context, the STDOUT in scalar form *and* the STDERR in scalar
form.

Examples:

    run_command('create', '--type=Foo');

=head2 load_record($type, $uuid)

Loads and returns a record object for the record with the given type and uuid.

=head2 as_alice CODE, as_bob CODE, as_charlie CODE, as_david CODE

Runs CODE as alice, bob, charlie or david.

=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