view release on metacpan or  search on metacpan

lib/App/RecordStream/Test/OperationHelper.pm  view on Meta::CPAN

  return App::RecordStream::InputStream->new(STRING => $input);
}

sub matches {
  my $this = shift;
  my $name = shift || 'unnamed';

  my $op     = $this->{'OPERATION'};
  my $input  = $this->{'INPUT'};

  if ( $op->wants_input() && $input ) {
    if ( ref($input) eq 'ARRAY' ) {
      my ($t, @v) = @$input;
      if ( $t eq 'LINES' ) {
        for my $l (@v) {
          if ( ! $op->accept_line($l) ) {
            last;
          }
        }
      }
      elsif ( $t eq 'FILES' ) {
        local @ARGV = @v;
        while(my $l = <>) {
          App::RecordStream::Operation::set_current_filename($ARGV);
          chomp $l;
          if ( ! $op->accept_line($l) ) {
            last;
          }
        }
      }
      else {
        die;
      }
    }
    else {
      App::RecordStream::Operation::set_current_filename($input->get_filename());
      while ( my $r = $input->get_record() ) {
        if ( ! $op->accept_record($r) ) {
          last;
        }
      }
    }
  }
  $op->finish();

  my $output  = $this->{'OUTPUT'};
  my $results = $this->{'KEEPER'}->get_records();
  my $i = 0;

  #ok(0, "DIE");
  my @output_records;
  if ( $output ) {
    while ( my $record = $output->get_record() ) {
      push @output_records, $record;
    }
  }

  # Find the call level of the originating test file for better diagnostic
  # reporting if we fail tests below
  my ($level_to_testfile, $file) = (0, (caller(0))[1]);
  while (defined $file and $file !~ /\.t$/) {
    $level_to_testfile++;
    $file = (caller($level_to_testfile))[1];
  }

  local $Test::Builder::Level = $Test::Builder::Level + $level_to_testfile + 1;

  my $is_ok = 1;
  for my $record (@$results) {
    $is_ok = 0 if ( ! ok(UNIVERSAL::isa($record, 'App::RecordStream::Record'), "Record is a App::RecordStream::Record") );
  }

  $is_ok = 0 if ( ! is_deeply($results, \@output_records, "Records match: $name") );

  $is_ok = 0 if ( ! ok($this->{'KEEPER'}->has_called_finish(), "Has called finish: $name") );

  if ( ! $is_ok ) {
    warn "Expected and output differed!\nExpected:\n";
    for my $record (@output_records) {
      print STDERR App::RecordStream::OutputStream::hashref_string($record) . "\n";
    }
    warn "Output from module:\n";
    for my $record (@$results) {
      print STDERR App::RecordStream::OutputStream::hashref_string($record) . "\n";
    }
  }

  return $is_ok;
}

sub do_match {
  my $class          = shift;
  my $operation_name = shift;
  my $args           = shift;
  my $input          = shift;
  my $output         = shift;

  my $operation_class = "App::RecordStream::Operation::$operation_name";
  my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new();
  my $op = $operation_class->new($args, $keeper);

  if ( $op->wants_input() && @$args ) {
    if ( $input ) {
      fail("Both extra args [" . join(", ", @$args) . "] and input provided?");
    }
    else {
      $input = ['FILES', @$args];
    }
  }

  ok($op, "Operation initialization");

  my $helper = $class->new(
    operation => $op,
    keeper    => $keeper,
    input     => $input,
    output    => $output,
  );

  $helper->matches();

  return $helper;
}