Initial commit

5 files changed, 293 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c97f963
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.sh
diff --git a/deefine.pl b/deefine.pl
new file mode 100755
index 0000000..5c9be21
--- /dev/null
+++ b/deefine.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/env perl
+#
+# Find the details of a given word using the Words API
+# (https://www.wordsapi.com/docs/)
+#
+# Dependencies: HTTP-Message, LWP, JSON
+################################################################################
+
+use strict;
+use warnings;
+use open ':std', ':encoding(UTF-8)'; # To correctly display pronunciations
+
+use HTTP::Request;
+use LWP::UserAgent;
+use JSON qw<decode_json>;
+
+# API key read from environment
+my $WORDSAPI_KEY = $ENV{'WORDSAPI_KEY'} or die "WORDSAPI_KEY not defined";
+my $WORD = shift or die "Usage: $0 <word>\n";
+
+my $ua = LWP::UserAgent->new;
+$ua->agent("gramos's script for perlweeklychallenge.org");
+my $uri = "https://wordsapiv1.p.mashape.com/words/$WORD";
+my @headers = ("X-Mashape-Key", $WORDSAPI_KEY);
+my $response = $ua->request(HTTP::Request->new("GET", $uri, \@headers));
+
+# Check for errors in API request
+if ($response->is_error()) {
+    if ($response->code == 404) {
+        die "Word '$WORD' not found\n";
+    } else {
+        die "Unknown error: " . $response->message;
+    }
+}
+
+my $json_resp = decode_json $response->content;
+
+my $syllables = $json_resp->{'syllables'};
+if ($syllables && $syllables->{'count'} > 1) {
+    printf "Word: '$WORD' (%s)\n", join("-", @{$syllables->{'list'}});
+} else {
+    print "Word: '$WORD'\n";
+}
+
+my $pronunciation = $json_resp->{'pronunciation'};
+if (ref($pronunciation) eq "HASH") {
+    my %pronunciations = %{$pronunciation};
+    if ($pronunciations{'all'}) {
+        print "Pronunciation: /$pronunciations{'all'}/\n";
+    } else {
+        print "Pronunciation:\n";
+        foreach my $k (keys %pronunciations) {
+            print "  as $k: /$pronunciations{$k}/\n";
+        }
+    }
+} elsif ($pronunciation) {
+    # This case is not documented, thanks WordsAPI.
+    print "Pronunciation: /$pronunciation/\n";
+}
+
+my $frequency = $json_resp->{'frequency'};
+if ($frequency) {
+    print "Frequency: ";
+    print $frequency > 5 ? "frequently used"
+        : $frequency > 3 ? "occasionally used"
+        : $frequency > 1 ? "rarely used"
+        : "never used";
+    print "\n";
+}
+
+my $results = $json_resp->{'results'};
+if ($results) {
+    print "Definitions:\n";
+    foreach my $res (@$results) {
+        printf "  - (%s) %s\n", $res->{'partOfSpeech'}, $res->{'definition'};
+        my $synonyms = $res->{'synonyms'};
+        if ($synonyms) {
+            printf "    synonyms: %s\n", join(", ", @$synonyms);
+        }
+        my $examples = $res->{'examples'};
+        if ($examples) {
+            foreach my $example (@$examples) {
+                print qq'    "$example"\n';
+            }
+        }
+        print "\n";
+    }
+}
diff --git a/escato.pl b/escato.pl
new file mode 100755
index 0000000..0ee4515
--- /dev/null
+++ b/escato.pl
@@ -0,0 +1,148 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use List::Util qw<any>;
+use DBI;
+
+exit unless exists $ENV{'TGUTILS_TYPE'};
+exit unless $ENV{'TGUTILS_TYPE'} eq 'TEXT';
+
+$/ = undef;
+my $text = <>;
+
+# Indicios de que alguien ha cagado
+my @DUMP_TRIGGERS = (
+    "caga", "jiñ", # Verbos
+    "pino", "pinaco", "ñordo", "truñ", "chusc", "caca" # Sustantivos
+    );
+my @PHRASES = (
+    "Estoy orgulloso de ti, %s.",
+    "¡Así se hace %s! 👏👏",
+    "¿Otra vez, %s? Tu salud intestinal es admirable, felicidades.",
+    );
+my $dbh;
+
+init_schema() unless -f 'escato.db';
+if (any { lc($text) =~ $_ } @DUMP_TRIGGERS) {
+    save_dump();
+} elsif (lc($text) =~ /^\@escatobot/) {
+    show_dumps();
+}
+
+sub show_dumps {
+    my ($tg_chat_id, $tg_id, $tg_username) =
+        @ENV{'TGUTILS_CHAT_ID', 'TGUTILS_FROM_ID', 'TGUTILS_FROM_USERNAME'};
+    $dbh ||= DBI->connect("DBI:SQLite:dbname=escato.db", { AutoCommit => 0, RaiseError => 1 });
+
+    my ($sec, $min, $hour) = localtime();
+    print
+        $hour < 4 || $hour > 20 ? "Hola, buenas noches. " :
+        $hour > 13 ? "Hola, buenas tardes. " :
+        "Hola, buenos días. ";
+
+    if ($tg_chat_id ne $tg_id) {
+        my ($month, $year) =
+            @{tg_id_dumps($tg_id)}{'month', 'year'};
+
+        print "Te cuento, $tg_username. Este mes has cagado $month veces. En total llevas $year truños en lo que vamos de año.\n";
+    } else {
+        print "Os cuento, shures:\n";
+        my $position = 1;
+        my @shures;
+        foreach my $shur (values %{chat_members($tg_chat_id)}) {
+            push @shures, {username => $shur->{'username'},
+                           data => tg_id_dumps($shur->{'id'})};
+        }
+        foreach my $shur (sort { $_->{data}{month} } @shures) {
+            printf "%d - @%s ha cagado %d veces este mes, y %d al año.\n",
+                $position++, $shur->{username}, $shur->{data}{month}, $shur->{data}{year};
+        }
+    }
+}
+
+sub chat_members {
+    my $tg_chat_id = shift;
+    $dbh ||= DBI->connect("DBI:SQLite:dbname=escato.db", { AutoCommit => 0, RaiseError => 1 });
+    my $sth = $dbh->prepare('SELECT U.id, U.username FROM tg_chat_users CU JOIN tg_users U ON U.id = CU.tg_id WHERE CU.tg_chat_id = ?');
+    $sth->execute($tg_chat_id);
+
+    return $sth->fetchall_hashref('id');
+}
+
+sub tg_id_dumps {
+    my $tg_id = shift;
+
+    $dbh ||= DBI->connect("DBI:SQLite:dbname=escato.db", { AutoCommit => 0, RaiseError => 1 });
+
+    my $sth = $dbh->prepare('SELECT day, count FROM monthly_dumps WHERE tg_id = ?');
+    $sth->execute($tg_id);
+    my %stats = (total => 0, year => 0, month => 0, day => 0);
+    my (undef, undef, undef, $day, $month, $year) = localtime();
+    $month++;
+    $year += 1900;
+    while (my $row = $sth->fetch()) {
+        my ($date, $count) = @$row;
+        my ($y, $m, $d) = $date =~ /(\d+)-(\d+)-(\d+)/;
+        $stats{total} += $count;
+        $stats{year} += $count if $y == $year;
+        $stats{month} += $count if $m == $month;
+        $stats{day} += $count if $d == $day;
+    }
+    \%stats;
+}
+
+sub init_schema {
+    $dbh ||= DBI->connect("DBI:SQLite:dbname=escato.db", { AutoCommit => 0, RaiseError => 1 });
+    $dbh->prepare('CREATE TABLE tg_users (
+                 id INTEGER PRIMARY KEY,
+                 username TEXT NOT NULL UNIQUE
+                 )')->execute();
+    $dbh->prepare('CREATE TABLE tg_chats (
+                 id INTEGER PRIMARY KEY
+                 )')->execute();
+    $dbh->prepare('CREATE TABLE tg_chat_users (
+                 tg_chat_id INTEGER NOT NULL,
+                 tg_id INTEGER NOT NULL,
+                 PRIMARY KEY (tg_chat_id, tg_id),
+                 FOREIGN KEY (tg_id) REFERENCES tg_users(id),
+                 FOREIGN KEY (tg_chat_id) REFERENCES tg_chats(id)
+                 )')->execute();
+    $dbh->prepare('CREATE TABLE monthly_dumps (
+                 id INTEGER PRIMARY KEY,
+                 tg_id INTEGER NOT NULL,
+                 day DATE NOT NULL,
+                 count INTEGER NOT NULL,
+                 FOREIGN KEY (tg_id) REFERENCES tg_users(id)
+                 UNIQUE(tg_id, day)
+                 )')->execute();
+}
+
+sub save_dump {
+    my ($tg_chat_id, $tg_id, $tg_username) = @ENV{'TGUTILS_CHAT_ID', 'TGUTILS_FROM_ID', 'TGUTILS_FROM_USERNAME'};
+
+    $dbh ||= DBI->connect("DBI:SQLite:dbname=escato.db", { AutoCommit => 0, RaiseError => 1 });
+    $dbh->prepare('INSERT OR REPLACE INTO tg_users VALUES (?, ?)')
+        ->execute($tg_id, $tg_username);
+    $dbh->prepare('INSERT OR IGNORE INTO tg_chats VALUES (?)')
+        ->execute($tg_chat_id);
+    $dbh->prepare('INSERT OR IGNORE INTO tg_chat_users VALUES (?, ?)')
+        ->execute($tg_chat_id, $tg_id);
+
+    my $sth = $dbh->prepare('SELECT count FROM monthly_dumps
+                           WHERE tg_id = ? AND day = DATE("now", "start of day")');
+    $sth->execute($tg_id);
+    if ($sth->fetch()) {
+        $dbh
+            ->prepare('UPDATE monthly_dumps SET count = count+1 WHERE
+                     tg_id = ? AND day = DATE("now", "start of day")')
+            ->execute($tg_id);
+    } else {
+        $dbh->prepare('INSERT INTO monthly_dumps
+                     (tg_id, day, count)
+                     VALUES
+                     (?, DATE("now", "start of day"), 1)')->execute($tg_id);
+    }
+    printf $PHRASES[rand @PHRASES], "@" . $tg_username;
+}
+
diff --git a/pegatino.pl b/pegatino.pl
new file mode 100755
index 0000000..7ef2e61
--- /dev/null
+++ b/pegatino.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use JSON qw<encode_json>;
+use MIME::Base64 qw<encode_base64>;
+use Image::Magick;
+use File::Temp qw<tempfile>;
+use Data::Dumper;
+
+exit unless exists $ENV{'TGUTILS_TYPE'};
+exit unless $ENV{'TGUTILS_TYPE'} eq 'IMAGE';
+
+$/ = undef;
+binmode STDIN;
+my $origimg = <>;
+
+my ($origh, $origpath) = tempfile();
+
+binmode $origh;
+print $origh $origimg;
+close $origh;
+
+my $imagick = Image::Magick->new;
+$imagick->Read($origpath);
+$imagick->Resize(geometry => '512x512');
+
+my $newpath = $origpath . ".png";
+$imagick->Write($newpath);
+
+open(my $newh, "<", $newpath);
+binmode $newh;
+my $newimg = <$newh>;
+close $newh;
+
+unlink $origpath, $newpath;
+
+print encode_json({type => 'DOCUMENT', caption => 'Tenga, ayúdese', content => encode_base64 $newimg, '' });
diff --git a/savefc.pl b/savefc.pl
new file mode 100755
index 0000000..2333ab9
--- /dev/null
+++ b/savefc.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+my $phrase = join "", <STDIN>;
+chomp $phrase;
+
+if ($phrase) {
+    open(my $f, ">>", shift) or die $!;
+    print $f "$phrase\n====\n";
+    close $f;
+
+    print "Saved!\n";
+} else {
+    print "I don't like that, GTFO\n";
+}