tgserver: receive images + send documents

2 files changed, 131 insertions, 18 deletions

diff --git a/lib/TgLib/Api.pm b/lib/TgLib/Api.pm
index 66c808f..73aee4b 100644
--- a/lib/TgLib/Api.pm
+++ b/lib/TgLib/Api.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use JSON qw<encode_json decode_json>;
 use HTTP::Request;
+use HTTP::Request::Common qw<POST>;
 use LWP::UserAgent;
 use Data::Dumper;
 
@@ -14,6 +15,7 @@ our @EXPORT = qw<new>;
 sub new {
     my ($class, $token, $logger) = @_;
     return bless { uri => "https://api.telegram.org/bot$token",
+                   file_uri => "https://api.telegram.org/file/bot$token",
                    ua => LWP::UserAgent->new,
                    logger => $logger }, $class;
 }
@@ -35,7 +37,7 @@ sub get_updates {
     } else {
         my $updates = decode_json($resp->content)->{'result'};
         # TODO why does `decode_json` not do this work?
-        map { utf8::encode($_->{'message'}{'text'}) } @$updates;
+        map { utf8::encode($_->{'message'}{'text'}) if exists $_->{'message'}{'text'} } @$updates;
         $logger->info(sprintf "Received %d updates from chats %s\n",
                      scalar(@$updates),
                      join(", ", map { $_->{'message'}{'chat'}{'id'} } @$updates));
@@ -61,4 +63,57 @@ sub send_message {
     }
 }
 
+sub send_document {
+    my ($self, $chat_id, $photo) = @_;
+    my $logger = $self->{'logger'};
+    my $uri = "$self->{'uri'}/sendDocument";
+    my $content = {'chat_id' => $chat_id,
+                       'caption' => 'Tenga, ayúdese',
+                       'document' => [undef, 'cosa.png', Content => $photo]};
+
+    my $req = POST $uri, 'Content-Type' => "multipart/form-data", 'Content' => $content;
+    $logger->info("Sending photo to $chat_id\n");
+    $logger->debug(sprintf "Request:\n%s\n", Dumper($req)); # DEBUG
+
+    my $resp = $self->{'ua'}->request($req);
+    $logger->debug(sprintf "Response:\n%s\n", Dumper($resp));
+    if ($resp->is_error()) {
+        print decode_json($resp->content)->{'description'};
+        die $resp->message;
+    }
+}
+
+sub get_file {
+    my ($self, $file_id) = @_;
+    my $logger = $self->{'logger'};
+    my $uri = "$self->{'uri'}/getFile";
+    my $content = encode_json {'file_id' => $file_id};
+
+    my $req = HTTP::Request->new("POST", $uri,
+                               ["Content-Type", "application/json"], $content);
+    $logger->debug(sprintf "Request:\n%s\n", Dumper($req));
+
+    my $resp = $self->{'ua'}->request($req);
+    $logger->debug(sprintf "Response:\n%s\n", Dumper($resp));
+    if ($resp->is_error()) {
+        die $resp->message;
+    } else {
+        my $file_path = decode_json($resp->content)->{'result'}{'file_path'};
+        $logger->info("Getting file $file_id (file_path: $file_path)...\n");
+
+        my $uri = "$self->{'file_uri'}/$file_path";
+        my $req = HTTP::Request->new("GET", $uri);
+        $logger->debug(sprintf "Request:\n%s\n", Dumper($req));
+
+        my $resp = $self->{'ua'}->request($req);
+        $logger->debug(sprintf "Response:\n%s\n", Dumper($resp));
+
+        if ($resp->is_error()) {
+            die $resp->content;
+        } else {
+            return $resp->content;
+        }
+    }
+}
+
 1;
diff --git a/tgserver b/tgserver
index e624ae2..589054b 100755
--- a/tgserver
+++ b/tgserver
@@ -5,11 +5,18 @@
 # Run `tgserver -h` for quick help, or `tgserver -h -v` for full manual.
 ################################################################################
 
