From dd67f33ec57b7f9b6b565f7257b5810926c5ebc4 Mon Sep 17 00:00:00 2001 From: eleksir Date: Thu, 25 Feb 2021 21:09:39 +0300 Subject: [PATCH] Merge fox and kitty plugins to image.pm, add oboobs, obutts command family, extend/fix admin.pm MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Merge fox and kitty plugins to image.pm * Add !tits, !tities, !boobs, !boobies, !сиси, !сисечки commands * Add !butt, !booty, !ass, !попа, !попка commands * Add generic interface for plugin toggle flags * Fix a bit morning fortune status plugin --- lib/admin.pm | 118 +++++++++++++++++++++++++++++++++++-- lib/botlib.pm | 65 ++++++++++++++++++-- lib/fox.pm | 55 ----------------- lib/image.pm | 160 ++++++++++++++++++++++++++++++++++++++++++++++++++ lib/kitty.pm | 55 ----------------- 5 files changed, 335 insertions(+), 118 deletions(-) delete mode 100644 lib/fox.pm create mode 100644 lib/image.pm delete mode 100644 lib/kitty.pm diff --git a/lib/admin.pm b/lib/admin.pm index ccb735e..da8ef12 100644 --- a/lib/admin.pm +++ b/lib/admin.pm @@ -16,10 +16,12 @@ use version; our $VERSION = qw (1.0); use Exporter qw (import); # to export array we need @ISA here our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA) -our @EXPORT_OK = qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status); +our @EXPORT_OK = qw (@forbiddenMessageTypes @pluginList getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status plugin_toggle plugin_status pluginEnabled); my $c = loadConf (); my $dir = $c->{admin}->{dir}; +# this list is not yet used +our @pluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars) our @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars) sub initCensorDB { @@ -190,7 +192,7 @@ sub fortune_toggle (@) { }; } - my $backingfile = sprintf '%s/chats.sqlite', $dir; + my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir; tie my %toggle, 'SQLite_File', $backingfile || do { cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; @@ -235,7 +237,7 @@ sub fortune_status ($) { }; } - my $backingfile = sprintf '%s/chats.sqlite', $dir; + my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir; tie my %toggle, 'SQLite_File', $backingfile || do { cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"; @@ -263,7 +265,7 @@ sub fortune_toggle_list () { } } - my $backingfile = sprintf '%s/chats.sqlite', $dir; + my $backingfile = sprintf '%s/fortune_morning.sqlite', $dir; tie my %toggle, 'SQLite_File', $backingfile || do { cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; @@ -276,6 +278,114 @@ sub fortune_toggle_list () { return @list; } +sub plugin_status (@) { + my $chatid = shift; + my $plugin = shift; + my $phrase = "Плагин $plugin "; + + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + return; + }; + } + + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"; + return; + }; + + my $state = $toggle{$plugin}; + untie %toggle; + + if (defined $state && $state) { + $phrase .= 'включён.'; + } else { + $phrase .= 'выключен.'; + } + + return $phrase; +} + +sub pluginEnabled (@) { + my $chatid = shift; + my $plugin = shift; + + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + return; + }; + } + + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n"; + return; + }; + + my $state = $toggle{$plugin}; + untie %toggle; + + if (defined $state && $state) { + return 1; + } else { + return 0; + } +} + +sub plugin_toggle (@) { + my $chatid = shift; + my $plugin = shift; + my $action = shift // undef; + my $phrase = "Плагин $plugin "; + + unless (-d $dir) { + make_path ($dir) || do { + cluck "[ERROR] Unable to create $dir: $OS_ERROR"; + my @empty = (); + return @empty; + } + } + + my $backingfile = utf2sha1 $chatid; + $backingfile =~ s/\//-/xmsg; + $backingfile = sprintf '%s/%s.sqlite', $dir, $backingfile; + + tie my %toggle, 'SQLite_File', $backingfile || do { + cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; + my @empty = (); + return @empty; + }; + + if (defined $action) { + if ($action) { + $toggle{$plugin} = 1; + $phrase .= 'включён'; + } else { + $toggle{$plugin} = 0; + $phrase .= 'выключен'; + } + } else { + if (defined ($toggle{$plugin}) && $toggle{$plugin}) { + $toggle{$plugin} = 0; + $phrase .= 'включён'; + } else { + $toggle{$plugin} = 1; + $phrase .= 'выключен'; + } + } + + untie %toggle; + return $phrase; +} 1; diff --git a/lib/botlib.pm b/lib/botlib.pm index 6ac57a5..6dd4dfc 100644 --- a/lib/botlib.pm +++ b/lib/botlib.pm @@ -11,14 +11,13 @@ use Carp qw (carp); use Math::Random::Secure qw (irand); use conf qw (loadConf); -use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status); +use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled); use archeologist qw (dig); use fisher qw (fish); use fortune qw (fortune); -use fox qw (fox); use friday qw (friday); +use image qw (kitty fox oboobs obutts); use karma qw (karmaSet karmaGet); -use kitty qw (kitty); use lat qw (latAnswer); use util qw (trim); use weather qw (weather); @@ -77,7 +76,10 @@ sub command { return; } elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') { $reply = latAnswer (); - } elsif ((length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма') { + } elsif ( + (length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || + substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма' + ) { my $mytext = ''; if (length($text) > 6) { @@ -94,6 +96,37 @@ sub command { $msg->typing (); sleep (irand (2) + 1); $msg->replyMd ($reply); + return; + } elsif ( + substr ($text, 1) eq 'tits' || + substr ($text, 1) eq 'boobs' || + substr ($text, 1) eq 'tities' || + substr ($text, 1) eq 'boobies' || + substr ($text, 1) eq 'сиси' || + substr ($text, 1) eq 'сисечки' + ) { + if (pluginEnabled $chatid, 'oboobs') { + $reply = oboobs (); + $msg->typing (); + sleep (irand (2) + 1); + $msg->replyMd ($reply); + } + + return; + } elsif ( + substr ($text, 1) eq 'butt' || + substr ($text, 1) eq 'booty' || + substr ($text, 1) eq 'ass' || + substr ($text, 1) eq 'попа' || + substr ($text, 1) eq 'попка' + ) { + if (pluginEnabled $chatid, 'obutts') { + $reply = obutts (); + $msg->typing (); + sleep (irand (2) + 1); + $msg->replyMd ($reply); + } + return; } elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { $reply = friday (); @@ -152,6 +185,10 @@ ${csign}admin fortune # - где 1 - вкл, 0 - выкл фортунку ${csign}admin фортунка # - где 1 - вкл, 0 - выкл фортунку с утра ${csign}admin fortune - показываем ли с утра фортунку для чата ${csign}admin фортунка - показываем ли с утра фортунку для чата +${csign}admin oboobs # - где 1 - вкл, 0 - выкл плагина oboobs +${csign}admin oboobs - показываем ли сисечки по просьбе участников чата (команды ${csign}tits, ${csign}tities, ${csign}boobs, ${csign}boobies, ${csign}сиси, ${csign}сисечки) +${csign}admin obutts # - где 1 - вкл, 0 - выкл плагина obutts +${csign}admin obutts - показываем ли попки по просьбе участников чата (команды ${csign}ass, ${csign}butt, ${csign}booty, ${csign}попа, ${csign}попка) ``` Типы сообщений: audio voice photo video animation sticker dice game poll document @@ -201,6 +238,26 @@ MYADMIN } else { $reply = fortune_status ($chatid); } + } elsif ($cmd eq 'oboobs') { + if (defined $args) { + if ($args == 1) { + $reply = plugin_toggle ($chatid, 'oboobs', 1); + } elsif ($args == 0) { + $reply = plugin_toggle ($chatid, 'oboobs', 0); + } + } else { + $reply = plugin_status ($chatid, 'oboobs'); + } + } elsif ($cmd eq 'obutts') { + if (defined $args) { + if ($args == 1) { + $reply = plugin_toggle ($chatid, 'obutts', 1); + } elsif ($args == 0) { + $reply = plugin_toggle ($chatid, 'obutts', 0); + } + } else { + $reply = plugin_status ($chatid, 'obutts'); + } } } } diff --git a/lib/fox.pm b/lib/fox.pm deleted file mode 100644 index d722bb0..0000000 --- a/lib/fox.pm +++ /dev/null @@ -1,55 +0,0 @@ -package fox; - -use 5.018; -use strict; -use warnings; -use utf8; -use open qw (:std :utf8); -use English qw ( -no_match_vars ); -use Carp qw (cluck); -use JSON::XS; -use HTTP::Tiny; -use Math::Random::Secure qw (irand); - -use version; our $VERSION = qw (1.0); -use Exporter qw (import); -our @EXPORT_OK = qw (fox); - -sub fox { - my $r; - my $ret = 'Нету лисичек, все разбежались.'; - - for (1..3) { - my $http = HTTP::Tiny->new (timeout => 3); - $r = $http->get ('https://randomfox.ca/floof/'); - - if ($r->{success}) { - last; - } - - sleep 2; - } - - if ($r->{success}) { - my $jfox = eval { - decode_json ($r->{content}) - }; - - if ($EVAL_ERROR) { - cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; - } else { - if ($jfox->{image}) { - $jfox->{image} =~ s/\\//xmsg; - $ret = sprintf '[-^^,--,~](%s)', $jfox->{image}; - } - } - } else { - cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; - } - - return $ret; -} - -1; - -# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/image.pm b/lib/image.pm new file mode 100644 index 0000000..f3bca09 --- /dev/null +++ b/lib/image.pm @@ -0,0 +1,160 @@ +package image; + +use 5.018; +use strict; +use warnings; +use utf8; +use open qw (:std :utf8); +use English qw ( -no_match_vars ); +use Carp qw (cluck); +use JSON::XS; +use HTTP::Tiny; +use Math::Random::Secure qw (irand); + +use version; our $VERSION = qw (1.0); +use Exporter qw (import); +our @EXPORT_OK = qw (kitty fox oboobs obutts); + +sub kitty { + my $r; + my $ret = 'Нету кошечек, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('https://api.thecatapi.com/v1/images/search'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $jcat = eval { + decode_json ($r->{content}) + }; + + unless (defined $jcat) { + cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; + } else { + if ($jcat->[0]->{url}) { + my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^' ); + $ret = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $jcat->[0]->{url}; + } + } + } else { + cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; + } + + return $ret; +} + +sub fox { + my $r; + my $ret = 'Нету лисичек, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('https://randomfox.ca/floof/'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $jfox = eval { + decode_json ($r->{content}) + }; + + unless (defined $jfox) { + cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; + } else { + if ($jfox->{image}) { + $jfox->{image} =~ s/\\//xmsg; + $ret = sprintf '[-^^,--,~](%s)', $jfox->{image}; + } + } + } else { + cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; + } + + return $ret; +} + +sub oboobs { + my $r; + my $ret = 'Нету cисичек, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('http://api.oboobs.ru/boobs/0/1/random'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $joboobs = eval { + decode_json ($r->{content}) + }; + + unless (defined $joboobs) { + cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; + } else { + if ($joboobs->[0]->{preview}) { + my @boobs = ('(. )( .)', '( . Y . )', '(o)(o)', '( @ )( @ )', '(.)(.)'); + $ret = sprintf '[%s](https://media.oboobs.ru/%s)', $boobs[irand ($#boobs + 1)], $joboobs->[0]->{preview}; + } + } + } else { + cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; + } + + return $ret; +} + +sub obutts { + my $r; + my $ret = 'Нету попок, все разбежались.'; + + for (1..3) { + my $http = HTTP::Tiny->new (timeout => 3); + $r = $http->get ('http://api.obutts.ru/butts/0/1/random'); + + if ($r->{success}) { + last; + } + + sleep 2; + } + + if ($r->{success}) { + my $jobutts = eval { + decode_json ($r->{content}) + }; + + unless (defined $jobutts) { + cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; + } else { + if ($jobutts->[0]->{preview}) { + my @butts = ('(__(__)', '(_!_)', '(__.__)'); + $ret = sprintf '[%s](http://media.obutts.ru/%s)', $butts[irand ($#butts + 1)], $jobutts->[0]->{preview}; + } + } + } else { + cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; + } + + return $ret; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/kitty.pm b/lib/kitty.pm deleted file mode 100644 index b97f86b..0000000 --- a/lib/kitty.pm +++ /dev/null @@ -1,55 +0,0 @@ -package kitty; - -use 5.018; -use strict; -use warnings; -use utf8; -use open qw (:std :utf8); -use English qw ( -no_match_vars ); -use Carp qw (cluck); -use JSON::XS; -use HTTP::Tiny; -use Math::Random::Secure qw (irand); - -use version; our $VERSION = qw (1.0); -use Exporter qw (import); -our @EXPORT_OK = qw (kitty); - -sub kitty { - my $r; - my $ret = 'Нету кошечек, все разбежались.'; - - for (1..3) { - my $http = HTTP::Tiny->new (timeout => 3); - $r = $http->get ('https://api.thecatapi.com/v1/images/search'); - - if ($r->{success}) { - last; - } - - sleep 2; - } - - if ($r->{success}) { - my $jcat = eval { - decode_json ($r->{content}) - }; - - if ($EVAL_ERROR) { - cluck "[ERROR] Unable to decode JSON: $EVAL_ERROR"; - } else { - if ($jcat->[0]->{url}) { - my @cats = ('龴ↀ◡ↀ龴', '=^..^=', '≧◔◡◔≦ ','^ↀᴥↀ^' ); - $ret = sprintf '[%s](%s)', $cats[irand ($#cats + 1)], $jcat->[0]->{url}; - } - } - } else { - cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason}; - } - - return $ret; -} - -1; - -# vim: set ft=perl noet ai ts=4 sw=4 sts=4: