view release on metacpan or  search on metacpan

t/lib/Bot/Telegram/Test.pm  view on Meta::CPAN

package Bot::Telegram::Test;

use Mojo::Base -strict;
use Mojo::IOLoop;

use Test::MockObject;
use Test::MockObject::Extends;

use Mojo::JSON qw/encode_json decode_json/;
use Mojo::UserAgent;
use Mojo::Transaction::HTTP;

use WWW::Telegram::BotAPI;

use base 'Exporter';
our @EXPORT = qw {
  timer
  update
  loop_for_a_second
  random_valid_polling_response
  json_response
  bot_api
};

my @UPDATES = qw/message edited_message edited_channel_post callback_query/;

sub timer(&$) { Mojo::IOLoop -> timer(pop, pop) } ## no critic

sub loop_for_a_second {
  timer { Mojo::IOLoop -> stop } 1;
  Mojo::IOLoop -> start;
}

sub update {
  my ($type, $id) = @_;

  return {
    $type => {
      foo => 'bar',
      baz => 'qux',
    },

    update_id => $id,
  };
}

sub json_response(;$) { ## no critic
  Mojo::Message::Response
    -> new
    -> body(encode_json shift);
}

sub random_valid_polling_response {
  my $updates_count = shift // 3;

  json_response {
    ok => \1,
    result => [map { update $UPDATES[rand scalar @UPDATES], $_ } 1 .. $updates_count]
  }
}

# Error handling in synchronous mode
# mostly copypasted from WWW::Telegram::BotAPI sources
sub _handle_error_sync {
  my $tx = shift;
  my $response = $tx -> res -> json;

  unless (!$tx->error && $response && $response->{ok}) {
    $response ||= {};
    my $error = $response->{description} || WWW::Telegram::BotAPI::_mojo_error_to_string($tx);
    # Print either the error returned by the API or the HTTP status line.
    Carp::confess
      "ERROR: ", ($response->{error_code} ? "code " . $response->{error_code} . ": " : ""),
      $error || "something went wrong!";
  }

  $response
}

sub bot_api {
  # Request hook
  my $hook;
  $hook = pop if ref $_[$#_] eq 'CODE';

  my @responses = @_;

  my $api = Test::MockObject::Extends -> new(
    WWW::Telegram::BotAPI -> new(token => 'foobaz', async => 1)
  );

  $api -> mock(
    api_request => sub {
      my ($self, $method, $postdata, $cb) = @_;