+use strict;
+use warnings;
+
+use Try::Tiny;
+
 $main::VERSION = "0.1.1";
 
 use Getopt::Long qw(:config auto_version);
 use Pod::Usage qw<pod2usage>;
 use Data::Dumper;
+use MIME::Base64 qw<decode_base64>;
+use JSON qw<decode_json>;
 
 use FindBin;
 use lib "$FindBin::Bin/lib";
@@ -44,28 +51,75 @@ while (1) {
         $cache->offset($update->{'update_id'}+1);
 
         $logger->debug(sprintf "Update %s", Dumper($update));
-        my $text = $update->{'message'}{'text'};
-        my $chat_id = $update->{'message'}{'chat'}{'id'};
-        $logger->info("Received from chat $chat_id: '$text'\n");
-
-        use IPC::Open2 qw<open2>;
-        my $pid = open2(my $progr, my $progw, "@ARGV");
-        print $progw $text;
-        close($progw);
-        my $response = join "", <$progr>;
-        chomp $response;
-        $logger->debug("'$text' -> @ARGV -> '$response'\n");
-        close($progr);
-
-        if ($response) {
-            my $api = TgLib::Api->new($TOKEN, $logger);
-            $api->send_message($chat_id, $response);
+        my $msg = $update->{'message'};
+        if (exists $msg->{'photo'}) {
+            handle_photo($msg);
         } else {
-            $logger->warn("Empty response, skipping\n");
+            handle_text($msg);
         }
     }
 }
 
+sub handle_photo {
+    my $msg = shift;
+    my $photos = $msg->{'photo'};
+    my $chat_id = $msg->{'chat'}{'id'};
+    my $photo = (sort { $b->{'width'} <=> $a->{'width'} } @$photos)[0];
+    $logger->info(sprintf "Received photo %s (size=%d)\n", $photo->{'file_id'}, $photo->{'file_size'});
+
+    my $file = $api->get_file($photo->{'file_id'});
+
+    $ENV{'TGUTILS_TYPE'} = 'IMAGE';
+    my $response = pipe_send($file, @ARGV);
+    my $type = ref $response eq 'HASH' ? $response->{'type'} : undef;
+    if ($type eq 'DOCUMENT') {
+        $api->send_document($chat_id, decode_base64 $response->{'content'});
+    } else {
+        $api->send_message($chat_id, $response);
+    }
+}
+
+sub handle_text {
+    my $msg = shift;
+    my $text = $msg->{'text'};
+    my $chat_id = $msg->{'chat'}{'id'};
+    $logger->info("Received from chat $chat_id: '$text'\n");
+
+    $ENV{'TGUTILS_TYPE'} = 'TEXT';
+    my $response = pipe_send($text, @ARGV);
+    if ($response) {
+        $api->send_message($chat_id, $response);
+    } else {
+        $logger->warn("Empty response, skipping\n");
+    }
+}
+
+sub pipe_send {
+    my ($content, @cmd) = @_;
+
+    use IPC::Open2 qw<open2>;
+    my $pid = open2(my $progr, my $progw, @cmd);
+
+    print $progw $content;
+    close($progw);
+
+    # Don't read a single line
+    my $oldsep = $/;
+    $/ = undef;
+
+    binmode($progr);
+    my $response = <$progr>;
+    close($progr);
+
+    $/ = $oldsep;
+
+    waitpid $pid, 0; # collect the child process
+    chomp $response;
+    # $logger->debug("'$content' -> @ARGV -> '$response'\n");
+
+    return try { decode_json $response } catch { $response };
+}
+
 
 __END__
 
@@ -83,6 +137,10 @@ B<tgserver> [I<options>] -- I<prog>
 
 =over
 
+=item B<--on-image>=I<cmd>
+
+Command to launch whenever an image is received
+
 =item B<--token>=I<token>, B<-t> I<token>
 
 Bot token (see B<AUTHENTICATION>)