view release on metacpan or  search on metacpan

lib/ASNMTAP/Asnmtap/Plugins/NPTest.pm  view on Meta::CPAN

      }
    }

    if ( %exceptions && exists( $exceptions{$exitStatus} ) )
    {
      $testStatus += skip( $exceptions{$exitStatus}, $exitStatus, $desiredExitStatus );
      $testOutput = "skip";
    }
    else
    {
      $testStatus += ok( $exitStatus, $desiredExitStatus );
    }
  }

  if ( defined( $desiredOutput ) )
  {
    if ( $testOutput ne "skip" )
    {
      $testStatus += ok( $output, $desiredOutput );
    }
    else
    {
      $testStatus += skip( "Skipping output test as requested", $output, $desiredOutput );
    }
  }

  return $testStatus;
}


sub skipMissingCmd
{
  my( $command, $count ) = @_;

  my $testStatus;

  for ( 1 .. $count )
  {
    $testStatus += skip( "Missing ${command} - tests skipped", 1 );
  }

  return $testStatus;
}

sub getTestParameter
{
  my( $param, $envvar, $default, $brief, $scoped );
  my $new_style;
  if (scalar @_ <= 3) {
	($param, $brief, $default) = @_;
	$envvar = $param;
	$new_style = 1;
  } else {
	( $param, $envvar, $default, $brief, $scoped ) = @_;
	$new_style = 0;
  }

  # Apply default values for optional arguments
  $scoped = ( defined( $scoped ) && $scoped );

  my $testharness = basename( (caller(0))[1], ".t" ); # used for scoping

  if ( defined( $envvar ) &&  exists( $ENV{$envvar} ) && $ENV{$envvar} )
  {
    return $ENV{$envvar};
  }

  my $cachedValue = SearchCache( $param, $testharness );
  if ( defined( $cachedValue ) )
  {
    # This save required to convert to new style because the key required is
    # changing to the environment variable
    if ($new_style == 0) {
      SetCacheParameter( $envvar, undef, $cachedValue );
    }
    return $cachedValue;
  }

  my $defaultValid      = ( defined( $default ) && $default );
  my $autoAcceptDefault = ( exists( $ENV{'NPTEST_ACCEPTDEFAULT'} ) && $ENV{'NPTEST_ACCEPTDEFAULT'} );

  if ( $autoAcceptDefault && $defaultValid )
  {
    return $default;
  }

  # Set "none" if no terminal attached (eg, tinderbox build servers when new variables set)
  return "" unless (-t STDERR);

  my $userResponse = '';

  while ( $userResponse eq '' )
  {
    print STDERR "\n";
    print STDERR "Test Harness         : $testharness\n";
    print STDERR "Test Parameter       : $param\n";
    print STDERR "Environment Variable : $envvar\n" if ($param ne $envvar);
    print STDERR "Brief Description    : $brief\n";
    print STDERR "Enter value (or 'none') ", ($defaultValid ? "[${default}]" : "[]"), " => ";
    $userResponse = <STDIN>;
    $userResponse = "" if ! defined( $userResponse ); # Handle EOF
    chomp( $userResponse );
    if ( $defaultValid && $userResponse eq '' )
    {
      $userResponse = $default;
    }
  }

  print STDERR "\n";

  if ($userResponse =~ /^(na|none)$/) {
	$userResponse = '';
  }

  # define all user responses at global scope
  SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse );

  return $userResponse;
}

#

lib/ASNMTAP/Asnmtap/Plugins/NPTest.pm  view on Meta::CPAN

  closedir( DIR );

  return sort @tests;
}

# All the new object oriented stuff below

sub new { 
	my $type = shift;
	my $self = {};
	return bless $self, $type;
}

# Accessors
sub return_code {
	my $self = shift;
	if (@_) {
		return $self->{return_code} = shift;
	} else {
		return $self->{return_code};
	}
}
sub output {
	my $self = shift;
	if (@_) {
		return $self->{output} = shift;
	} else {
		return $self->{output};
	}
}

sub perf_output {
	my $self = shift;
	$_ = $self->{output};
	/\|(.*)$/;
	return $1 || "";
}

sub only_output {
	my $self = shift;
	$_ = $self->{output};
	/(.*?)\|/;
	return $1 || "";
}

sub testCmd {
	my $class = shift;
	my $command = shift or die "No command passed to testCmd";
	my $object = $class->new;
	
	my $output = `$command`;
	$object->return_code($? >> 8);
	$_ = $? & 127;
	if ($_) {
		die "Got signal $_ for command $command";
	}
	chomp $output;
	$object->output($output);

	if ($ENV{'NPTEST_DEBUG'}) {
		my ($pkg, $file, $line) = caller(0);
		print "testCmd: Called from line $line in $file", $/;
		print "Testing: $command", $/;
		print "Output:  ", $object->output, $/;
		print "Return code: ", $object->return_code, $/;
	}

	return $object;
}

1;
#
# End of File
#