WWW-Telegram-BotAPI-0.12/0000750000175100017510000000000013605500140015147 5ustar robertofrobertofWWW-Telegram-BotAPI-0.12/INSTALL.SKIP0000644000175100017510000000001013050351442016744 0ustar robertofrobertofgen_doc WWW-Telegram-BotAPI-0.12/META.json0000640000175100017510000000263613605500140016600 0ustar robertofrobertof{ "abstract" : "Perl implementation of the Telegram Bot API", "author" : [ "Roberto Frenna " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "WWW-Telegram-BotAPI", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Encode" : "0", "JSON::MaybeXS" : "0", "LWP::Protocol::https" : "0", "LWP::UserAgent" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Robertof/perl-www-telegram-botapi/issues" }, "license" : [ "http://www.opensource.org/licenses/artistic-license-2.0" ], "repository" : { "url" : "https://github.com/Robertof/perl-www-telegram-botapi" } }, "version" : "0.12", "x_serialization_backend" : "JSON::PP version 2.27300_01" } WWW-Telegram-BotAPI-0.12/gen_doc0000644000175100017510000000400113050351442016473 0ustar robertofrobertof#!/usr/bin/env perl use strict; use subs 'quit'; use warnings; my $file = shift || quit "no file specified"; -f $file || quit "$file does not exist or is not a file"; eval 'use Pod::Markdown; 1' || quit "no Pod::Markdown"; # Parse the documentation my $parser = Local::Pod::Markdown->new (markdown_fragment_format => sub { # remove non-word characters, along with non-hypens and non-spaces s/[^\w\-\s]//gi; # replace spaces with hyphens s/\s/-/g; # return the lowercase version of the string lc; }); open my $outfh, ">", "README.md" || die "can't open README.md for writing: $!"; $parser->output_fh ($outfh); $parser->parse_file ($file); print "README.md generated.", $/; sub quit { print STDERR "skipping $0: ", shift, $/; exit 0 # we didn't fail } # Apply some fixes to Pod::Markdown package Local::Pod::Markdown; use strict; use warnings; BEGIN { # Too lazy to touch @ISA eval 'use parent "Pod::Markdown"'; } # Highlight Verbatim blocks. sub end_Verbatim { my ($self) = @_; my $text = $self->_pop_stack_text; # Find the smallest indentation. (Pod::Markdown::_indent_verbatim) my $indent = ' ' x 4; foreach my $line (split /\n/, $text) { next unless $line =~ /^(\s+)/; $indent = $1 if length ($1) < length ($indent); } # Remove it. $text =~ s/^$indent//mg; $self->_private->{no_escape} = 0; # Add the syntax highlighting block. $self->_save_block (join '', '```perl', $/, $text, $/, '```'); } # Normalize heading names, and fix normalization errors sub _end_head { my ($self, $num) = @_; my $h = '#' x $num; my $text = $self->_pop_stack_text; $self->_private->{search_header} = $text =~ /NAME/ ? 'Title' : $text =~ /AUTHOR/ ? 'Author' : undef; # Normalize the heading name. $text = ucfirst lc $text if lc $text ne $text and $text ne 'AUTOLOAD'; # Fix lowercase names that shouldn't be lowercase. $text =~ s/([$@%][^\s]+)/uc $1/e; $self->_save_block (join ' ', $h, $text); } 1; WWW-Telegram-BotAPI-0.12/META.yml0000640000175100017510000000156613605500140016431 0ustar robertofrobertof--- abstract: 'Perl implementation of the Telegram Bot API' author: - 'Roberto Frenna ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: WWW-Telegram-BotAPI no_index: directory: - t - inc requires: Carp: '0' Encode: '0' JSON::MaybeXS: '0' LWP::Protocol::https: '0' LWP::UserAgent: '0' resources: bugtracker: https://github.com/Robertof/perl-www-telegram-botapi/issues license: http://www.opensource.org/licenses/artistic-license-2.0 repository: https://github.com/Robertof/perl-www-telegram-botapi version: '0.12' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' WWW-Telegram-BotAPI-0.12/Changes0000644000175100017510000000531013605500050016446 0ustar robertofrobertof0.12 2020-01-09 - Fix a crash in debug mode when trying to dump undefined values. - When using `Mojo::UserAgent` and in debug mode, print out the real reason of failure when a connection fails due to a proxy error. Before, only an opaque "Proxy connection error" would have been returned. See issue #29. 0.11 2019-01-07 - Replace deprecated calls to Mojo::Transaction::success with Mojo::Transaction::error. See issue #28. Thanks @huckeduster! 0.10 2018-02-05 - Wrap calls to JSON::MaybeXS::encode_json() with parentheses. This fixes recent test failures. Sorry everybody, and thanks Flavio (@polettix)! 0.09 2017-10-10 - Fix error messages containing "at" being incorrectly parsed by `parse_error`. See issue #19. Thanks Thomas! 0.08 2017-02-13 - Handle plain text error messages returned by old versions of Mojolicious. See issue #16. - Add a note in the documentation about how important is to reuse objects and the undefined behavior that happens with asynchronous requests when that rule is not honoured. See issue #13. 0.07 2016-08-23 - Don't encode to UTF-8 when JSON::MaybeXS takes care of it. 0.06 2016-08-21 - Fix a critical encoding issue involving LWP, file uploads and UTF-8 fields. 0.05 2016-08-21 - Fix compatibility with older Perls. - Improve debugging output. 0.04 2016-08-08 - Major change to how requests are handled. Every request is now sent using `application/json` by default, except when uploading, where `multipart/form-data` is used instead. This has the benefit of allowing the usage of complex objects with zero effort. It *should not* be a breaking change (except if dealing with the internals of this module). - Implement `parse_error`. This new method allows to parse errors and obtain information about them, such as their source or code. Please see the updated documentation. - Asynchronous callbacks are no more mandatory when async mode is enabled. When the callback is missing, requests are simply executed synchronously. 0.03 2015-10-31 - Happy Halloween! - Add new debugging mode, enabled by setting the `TELEGRAM_BOTAPI_DEBUG` environment variable to a true value. - `api_request` now dies when, in the response, `ok` is missing or set to a false value. This means that `undef` can no longer be returned. Consequently, error messages returned from Telegram - when available - are now shown when dying (instead of showing just the HTTP response code). - Several improvements to the documentation and the code. 0.02 2015-09-02 - DESTROY is not handled by AUTOLOAD anymore. - Now using `Carp::confess` instead of `die` for server-side errors. - The documentation now has more examples. 0.01 2015-06-28 - First release. WWW-Telegram-BotAPI-0.12/README.md0000644000175100017510000003261313605500050016440 0ustar robertofrobertof# Name WWW::Telegram::BotAPI - Perl implementation of the Telegram Bot API # Synopsis ```perl use WWW::Telegram::BotAPI; my $api = WWW::Telegram::BotAPI->new ( token => 'my_token' ); # The API methods die when an error occurs. say $api->getMe->{result}{username}; # ... but error handling is available as well. my $result = eval { $api->getMe } or die 'Got error message: ', $api->parse_error->{msg}; # Uploading files is easier than ever. $api->sendPhoto ({ chat_id => 123456, photo => { file => '/home/me/cool_pic.png' }, caption => 'Look at my cool photo!' }); # Complex objects are as easy as writing a Perl object. $api->sendMessage ({ chat_id => 123456, # Object: ReplyKeyboardMarkup reply_markup => { resize_keyboard => \1, # \1 = true when JSONified, \0 = false keyboard => [ # Keyboard: row 1 [ # Keyboard: button 1 'Hello world!', # Keyboard: button 2 { text => 'Give me your phone number!', request_contact => \1 } ] ] } }); # Asynchronous request are supported with Mojo::UserAgent. $api = WWW::Telegram::BotAPI->new ( token => 'my_token', async => 1 # WARNING: may fail if Mojo::UserAgent is not available! ); $api->sendMessage ({ chat_id => 123456, text => 'Hello world!' }, sub { my ($ua, $tx) = @_; die 'Something bad happened!' if $tx->error; say $tx->res->json->{ok} ? 'YAY!' : ':('; # Not production ready! }); Mojo::IOLoop->start; ``` # Description This module provides an easy to use interface for the [Telegram Bot API](https://core.telegram.org/bots/api). It also supports async requests out of the box using [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent), which makes this module easy to integrate with an existing [Mojolicious](https://metacpan.org/pod/Mojolicious) application. # Methods [WWW::Telegram::BotAPI](https://metacpan.org/pod/WWW%3A%3ATelegram%3A%3ABotAPI) implements the following methods. ## new ```perl my $api = WWW::Telegram::BotAPI->new (%options); ``` Creates a new [WWW::Telegram::BotAPI](https://metacpan.org/pod/WWW%3A%3ATelegram%3A%3ABotAPI) instance. **WARNING:** you should only create one instance of this module and reuse it when needed. Calling `new` each time you run an async request causes unexpected behavior with [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) and won't work correctly. See also [issue #13 on GitHub](https://github.com/Robertof/perl-www-telegram-botapi/issues/13). `%options` may contain the following: - `token => 'my_token'` The token that will be used to authenticate the bot. **This is required! The method will croak if this option is not specified.** - `api_url => 'https://api.example.com/token/%s/method/%s'` A format string that will be used to create the final API URL. The first parameter specifies the token, the second one specifies the method. Defaults to `https://api.telegram.org/bot%s/%s`. - `async => 1` Enables asynchronous requests. **This requires [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent), and the method will croak if it isn't found.** Defaults to `0`. - `force_lwp => 1` Forces the usage of [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) instead of [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent), even if the latter is available. By default, the module tries to load [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent), and on failure it uses [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent). ## AUTOLOAD ```perl $api->getMe; $api->sendMessage ({ chat_id => 123456, text => 'Hello world!' }); # with async => 1 and the IOLoop already started $api->setWebhook ({ url => 'https://example.com/webhook' }, sub { my ($ua, $tx) = @_; die if $tx->error; say 'Webhook set!' }); ``` This module makes use of ["Autoloading" in perlsub](https://metacpan.org/pod/perlsub#Autoloading). This means that **every current and future method of the Telegram Bot API can be used by calling its Perl equivalent**, without requiring an update of the module. If you'd like to avoid using `AUTOLOAD`, then you may simply call the ["api\_request"](#api_request) method specifying the method name as the first argument. ```perl $api->api_request ('getMe'); ``` This is, by the way, the exact thing the `AUTOLOAD` method of this module does. ## api\_request ```perl # Remember: each of these samples can be aliased with # $api->methodName ($params). $api->api_request ('getMe'); $api->api_request ('sendMessage', { chat_id => 123456, text => 'Oh, hai' }); # file upload $api->api_request ('sendDocument', { chat_id => 123456, document => { filename => 'dump.txt', content => 'secret stuff' } }); # complex objects are supported natively since v0.04 $api->api_request ('sendMessage', { chat_id => 123456, reply_markup => { keyboard => [ [ 'Button 1', 'Button 2' ] ] } }); # with async => 1 and the IOLoop already started $api->api_request ('getMe', sub { my ($ua, $tx) = @_; die if $tx->error; # ... }); ``` This method performs an API request. The first argument must be the method name ([here's a list](https://core.telegram.org/bots/api#available-methods)). Once the request is completed, the response is decoded using [JSON::MaybeXS](https://metacpan.org/pod/JSON%3A%3AMaybeXS) and then returned. If [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) is used as the user-agent, then the response is decoded automatically using [Mojo::JSON](https://metacpan.org/pod/Mojo%3A%3AJSON). If the request is not successful or the server tells us something isn't `ok`, then this method dies with the first available error message (either the error description or the status line). You can make this method non-fatal using `eval`: ```perl my $response = eval { $api->api_request ($method, $args) } or warn "Request failed with error '$@', but I'm still alive!"; ``` Further processing of error messages can be obtained using ["parse\_error"](#parse_error). Request parameters can be specified using an hash reference. Additionally, complex objects can be specified like you do in JSON. See the previous examples or the example bot provided in ["SEE ALSO"](#see-also). File uploads can be specified using an hash reference containing the following mappings: - `file => '/path/to/file.ext'` Path to the file you want to upload. Required only if `content` is not specified. - `filename => 'file_name.ext'` An optional filename that will be used instead of the real name of the file. Particularly recommended when `content` is specified. - `content => 'Being a file is cool :-)'` The content of the file to send. When using this, `file` must not be specified. - `AnyCustom => 'Header'` Custom headers can be specified as hash mappings. Upload of multiple files is not supported. See ["tx" in Mojo::UserAgent::Transactor](https://metacpan.org/pod/Mojo%3A%3AUserAgent%3A%3ATransactor#tx) for more information about file uploads. To resend files, you don't need to perform a file upload at all. Just pass the ID as a normal parameter. ```perl $api->sendPhoto ({ chat_id => 123456, photo => $photo_id }); ``` When asynchronous requests are enabled, a callback can be specified as an argument. The arguments passed to the callback are, in order, the user-agent (a [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) object) and the response (a [Mojo::Transaction::HTTP](https://metacpan.org/pod/Mojo%3A%3ATransaction%3A%3AHTTP) object). More information can be found in the documentation of [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) and [Mojo::Transaction::HTTP](https://metacpan.org/pod/Mojo%3A%3ATransaction%3A%3AHTTP). **NOTE:** ensure that the event loop [Mojo::IOLoop](https://metacpan.org/pod/Mojo%3A%3AIOLoop) is started when using asynchronous requests. This is not needed when using this module inside a [Mojolicious](https://metacpan.org/pod/Mojolicious) app. The order of the arguments, except of the first one, does not matter: ```perl $api->api_request ('sendMessage', $parameters, $callback); $api->api_request ('sendMessage', $callback, $parameters); # same thing! ``` ## parse\_error ```perl unless (eval { $api->doSomething(...) }) { my $error = $api->parse_error; die "Unknown error: $error->{msg}" if $error->{type} eq 'unknown'; # Handle error gracefully using "type", "msg" and "code" (optional) } # Or, use it with a custom error message. my $error = $api->parse_error ($message); ``` When sandboxing calls to [WWW::Telegram::BotAPI](https://metacpan.org/pod/WWW%3A%3ATelegram%3A%3ABotAPI) methods using `eval`, it is useful to parse error messages using this method. **WARNING:** up until version 0.09, this method incorrectly stopped at the first occurence of `at` in error messages, producing results such as `missing ch` instead of `missing chat`. This method accepts an error message as its first argument, otherwise `$@` is used. An hash reference containing the following elements is returned: - `type => unknown|agent|api` The source of the error. `api` specifies an error originating from Telegram's BotAPI. When `type` is `api`, the key `code` is guaranteed to exist. `agent` specifies an error originating from this module's user-agent. This may indicate a network issue, a non-200 HTTP response code or any error not related to the API. `unknown` specifies an error with no known source. - `msg => ...` The error message. - `code => ...` The error code. **This key only exists when `type` is `api`**. ## agent ```perl my $user_agent = $api->agent; ``` Returns the instance of the user-agent used by the module. You can determine if the module is using [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) or [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) by using `isa`: ```perl my $is_lwp = $user_agent->isa ('LWP::UserAgent'); ``` ### Using a proxy Since all the painful networking stuff is delegated to one of the two supported user agents (either [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) or [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent)), you can use their built-in support for proxies by accessing the user agent object. An example of how this may look like is the following: ```perl my $user_agent = $api->agent; if ($user_agent->isa ('LWP::UserAgent')) { # Use LWP::Protocol::connect (for https) $user_agent->proxy ('https', '...'); # Or if you prefer, load proxy settings from the environment. # $user_agent->env_proxy; } else { # Mojo::UserAgent (builtin) $user_agent->proxy->https ('...'); # Or if you prefer, load proxy settings from the environment. # $user_agent->detect; } ``` **NOTE:** Unfortunately, [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent) returns an opaque `Proxy connection failed` when something goes wrong with the `CONNECT` request made to the proxy. To alleviate this, since version 0.12, this module prints the real reason of failure in debug mode. See ["DEBUGGING"](#debugging). If you need to access the real error reason in your code, please see [issue #29 on GitHub](https://github.com/Robertof/perl-www-telegram-botapi/issues/29). # Debugging To perform some cool troubleshooting, you can set the environment variable `TELEGRAM_BOTAPI_DEBUG` to a true value: ```perl TELEGRAM_BOTAPI_DEBUG=1 perl script.pl ``` This dumps the content of each request and response in a friendly, human-readable way. It also prints the version and the configuration of the module. As a security measure, the bot's token is automatically removed from the output of the dump. Since version 0.12, enabling this flag also gives more details when a proxy connection fails. **WARNING:** using this option along with an old Mojolicious version (< 6.22) leads to a warning, and forces [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) instead of [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent). This is because [Mojo::JSON](https://metacpan.org/pod/Mojo%3A%3AJSON) used incompatible boolean values up to version 6.21, which led to an horrible death of [JSON::MaybeXS](https://metacpan.org/pod/JSON%3A%3AMaybeXS) when serializing the data. # Caveats When asynchronous mode is enabled, no error handling is performed. You have to do it by yourself as shown in the ["SYNOPSIS"](#synopsis). # See also [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent), [Mojo::UserAgent](https://metacpan.org/pod/Mojo%3A%3AUserAgent), [https://core.telegram.org/bots/api](https://core.telegram.org/bots/api), [https://core.telegram.org/bots](https://core.telegram.org/bots), [example implementation of a Telegram bot](https://git.io/vlOK0), [example implementation of an async Telegram bot](https://git.io/vDrwL) # Author Roberto Frenna (robertof AT cpan DOT org) # Bugs Please report any bugs or feature requests to [https://github.com/Robertof/perl-www-telegram-botapi](https://github.com/Robertof/perl-www-telegram-botapi). # Thanks Thanks to [the authors of Mojolicious](https://metacpan.org/pod/Mojolicious) for inspiration about the license and the documentation. # License Copyright (C) 2015, Roberto Frenna. This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. WWW-Telegram-BotAPI-0.12/MANIFEST.SKIP0000644000175100017510000000223613050351442017060 0ustar robertofrobertof #!start included /home/Roberto/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this \b_eumm/ # 7.05_05 and above # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # and Module::Build::Tiny generated files \b_build_params$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ \..*\.sw.?$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid prove files \B\.prove$ # Avoid MYMETA files ^MYMETA\. #!end included /home/Roberto/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/ExtUtils/MANIFEST.SKIP \.travis\.yml$ WWW-Telegram-BotAPI-0.12/lib/0000750000175100017510000000000013605500137015723 5ustar robertofrobertofWWW-Telegram-BotAPI-0.12/lib/WWW/0000750000175100017510000000000013605500137016407 5ustar robertofrobertofWWW-Telegram-BotAPI-0.12/lib/WWW/Telegram/0000750000175100017510000000000013605500137020147 5ustar robertofrobertofWWW-Telegram-BotAPI-0.12/lib/WWW/Telegram/BotAPI.pm0000644000175100017510000006105413605500050021570 0ustar robertofrobertofpackage WWW::Telegram::BotAPI; use strict; use warnings; use warnings::register; use Carp (); use Encode (); use JSON::MaybeXS (); use constant DEBUG => $ENV{TELEGRAM_BOTAPI_DEBUG} || 0; our $VERSION = "0.12"; my $json; # for debugging purposes, only defined when DEBUG = 1 BEGIN { eval "require Mojo::UserAgent; 1" or eval "require LWP::UserAgent; 1" or die "Either Mojo::UserAgent or LWP::UserAgent is required.\n$@"; $json = JSON::MaybeXS->new (pretty => 1, utf8 => 1) if DEBUG; } # Debugging functions (only used when DEBUG is true) sub _dprintf { printf "-T- $_[0]\n", splice @_, 1 } sub _ddump { my ($varname, $to_dump) = splice @_, -2; _dprintf @_ if @_; printf "%s = %s", $varname, defined $to_dump ? $json->encode ($to_dump) : "undefined\n"; } # %settings = ( # async => Bool, # token => String, # api_url => "http://something/%s/%s", # 1st %s = tok, 2nd %s = method # force_lwp => Bool # ) sub new { my ($class, %settings) = @_; exists $settings{token} or Carp::croak "ERROR: missing 'token' from \%settings."; # When DEBUG is enabled, and Mojo::UserAgent is used, Mojolicious must be at # least version 6.22 (https://github.com/kraih/mojo/blob/v6.22/Changes). This is because # Mojo::JSON used incompatible JSON boolean constants which led JSON::MaybeXS to crash # with a mysterious error message. To prevent this, we force LWP in this case. if (DEBUG && Mojo::JSON->can ("true") && ref Mojo::JSON->true ne "JSON::PP::Boolean") { warnings::warnif ( "WARNING: Enabling DEBUG with Mojolicious versions < 6.22 won't work. Forcing " . "LWP::UserAgent. (update Mojolicious or disable DEBUG to fix)" ); ++$settings{force_lwp}; } # Ensure that LWP is loaded if "force_lwp" is specified. $settings{force_lwp} and require LWP::UserAgent; # Instantiate the correct user-agent. This automatically detects whether Mojo::UserAgent is # available or not. if ($settings{force_lwp} or !Mojo::UserAgent->can ("new")) { $settings{_agent} = LWP::UserAgent->new; } else { $settings{_agent} = Mojo::UserAgent->new; # Setup an handler to print detailed information in case of proxy connection failure. DEBUG and $settings{_agent}->on (start => sub { my (undef, $tx) = @_; # Skip all requests which are not proxy-related. return unless $tx->req->method eq "CONNECT"; # Add an handler on completion. $tx->on (finish => sub { my $tx = shift; _dprintf "ERROR: Got error from proxy server: %s", _mojo_error_to_string ($tx) if $tx->error; }); }) } ($settings{async} ||= 0) and $settings{_agent}->isa ("LWP::UserAgent") and Carp::croak "ERROR: Mojo::UserAgent is required to use 'async'."; $settings{api_url} ||= "https://api.telegram.org/bot%s/%s"; DEBUG && _dprintf "WWW::Telegram::BotAPI initialized (v%s), using agent %s %ssynchronously.", $VERSION, ref $settings{_agent}, $settings{async} ? "a" : ""; bless \%settings, $class } # Don't let old Perl versions call AUTOLOAD when DESTROYing our class. sub DESTROY {} # Magically provide methods named as the Telegram API ones, such as $o->sendMessage. sub AUTOLOAD { my $self = shift; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/.*:://; # removes the package name at the beginning $self->api_request ($method, @_); } # The real stuff! sub api_request { my ($self, $method) = splice @_, 0, 2; # Detect if the user provided a callback to use for async requests. # The only parameter whose order matters is $method. The callback and the request parameters # can be put in any order, like this: $o->api_request ($method, sub {}, { a => 1 }) or # $o->api_request ($method, { a => 1 }, sub {}), or even # $o->api_request ($method, "LOL", "DONGS", sub {}, { a => 1 }). my ($postdata, $async_cb); for my $arg (@_) { # Poor man's switch block for (ref $arg) { # Ensure that we don't get async callbacks when we aren't in async mode. ($async_cb = $arg, last) if $_ eq "CODE" and $self->{async}; ($postdata = $arg, last) if $_ eq "HASH"; } last if defined $async_cb and defined $postdata; } # Prepare the request method parameters. my @request; my $is_lwp = $self->_is_lwp; # Push the request URI (this is the same in LWP and Mojo) push @request, sprintf ($self->{api_url}, $self->{token}, $method); if (defined $postdata) { # POST arguments which are array/hash references need to be handled as follows: # - if no file upload exists, use application/json and encode everything with JSON::MaybeXS # or let Mojo::UserAgent handle everything, when available. # - whenever a file upload exists, the MIME type is switched to multipart/form-data. # Other refs which are not file uploads are then encoded with JSON::MaybeXS. my @fixable_keys; # This array holds keys found before file uploads which have to be fixed. my @utf8_keys; # This array holds keys found before file uploads which have to be encoded. my $has_file_upload; # Traverse the post arguments. for my $k (keys %$postdata) { # Ensure we pass octets to LWP with multipart/form-data and that we deal only with # references. ($is_lwp ? $has_file_upload ? $postdata->{$k} = Encode::encode ("utf-8", $postdata->{$k}) : push @utf8_keys, $k : ()), next unless my $ref = ref $postdata->{$k}; # Process file uploads. if ($ref eq "HASH" and (exists $postdata->{$k}{file} or exists $postdata->{$k}{content})) { # WARNING: using file uploads implies switching to the MIME type # multipart/form-data, which needs a JSON stringification for every complex object. ++$has_file_upload; # No particular treatment is needed for file uploads when using Mojo. next unless $is_lwp; # The structure of the hash must be: # { content => 'file content' } or { file => 'path to file' } # With an optional key "filename" and optional headers to be merged into the # multipart/form-data stuff. # See https://metacpan.org/pod/Mojo::UserAgent::Transactor#tx # HTTP::Request::Common uses this syntax instead: # [ $file, $filename, SomeHeader => 'bla bla', Content => 'fileContent' ] # See p3rl.org/HTTP::Request::Common#POST-url-Header-Value-...-Content-content my $new_val = []; # Push and remove the keys 'file' and 'filename' (if defined) to $new_val. push @$new_val, delete $postdata->{$k}{file}, delete $postdata->{$k}{filename}; # Push 'Content' (note the uppercase 'C') exists $postdata->{$k}{content} and push @$new_val, Content => delete $postdata->{$k}{content}; # Push the other headers. push @$new_val, %{$postdata->{$k}}; # Finalize the changes. $postdata->{$k} = $new_val; } else { $postdata->{$k} = JSON::MaybeXS::encode_json ($postdata->{$k}), next if $has_file_upload; push @fixable_keys, $k; } } if ($has_file_upload) { # Fix keys found before the file upload. $postdata->{$_} = JSON::MaybeXS::encode_json ($postdata->{$_}) for @fixable_keys; $postdata->{$_} = Encode::encode ("utf-8", $postdata->{$_}) for @utf8_keys; $is_lwp and push @request, Content => $postdata, Content_Type => "form-data" or push @request, form => $postdata; } else { $is_lwp and push @request, DEBUG ? (DBG => $postdata) : (), # handled in _fix_request_args Content => JSON::MaybeXS::encode_json ($postdata), Content_Type => "application/json" or push @request, json => $postdata; } } # Protip (also mentioned in the doc): if you are using non-blocking requests with # Mojo::UserAgent, remember to start the event loop with Mojo::IOLoop->start. # This is superfluous when using this module in a Mojolicious app. push @request, $async_cb if $async_cb; # Stop here if this is a test - specified using the (internal) "_dry_run" flag. return 1 if $self->{_dry_run}; DEBUG and _ddump "BEGIN REQUEST to /%s :: %s", $method, scalar localtime, PAYLOAD => _fix_request_args ($self, \@request); # Perform the request. my $tx = $self->agent->post (@request); DEBUG and $async_cb and _dprintf "END REQUEST to /%s (async) :: %s", $method, scalar localtime; # We're done if the request is asynchronous. return $tx if $async_cb; # Pre-decode the response to provide, if possible, an error message. my $response = $is_lwp ? eval { JSON::MaybeXS::decode_json ($tx->decoded_content) } || undef : $tx->res->json; # Dump it in debug mode. DEBUG and _ddump RESPONSE => $response; # If we (or the server) f****d up... die horribly. unless (($is_lwp ? $tx->is_success : !$tx->error) && $response && $response->{ok}) { $response ||= {}; my $error = $response->{description} || ( $is_lwp ? $tx->status_line : _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!"; } DEBUG and _dprintf "END REQUEST to /%s :: %s", $method, scalar localtime; $response } sub parse_error { my $r = { type => "unknown", msg => $_[1] || $@ }; # The following regexp matches the error code to the first group and the error message to the # second. # Issue #19: match only `at ...` messages separated by at least one space. See t/02-exceptions return $r unless $r->{msg} =~ /ERROR: (?:code ([0-9]+): )?(.+?)(?:\s+at .+)?$/m; # Find and save the error code and message. $r->{code} = $1 if $1; $r->{msg} = $2; # If the error message has a code, then it comes from the BotAPI. Otherwise, it's our agent # telling us something went wrong. $r->{type} = exists $r->{code} ? "api" : "agent" if $r->{msg} ne "something went wrong!"; $r } sub agent { shift->{_agent} } # Hides the bot's token from the request arguments and improves debugging output. sub _fix_request_args { my ($self, $args) = @_; my $args_cpy = [ @$args ]; $args_cpy->[0] =~ s/\Q$self->{token}\E/XXXXXXXXX/g; # Note for the careful reader: you may remember that the position of Perl's hash keys is # undeterminate - that is, an hash has no particular order. This is true, however we are # dealing with an array which has a fixed order, so no particular problem arises here. # Addendum: the original reference of $args is used here to get rid of `DBG => $postdata`. if (@$args > 1 and $args->[1] eq "DBG") { my (undef, $data) = splice @$args, 1, 2; # Be sure to get rid of the `DBG` key in our copy too. splice @$args_cpy, 1, 2; # In the debug output, substitute the JSON-encoded data (which is not human readable) with # the raw POST arguments. $args_cpy->[2] = $data; } # Ensure that we do NOT try display async subroutines! pop @$args_cpy if ref $args_cpy->[-1] eq "CODE"; $args_cpy } sub _is_lwp { shift->agent->isa ("LWP::UserAgent") } # Extracts an error message returned from Mojo::UserAgent in a way that's compatible for all # Mojolicious versions: in some conditions, `$tx->error` returned a string instead of the # expected hash reference. See issue #16. sub _mojo_error_to_string { my $tx = shift; ((ref ($tx->error || {}) ? $tx->error : { message => $tx->error }) || {})->{message} } 1; =encoding utf8 =head1 NAME WWW::Telegram::BotAPI - Perl implementation of the Telegram Bot API =head1 SYNOPSIS use WWW::Telegram::BotAPI; my $api = WWW::Telegram::BotAPI->new ( token => 'my_token' ); # The API methods die when an error occurs. say $api->getMe->{result}{username}; # ... but error handling is available as well. my $result = eval { $api->getMe } or die 'Got error message: ', $api->parse_error->{msg}; # Uploading files is easier than ever. $api->sendPhoto ({ chat_id => 123456, photo => { file => '/home/me/cool_pic.png' }, caption => 'Look at my cool photo!' }); # Complex objects are as easy as writing a Perl object. $api->sendMessage ({ chat_id => 123456, # Object: ReplyKeyboardMarkup reply_markup => { resize_keyboard => \1, # \1 = true when JSONified, \0 = false keyboard => [ # Keyboard: row 1 [ # Keyboard: button 1 'Hello world!', # Keyboard: button 2 { text => 'Give me your phone number!', request_contact => \1 } ] ] } }); # Asynchronous request are supported with Mojo::UserAgent. $api = WWW::Telegram::BotAPI->new ( token => 'my_token', async => 1 # WARNING: may fail if Mojo::UserAgent is not available! ); $api->sendMessage ({ chat_id => 123456, text => 'Hello world!' }, sub { my ($ua, $tx) = @_; die 'Something bad happened!' if $tx->error; say $tx->res->json->{ok} ? 'YAY!' : ':('; # Not production ready! }); Mojo::IOLoop->start; =head1 DESCRIPTION This module provides an easy to use interface for the L. It also supports async requests out of the box using L, which makes this module easy to integrate with an existing L application. =head1 METHODS L implements the following methods. =head2 new my $api = WWW::Telegram::BotAPI->new (%options); Creates a new L instance. B you should only create one instance of this module and reuse it when needed. Calling C each time you run an async request causes unexpected behavior with L and won't work correctly. See also L. C<%options> may contain the following: =over 4 =item * C<< token => 'my_token' >> The token that will be used to authenticate the bot. B =item * C<< api_url => 'https://api.example.com/token/%s/method/%s' >> A format string that will be used to create the final API URL. The first parameter specifies the token, the second one specifies the method. Defaults to C. =item * C<< async => 1 >> Enables asynchronous requests. B, and the method will croak if it isn't found.> Defaults to C<0>. =item * C<< force_lwp => 1 >> Forces the usage of L instead of L, even if the latter is available. By default, the module tries to load L, and on failure it uses L. =back =head2 AUTOLOAD $api->getMe; $api->sendMessage ({ chat_id => 123456, text => 'Hello world!' }); # with async => 1 and the IOLoop already started $api->setWebhook ({ url => 'https://example.com/webhook' }, sub { my ($ua, $tx) = @_; die if $tx->error; say 'Webhook set!' }); This module makes use of L. This means that B, without requiring an update of the module. If you'd like to avoid using C, then you may simply call the L method specifying the method name as the first argument. $api->api_request ('getMe'); This is, by the way, the exact thing the C method of this module does. =head2 api_request # Remember: each of these samples can be aliased with # $api->methodName ($params). $api->api_request ('getMe'); $api->api_request ('sendMessage', { chat_id => 123456, text => 'Oh, hai' }); # file upload $api->api_request ('sendDocument', { chat_id => 123456, document => { filename => 'dump.txt', content => 'secret stuff' } }); # complex objects are supported natively since v0.04 $api->api_request ('sendMessage', { chat_id => 123456, reply_markup => { keyboard => [ [ 'Button 1', 'Button 2' ] ] } }); # with async => 1 and the IOLoop already started $api->api_request ('getMe', sub { my ($ua, $tx) = @_; die if $tx->error; # ... }); This method performs an API request. The first argument must be the method name (L). Once the request is completed, the response is decoded using L and then returned. If L is used as the user-agent, then the response is decoded automatically using L. If the request is not successful or the server tells us something isn't C, then this method dies with the first available error message (either the error description or the status line). You can make this method non-fatal using C: my $response = eval { $api->api_request ($method, $args) } or warn "Request failed with error '$@', but I'm still alive!"; Further processing of error messages can be obtained using L. Request parameters can be specified using an hash reference. Additionally, complex objects can be specified like you do in JSON. See the previous examples or the example bot provided in L. File uploads can be specified using an hash reference containing the following mappings: =over 4 =item * C<< file => '/path/to/file.ext' >> Path to the file you want to upload. Required only if C is not specified. =item * C<< filename => 'file_name.ext' >> An optional filename that will be used instead of the real name of the file. Particularly recommended when C is specified. =item * C<< content => 'Being a file is cool :-)' >> The content of the file to send. When using this, C must not be specified. =item * C<< AnyCustom => 'Header' >> Custom headers can be specified as hash mappings. =back Upload of multiple files is not supported. See L for more information about file uploads. To resend files, you don't need to perform a file upload at all. Just pass the ID as a normal parameter. $api->sendPhoto ({ chat_id => 123456, photo => $photo_id }); When asynchronous requests are enabled, a callback can be specified as an argument. The arguments passed to the callback are, in order, the user-agent (a L object) and the response (a L object). More information can be found in the documentation of L and L. B ensure that the event loop L is started when using asynchronous requests. This is not needed when using this module inside a L app. The order of the arguments, except of the first one, does not matter: $api->api_request ('sendMessage', $parameters, $callback); $api->api_request ('sendMessage', $callback, $parameters); # same thing! =head2 parse_error unless (eval { $api->doSomething(...) }) { my $error = $api->parse_error; die "Unknown error: $error->{msg}" if $error->{type} eq 'unknown'; # Handle error gracefully using "type", "msg" and "code" (optional) } # Or, use it with a custom error message. my $error = $api->parse_error ($message); When sandboxing calls to L methods using C, it is useful to parse error messages using this method. B up until version 0.09, this method incorrectly stopped at the first occurence of C in error messages, producing results such as C instead of C. This method accepts an error message as its first argument, otherwise C<$@> is used. An hash reference containing the following elements is returned: =over 4 =item * C<< type => unknown|agent|api >> The source of the error. C specifies an error originating from Telegram's BotAPI. When C is C, the key C is guaranteed to exist. C specifies an error originating from this module's user-agent. This may indicate a network issue, a non-200 HTTP response code or any error not related to the API. C specifies an error with no known source. =item * C<< msg => ... >> The error message. =item * C<< code => ... >> The error code. B is C>. =back =head2 agent my $user_agent = $api->agent; Returns the instance of the user-agent used by the module. You can determine if the module is using L or L by using C: my $is_lwp = $user_agent->isa ('LWP::UserAgent'); =head3 USING A PROXY Since all the painful networking stuff is delegated to one of the two supported user agents (either L or L), you can use their built-in support for proxies by accessing the user agent object. An example of how this may look like is the following: my $user_agent = $api->agent; if ($user_agent->isa ('LWP::UserAgent')) { # Use LWP::Protocol::connect (for https) $user_agent->proxy ('https', '...'); # Or if you prefer, load proxy settings from the environment. # $user_agent->env_proxy; } else { # Mojo::UserAgent (builtin) $user_agent->proxy->https ('...'); # Or if you prefer, load proxy settings from the environment. # $user_agent->detect; } B Unfortunately, L returns an opaque C when something goes wrong with the C request made to the proxy. To alleviate this, since version 0.12, this module prints the real reason of failure in debug mode. See L. If you need to access the real error reason in your code, please see L. =head1 DEBUGGING To perform some cool troubleshooting, you can set the environment variable C to a true value: TELEGRAM_BOTAPI_DEBUG=1 perl script.pl This dumps the content of each request and response in a friendly, human-readable way. It also prints the version and the configuration of the module. As a security measure, the bot's token is automatically removed from the output of the dump. Since version 0.12, enabling this flag also gives more details when a proxy connection fails. B using this option along with an old Mojolicious version (< 6.22) leads to a warning, and forces L instead of L. This is because L used incompatible boolean values up to version 6.21, which led to an horrible death of L when serializing the data. =head1 CAVEATS When asynchronous mode is enabled, no error handling is performed. You have to do it by yourself as shown in the L. =head1 SEE ALSO L, L, L, L, L, L =head1 AUTHOR Roberto Frenna (robertof AT cpan DOT org) =head1 BUGS Please report any bugs or feature requests to L. =head1 THANKS Thanks to L for inspiration about the license and the documentation. =head1 LICENSE Copyright (C) 2015, Roberto Frenna. This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut WWW-Telegram-BotAPI-0.12/LICENSE0000644000175100017510000002141313050351442016165 0ustar robertofrobertof The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. WWW-Telegram-BotAPI-0.12/t/0000750000175100017510000000000013605500137015420 5ustar robertofrobertofWWW-Telegram-BotAPI-0.12/t/02-exceptions.t0000644000175100017510000000520613414516057020223 0ustar robertofrobertof#!/usr/bin/env perl use strict; use warnings; use WWW::Telegram::BotAPI; use Test::More; BEGIN { eval 'use Test::Fatal; 1' || plan skip_all => 'Test::Fatal required for this test!'; eval 'use Test::MockObject'; } plan tests => 12; like ( exception { WWW::Telegram::BotAPI->new }, qr/missing 'token'/, 'a token is required to create a new instance of WWW::Telegram::BotAPI' ); like ( exception { WWW::Telegram::BotAPI->new (force_lwp => 1, async => 1, token => 'whatever') }, qr/Mojo::UserAgent is required/, 'Mojo::UserAgent is required to use "async"' ); SKIP: { skip 'Test::MockObject required to test Mojo::UserAgent features', 8 unless Test::MockObject->can ('new'); my $inst = WWW::Telegram::BotAPI->new (token => 'whatever'); # 1. Test agent-provided errors my $mojo_mock = Test::MockObject->new->set_always ('post', Test::MockObject->new->set_always ('error', { message => ':<' }) ->set_always ('res', Test::MockObject->new->set_false ('json'))); $mojo_mock->set_isa ('Mojo::UserAgent'); $inst->{_agent} = $mojo_mock; # Do not try this at home! like my $msg = exception { $inst->something }, qr/ERROR: : 'agent', msg => ':<'); # 2. Test API-provided errors $mojo_mock->set_always ('post', Test::MockObject->new->set_false ('error') ->set_always ('res', Test::MockObject->new->set_always ('json', { ok => 0, description => 'Meow!', error_code => 1337 }))); like $msg = exception { $inst->something }, qr/ERROR: code/, 'api errors are handled'; test_error ($msg, type => 'api', msg => 'Meow!', code => 1337); # 3. Test plain-string error handling $mojo_mock->set_always ('post', Test::MockObject->new->set_always ('error', ':<') ->set_always ('res', Test::MockObject->new->set_false ('json'))); like $msg = exception { $inst->something }, qr/ERROR: : 'agent', msg => ':<'); } # Test error messages containing 'at' (issue #19). test_error ('ERROR: chat not found', type => 'agent', msg => 'chat not found'); sub test_error { my ($message, %configuration) = @_; my $error = WWW::Telegram::BotAPI->parse_error ($message); ok !exists $error->{code}, 'error code must not exist' if !exists $configuration{code}; is_deeply $error, \%configuration, 'parse_error returns expected values'; } WWW-Telegram-BotAPI-0.12/t/00-basic.t0000644000175100017510000000342213050351442017106 0ustar robertofrobertof#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 14 + 2 * 2; require_ok 'WWW::Telegram::BotAPI' || BAIL_OUT "Can't load WWW::Telegram::BotAPI"; can_ok 'WWW::Telegram::BotAPI', 'new', 'api_request', 'agent'; my $inst = WWW::Telegram::BotAPI->new (token => 'something'); isa_ok $inst, 'WWW::Telegram::BotAPI'; like ref $inst->agent, qr/^(LWP|Mojo)::UserAgent$/, 'agent is either LWP or Mojo'; $inst = WWW::Telegram::BotAPI->new (token => 'something', force_lwp => 1); isa_ok $inst->agent, 'LWP::UserAgent'; # Test parse_error with pre-defined error messages my $error = $inst->parse_error ("ERROR: your pizza is not reachable!\n"); is $error->{type}, 'agent', 'error type is "agent" when no code is specified'; is $error->{msg}, 'your pizza is not reachable!', 'error message is correctly parsed'; ok !exists $error->{code}, 'error code does not exist in agent errors'; $error = $inst->parse_error ('ERROR: code 403: access to pizzas is forbidden!'); is $error->{type}, 'api', 'error type is "api" when there is a numeric code'; is $error->{msg}, 'access to pizzas is forbidden!', 'error message is correctly parsed'; is $error->{code}, 403, 'access to our pizza is really forbidden (code is correctly parsed)'; $error = $inst->parse_error ("What is a pizza?\n"); is $error->{type}, 'unknown', 'error type is "unknown" when we don\'t know what it is'; is $error->{msg}, "What is a pizza?\n", 'error message is not modified when type == "unknown"'; ok !exists $error->{code}, 'error code does not exist in unknown errors'; # Test AUTOLOAD for (0 .. 1) { $inst = WWW::Telegram::BotAPI->new (token => 'something', force_lwp => $_, _dry_run => 1); is $inst->blaBlaBla(), 1, 'AUTOLOAD works'; is $inst->something ({ a => 1 }), 1, 'AUTOLOAD works (with POST arguments)'; } WWW-Telegram-BotAPI-0.12/t/01-api-requests.t0000644000175100017510000002430613414516057020465 0ustar robertofrobertof#!/usr/bin/env perl use strict; use warnings; use JSON::MaybeXS (); use Test::More; use WWW::Telegram::BotAPI; BEGIN { eval 'use Test::MockObject; 1' || plan skip_all => 'Test::MockObject required for this test!'; } my @base_constructor_args = ( api_url => '%s/%s', token => 'whatever' ); my @tests = ( { agent => \&lwp_mock, resp => { result => 'wow' }, method => 'getWow' }, { agent => \&lwp_mock, resp => { result => { wow_level => 9001 } }, method => 'getWowLevel', request_args => [ { wow_string => 'wow' } ] }, { agent => \&lwp_mock, resp => { result => { wow_uploaded => JSON::MaybeXS::JSON->true } }, method => 'sendWow', # test the translation from Mojo::UserAgent-esque args to args compatible with # HTTP::Request::Common request_args => [{ wow_name => 'WOW!!', wow_file => { file => '/etc/wow.conf' } }], expected_request_args => [ 'whatever/sendWow', Content => { wow_name => 'WOW!!', wow_file => [ '/etc/wow.conf', undef ] }, Content_Type => 'form-data' ] }, { agent => \&lwp_mock, resp => { lazy_response => '¯\_(ツ)_/¯' }, method => 'sendLaziness', # test sending files with a content instead of a filename request_args => [{ lazy_file => { filename => 'lazy', content => '' } }], expected_request_args => [ 'whatever/sendLaziness', Content => { lazy_file => [ undef, 'lazy', Content => '' ] }, Content_Type => 'form-data' ] }, { agent => \&lwp_mock, resp => { out_of => 'ideas' }, method => 'sendIdeas', # test sending custom headers request_args => [{ idea_file => { file => '/var/big_database.ideas', filename => 'ideas.db', VeryCool => 'Header' } }], expected_request_args => [ 'whatever/sendIdeas', Content => { idea_file => [ '/var/big_database.ideas', 'ideas.db', VeryCool => 'Header' ] }, Content_Type => 'form-data' ] }, # Complex objects { agent => \&lwp_mock, resp => { error => 'Nobody knows it!' }, method => 'getCrocodileSound', request_args => [{ color => 'green', hints => { pitch => 19.4, volume => 38.3 } }] }, { agent => \&lwp_mock, resp => { thank_you => 'Much appreciated, you just solved a childhood mistery!' }, method => 'uploadCrocodileSound', request_args => [{ color => 'green', meta => { pitch => 19.1, volume => 9001 }, sound => { file => '/root/crocodile_s3cret.mp3' # Don't upload files as root! } }], expected_request_args => [ 'whatever/uploadCrocodileSound', Content => { color => 'green', meta => { pitch => 19.1, volume => 9001 }, sound => [ '/root/crocodile_s3cret.mp3', undef ] }, Content_Type => 'form-data' ], json_decode => 'meta' }, # Mojo::UserAgent tests { agent => \&mojo_mock, resp => { password => 'hunter2' }, method => 'getPassword' }, { agent => \&mojo_mock, resp => { hello => 'mojo' }, method => 'getGreet', request_args => [ { my_nick => 'mojo' } ] }, { agent => \&mojo_mock, resp => { msg => 'Your file smells bad' }, method => 'sendFile', request_args => [{ file => { file => '/home/me/poop.jpg', filename => 'flowers.jpg' } }], upload => 1 # No translation is needed when using the Mojo agent. }, # Complex objects { agent => \&mojo_mock, resp => { linus_says => 'F*** you!' }, method => 'chooChoo', request_args => [{ passengers => [ 'Linus Torvalds', 'Richard Stallman', 'Jen-Hsun Huang' ], destination => 'GNU/Land' }] }, { agent => \&mojo_mock, resp => { msg => 'Thank you. Jesus has been updated.' }, method => 'updateJesus', request_args => [{ picture => { file => '/home/steam/gaben.jpg' }, details => { name => 'Gaben', hl3 => -1 } }], json_decode => 'details' }, # Async time! { agent => \&mojo_mock, resp => { msg => 'Did you mean node.js?' }, method => 'asyncSearch', async => 1, request_args => [ { search_term => 'Perl' } ] }, { agent => \&mojo_mock, resp => { msg => 'Your file looks a bit too big' }, method => 'sendBigFile', async => 1, request_args => [{ big_file => { file => '/dev/urandom', filename => 'important_document.docx', TrustMe => "I'm an engineer" } }], upload => 1 } ); # Here's the plan...... ok sorry. plan tests => 5 * @tests + 2; # 2 more tests for the async ones (TODO: automatize the calculation) # Initialize the BotAPI. my $api = WWW::Telegram::BotAPI->new ( @base_constructor_args ); # Time to start testing! foreach my $test (@tests) { # WWW::Telegram::BotAPI now checks if 'ok' exists and is true. ++$test->{resp}{ok}; # Create the agent. my ($mock_agent, $mock_response, @call_order) = $test->{agent}->($test->{resp}); # Illegally replace BotAPI's agent with ours. Hope this does not backfire :-) $api->{_agent} = $mock_agent; # Also enable async if needed. $api->{async} = $test->{async}; my $method = $test->{method}; # Prepare the marvelous "mock tester". my $mock_tester = sub { my $return_value = shift; # Test return values (and thus, JSON encoding and decoding) is_deeply $return_value, $test->{resp}, "return value of '$method' is as expected"; # Test mock call order. $mock_agent->called_pos_ok (1, 'post'); $mock_response->called_pos_ok ($_ + 1, $call_order[$_]) for (0 .. @call_order - 1); # Test call arguments. my ($name, $args) = $mock_agent->next_call; shift @$args; # remove $self from the argument list # $args->[2] is always the hash reference containing post data -- decode as required if (my $var = $test->{json_decode}) { $args->[2]{$var} = JSON::MaybeXS::decode_json $args->[2]{$var}; } # If the test has request arguments but they are JSONified, fix it. # This is required because when using LWP everything is serialized using JSON::MaybeXS, # while in Mojo::UserAgent this is handled internally. elsif ($test->{request_args} and !ref $args->[2]) { $args->[2] = JSON::MaybeXS::decode_json $args->[2]; } is_deeply $args, ($test->{expected_request_args} || [ # automatically determine the expected request arguments # Parsed API url sprintf ($api->{api_url}, $api->{token}, $method), # The rest of the request arguments, if available. $test->{request_args} ? $mock_agent->isa ('Mojo::UserAgent') ? ( # Mojo # multipart/form-data ("form") is used when uploading files -- otherwise # always use application/json ("json") ($test->{upload} or $test->{json_decode}) ? 'form' : 'json', @{$test->{request_args}} ) : ( # LWP Content => @{$test->{request_args}}, Content_Type => 'application/json' ) : () ]), "arguments of '$name' for '$method' are as expected"; }; note ("running tests for $test->{method}"); # Handle asynchronous requests. if ($test->{async}) { # Push the callback. push @{$test->{request_args}}, $mock_tester; # Call the method. is $api->$method (@{$test->{request_args} || []}), 'ASYNC IS COOL', "async request for '$method' is really async"; # Relax. } else { # Non-async request. $mock_tester->($api->$method (@{$test->{request_args} || []})); } } sub lwp_mock { my $response = shift; my $mock_response = Test::MockObject->new->set_true ('is_success')->set_always ( 'decoded_content', JSON::MaybeXS::encode_json ($response)); my $mock_agent = Test::MockObject->new->set_always ('post', $mock_response); $mock_agent->set_isa ('LWP::UserAgent'); ($mock_agent, $mock_response, 'decoded_content', 'is_success') } sub mojo_mock { my $response = shift; my $mock_response = Test::MockObject->new->set_false ('error')->set_always ('res', Test::MockObject->new->set_always ('json', $response)); my $mock_agent = Test::MockObject->new->mock ('post', sub { if (ref (my $cb = pop) eq 'CODE') # Async request { my $response = $mock_response->res->json; # Fake the '!$tx->error' call when async is used - WWW::Telegram::BotAPI does not # verify if the request succeeded when async is true. $mock_response->error; # Call the callback (no pun intended) with the response. $cb->($response); return 'ASYNC IS COOL'; } # Otherwise just return the object. $mock_response }); $mock_agent->set_isa ('Mojo::UserAgent'); ($mock_agent, $mock_response, 'res', 'error') } WWW-Telegram-BotAPI-0.12/t/pod.t0000644000175100017510000000027213050351442016372 0ustar robertofrobertof#!/usr/bin/env perl use strict; use warnings; use Test::More; BEGIN { eval 'use Test::Pod 1.00; 1' || plan skip_all => 'Test::Pod 1.00 required for testing POD'; } all_pod_files_ok(); WWW-Telegram-BotAPI-0.12/MANIFEST0000644000175100017510000000054513605500140016311 0ustar robertofrobertofChanges gen_doc INSTALL.SKIP lib/WWW/Telegram/BotAPI.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP README.md t/00-basic.t t/01-api-requests.t t/02-exceptions.t t/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) WWW-Telegram-BotAPI-0.12/Makefile.PL0000644000175100017510000000245413050351442017136 0ustar robertofrobertof#!/usr/bin/env perl use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile ( AUTHOR => 'Roberto Frenna ', NAME => 'WWW::Telegram::BotAPI', VERSION_FROM => 'lib/WWW/Telegram/BotAPI.pm', ABSTRACT => 'Perl implementation of the Telegram Bot API', LICENSE => 'artistic_2', PREREQ_PM => { map { $_ => 0 } qw[Carp Encode LWP::UserAgent LWP::Protocol::https JSON::MaybeXS] }, (eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (META_MERGE => { resources => { license => 'http://www.opensource.org/licenses/artistic-license-2.0', bugtracker => 'https://github.com/Robertof/perl-www-telegram-botapi/issues', repository => 'https://github.com/Robertof/perl-www-telegram-botapi' } }) : () ) ); # Create the target "README.md" used to generate the markdown version of the POD documentation. # It uses the script gen_doc, which requires Pod::Markdown. # Thanks to the author of Mojolicious::Plugin::DigestAuth, who used a similar section in its # makefile to do the same thing. sub MY::postamble { my $self = shift; <{VERSION_FROM} \t\$(PERLRUN) gen_doc $self->{VERSION_FROM} END_MAKE }