view release on metacpan or  search on metacpan

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

      if ($@ =~ /Please install missing modules/) {
        plan skip_all => "Missing deps for operation $op";
      } else {
        die $@;
      }
    }
  }
}

sub new {
  my $class = shift;
  my %args  = @_;

  my $this = {
    INPUT     => create_stream($args{'input'}),
    OUTPUT    => create_stream($args{'output'}),
    OPERATION => $args{'operation'},
    KEEPER    => $args{'keeper'},
  };

  bless $this, $class;

  return $this;
}

sub create_stream {
  my $input = shift;

  return undef unless ( $input );
  return $input if ( ref($input) eq 'ARRAY' );

  if ( UNIVERSAL::isa($input, 'App::RecordStream::InputStream') ) {
    return $input;
  }

  if ( (not ($input =~ m/\n/m))  && -e $input ) {
    return App::RecordStream::InputStream->new(FILE => $input);
  }

  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";