Test::AskAnExpert::Interface::Mock - Mock interface for testing Test::AskAnExpert


Test-AskAnExpert documentation Contained in the Test-AskAnExpert distribution.

Index


Code Index:

NAME

Top

Test::AskAnExpert::Interface::Mock - Mock interface for testing Test::AskAnExpert

SYNOPSIS

Top

  use Test::AskAnExpert;

  initialize('Test::AskAnExpert::Interface::Mock',
              answer  => 'always do this',
              comment => 'saying this about it',
              skip    => 'or skip because of this',
              error   => 'or give this error'
	      never_answer => 0);

  # do some testing here to make sure Test::AskAnExpert
  # reacts properly.

DESCRIPTION

Top

This is for internal testing. If you're re-implementing Test::AskAnExpert you might find it useful yourself.

AUTHOR

Top

Edgar A. Bering, <trizor@cpan.org>

COPYRIGHT AND LICENSE

Top


Test-AskAnExpert documentation Contained in the Test-AskAnExpert distribution.
package Test::AskAnExpert::Interface::Mock;

use strict;
use warnings;
use base 'Test::AskAnExpert::Interface';

our $VERSION = 1.1;

sub load {
  my $class = shift;
  my %args = @_;
  my $self = {};

  $self->{_answer} = $args{answer};
  $self->{_comment} = $args{comment};
  $self->{_skip} = $args{skip};
  $self->{_error} = $args{error};
  $self->{_dont} = $args{never_answer};

  bless $self,$class;
}

sub submit {
  my ($self,$question,$name) = @_;

  $self->err($self->{_error}), return undef if $self->{_error};
  return Test::AskAnExpert::Question->new(question=>$question,
                                    name=>$name,
                                    id=>"id",
                                    skip=>$self->{_skip}) if $self->{_skip};
  return Test::AskAnExpert::Question->new(question=>$question,name=>$name,id=>"id");
}

sub has_answer {
  my $self = shift;
  return !$self->{_dont};
}

sub answer {
  my ($self,$Qobj) = @_;

  $self->err($self->{_error}), return undef if $self->{_error};
  $Qobj->answer($self->{_answer},$self->{_comment});
}


1;