01ui.t #3

#!/usr/local/bin/perl -w

=head1 NAME

01ui.t - testing of VCP::UI

=cut

use strict ;

use Carp ;
use Test ;
use VCP::UI;
use IPC::Run qw( start pump finish timeout run );
use VCP::TestUtils qw( vcp_cmd );

my @vcp = vcp_cmd ;


my $ui;


sub _ok {
   my ( $cli_params, $stdin, $exp_return_codes, $expected ) = @_;

   my ( $out, $err ) = ( "", "" );
   my $is_ok = eval {
      VCP::TestUtils::run [ @vcp, @$cli_params ],
         \$stdin,
         \$out,
         \$err,
         { ok_result_codes => $exp_return_codes };
      1;
   };

   warn "$err" if $err && ! $is_ok;

   @_ = (
      $is_ok ? defined $expected ? "$out$err" : $is_ok : $@,
      defined $expected ? $expected : 1,
      join " ",
         "vcp",
         @$cli_params,
         $stdin ? qq{\\"$stdin"} : ()
   );
   goto &ok;
}

# Rough test of an interactive vcp session.
#
# Takes a list of alternating (output, input) pairs, where the output
# strings are generally user prompts.  The list may be odd-sized, with
# the final output item having no user input expected in response.
#
# Runs vcp in interactive mode, with the input supplied.  There is no
# attempt made to make sure the responses match up with the input,
# only that the responses are seen in the order expected.  The
# responses given are regexes.  They are concatenated together with
# '*', so they need not be complete.
# 
sub ok_interactive_vcp {
   my $options;
   $options = pop if ref $_[-1];
   croak "expected_return_codes option required, and must be array ref"
      unless ref $options->{expected_return_codes} eq "ARRAY";

   my (@output, @prompts);
   while( @_ ) {
      push @output, shift;
      push @prompts, shift
         if @_;
   }
   my $in = join( "\n", @prompts ) . "\n";
   #my $re = join( ".*", map "quotemeta $_", @output );
   my $re = join( ".*", @output );

   my @vcp = qw( vcp );
   _ok [], $in, $options->{expected_return_codes}, /$re/i ;
}


my @tests = (
sub { 
    $ui = VCP::UI->new;
    ok 1;
},

sub { 
    ok ! defined eval { VCP::UI->new( UI => "NOT::A::REAL::MODULE" )->run };
},

sub {
   ok_interactive_vcp(
      "This is vcp's interactive user interface.", "n",
      { expected_return_codes => [0] }
   );
},

sub {
   my $tmpfile = "/tmp/${$}_vcp_01ui_tmp.revml";
   `echo '<revml/>' > $tmpfile`;
   ok_interactive_vcp(
      "continue",                   "y",
      "source scm type",            "revml",
      "revml filespec",             "$tmpfile",
      "destination scm type",       "revml",
      "revml filespec",             "/dev/null",
      "vcp: sorting revisions by change_id",
      { expected_return_codes => [0] }
   );
   unlink $tmpfile;
},

) ;

plan tests => scalar( @tests ) ;

$_->() for @tests ;