10vcp.t #16

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

=head1 NAME

vcp.t - testing of vcp command

=cut

use strict ;

use Carp ;
use Test ;
use VCP::TestUtils qw( vcp_cmd );

my @vcp = vcp_cmd ;

my $options = <<'END_TRANSFER';
Options: --help
END_TRANSFER

# Note the spaces instead of tabs and the spaces after the null:
my $null_transfer = <<'END_TRANSFER';
Source:
        null:   

Destination:    null:  
END_TRANSFER

# Note the spaces instead of tabs and the spaces after the null:
my $identity_transfer = <<'END_TRANSFER';
Source:
        null:   

Destination:    null:  

Identity:
END_TRANSFER

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

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

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

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


my @tests = (

#perldoc now complains when run as root, causing this test to fail
sub {
   return skip "preldoc may not be run as root", 1 unless $<;
   _ok [ "help" ], undef, [0], qr/help topics/i;
},
sub {
   return skip "preldoc may not be run as root", 1 unless $<;
   _ok [ "--help" ], undef, [0], qr/help topics/i
},

sub {
   _ok [ "vcp:-"  ], $options, [0], qr/help topics/i
},

sub { _ok [ qw( null: null:                     ) ] },
sub { _ok [ qw( null: identity: null:           ) ] },
sub { _ok [ qw( null: identity: identity: null: ) ] },

sub { _ok [ "vcp:-"                               ], $null_transfer     },
sub { _ok [ "vcp:-"                               ], $identity_transfer },

sub { _ok [ 'foo:'           ], undef, [ 2 ], qr/unknown source scheme/s        },
sub { _ok [ 'revml:', 'foo:' ], undef, [ 2 ], qr/unknown dest\w* scheme/s       },
sub { _ok [ '--foo'          ], undef, [ 1 ], qr/foo.*Usage/s                   },

sub {
   local $ENV{VCPDEBUG} = ".*";
   _ok [ "help" ], undef, undef, qr/Debugging/;
},

) ;

plan tests => scalar( @tests ) ;

$_->() for @tests ;