File Coverage

blib/lib/Bot/ChatBots/Telegram/Sender.pm
Criterion Covered Total %
statement 44 49 89.8
branch 19 28 67.8
condition 10 19 52.6
subroutine 9 10 90.0
pod 2 2 100.0
total 84 108 77.7


line stmt bran cond sub pod time code
1             package Bot::ChatBots::Telegram::Sender;
2 4     4   173823 use strict;
  4         23  
  4         100  
3 4     4   16 use warnings;
  4         8  
  4         85  
4 4     4   794 use Ouch;
  4         7155  
  4         19  
5 4     4   295 use 5.010;
  4         12  
6             { our $VERSION = '0.012'; }
7              
8 4     4   1836 use WWW::Telegram::BotAPI ();
  4         807176  
  4         87  
9              
10 4     4   861 use Moo;
  4         16798  
  4         20  
11 4     4   3753 use namespace::clean;
  4         18004  
  4         27  
12             with 'Bot::ChatBots::Role::Sender';
13              
14             has start_loop => (
15             is => 'rw',
16             default => sub { return 0 },
17             );
18              
19             has telegram => (
20             is => 'rw',
21             lazy => 1,
22             default => sub {
23             my $self = shift;
24             my $tg = WWW::Telegram::BotAPI->new(
25             token => $self->token,
26             async => 1,
27             );
28             return $tg;
29             }
30             );
31              
32             has token => (
33             is => 'ro',
34             required => 1,
35             );
36              
37             # copied from Bot::ChatBot::Role::UserAgent
38             sub may_start_loop {
39 1     1 1 3 my $self = shift;
40 1 50 33     6 my %args = (@_ && ref($_[0])) ? %{$_[0]} : @_;
  0         0  
41             my $start_loop =
42             exists($args{start_loop})
43             ? $args{start_loop}
44 1 50       33 : $self->start_loop;
45 1 50 33     3 Mojo::IOLoop->start if $start_loop && (!Mojo::IOLoop->is_running);
46 1         3 return $self;
47             } ## end sub may_start_loop
48              
49             sub send_message {
50 5     5 1 4615 my ($self, $message) = splice @_, 0, 2;
51 5 50       15 ouch 500, 'no output to send' unless defined $message;
52              
53 5 50 66     25 my %args = (@_ && ref($_[0])) ? %{$_[0]} : @_;
  0         0  
54              
55             # message normalization
56 5 100       21 $message =
57             ref($message)
58             ? {%$message}
59             : {text => $message, telegram_method => 'sendMessage'};
60 5   66     17 my $method = delete($message->{telegram_method}) // do {
61 1         10 state $method_for = {
62             send => 'sendMessage',
63             sendMessage => 'sendMessage',
64             };
65              
66 1   50     7 my $name = delete(local $message->{method}) // 'send';
67 1 50       5 $method_for->{$name}
68             or ouch 500, $self->name . ": unsupported method $name";
69             };
70              
71 5 100 100     24 if (($method eq 'sendMessage') && (!exists $message->{chat_id})) {
72 3 100       11 if (defined $args{record}) { # take from $record
    100          
73 1         3 $message->{chat_id} = $args{record}{channel}{id};
74             }
75             elsif ($self->has_recipient) {
76 1         3 $message->{chat_id} = $self->recipient;
77             }
78             else { # no more ways to figure it out
79 1         5 ouch 500, 'no chat identifier for message';
80             }
81             } ## end if (!exists $message->...)
82              
83 4         7 my @callback;
84 4 100       18 if ($args{callback}) {
    50          
85 1         2 @callback = $args{callback};
86             }
87             elsif ($self->can('callback')) {
88 0   0 0   0 my $has_callback = $self->can('has_callback') // sub { return 1 };
  0         0  
89 0 0       0 @callback = $self->callback if $has_callback->($self);
90             }
91              
92 4         83 my $res = $self->telegram->api_request($method => $message, @callback);
93              
94 4 100       362 $self->may_start_loop(%args) if @callback;
95              
96 4         18 return $res;
97             } ## end sub send_message
98              
99             1;