DoctorKarma/bin/doctor_karma.pl

408 lines
12 KiB
Prolog
Executable File

#!/usr/bin/env perl
use v5.30.0;
use strict;
use warnings;
use Data::Dumper;
use JSON;
use Mojo::URL;
use Mojo::Util qw/xml_escape/;
use DoctorKarma::Config;
use DoctorKarma::Telegram;
use DoctorKarma::Logger;
use DoctorKarma::DB;
use DoctorKarma::DAO::User;
use DoctorKarma::Model::User;
binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';
my $config = DoctorKarma::Config->new;
my $logger = DoctorKarma::Logger->new;
my $telegram =
DoctorKarma::Telegram->new( telegram_token => $config->telegram_token );
my $db = DoctorKarma::DB->dbh;
my @commands = (
{
command => 'karma',
description =>
'Shows your karma or the one of the user you are replying to.',
},
{
command => 'doctortop',
description => 'Shows the most popular users.',
},
{
command => 'doctorhate',
description => 'Shows the most hated users.',
},
{
command => 'about',
description =>
'Shows license information, author and where to find the code.',
},
{
command => 'donate',
description => 'Shows how to donate.',
},
{
command => 'help',
description => 'Shows this help.',
}
);
my $i = 0;
while (1) {
eval {
$telegram->set_my_commands( commands => [@commands] ) if $i == 0;
my $updates = $telegram->get_updates;
for my $update ( $updates->@* ) {
my $message = $update->{message};
if ( defined $message ) {
proccess_new_message($message);
}
}
$i++;
};
if ($@) {
$logger->log_error($@);
}
}
sub proccess_new_message {
my $message = shift;
my $reply_to_message = $message->{reply_to_message};
update_user($message);
if ( defined $message->{text} ) {
process_message_with_text($message);
}
}
sub process_message_with_text {
my $message = shift;
my $text = $message->{text};
my $username = $message->{from}{username};
my $user_id = $message->{from}{id};
my $first_name = $message->{from}{first_name};
my $reply_to_message = $message->{reply_to_message};
my $log_username = defined $username ? "\@$username" : '';
$logger->log_info(
"'$message->{text}' received from $first_name:$log_username:$user_id");
if ( defined $reply_to_message && $text eq '+1' ) {
add_karma_to_replied_message_user($message);
return;
}
if ( defined $reply_to_message && $text eq '-1' ) {
substract_karma_to_replied_message_user($message);
return;
}
if ( $text =~ m{^/karma(?:@\w+)?$} ) {
show_karma($message);
return;
}
if ( $text =~ m{^/doctortop(?:@\w+)?$} ) {
show_top_ten($message);
return;
}
if ( $text =~ m{^/doctorhate(?:@\w+)?$} ) {
show_top_ten_hate($message);
return;
}
if ( $text =~ m{^/about(?:@\w+)?$} ) {
show_about($message);
return;
}
if ( $text =~ m{^/donate(?:@\w+)?$} ) {
show_donate($message);
return;
}
if ( $text =~ m{^/help(?:@\w+)?$} ) {
show_help($message);
return;
}
if ( defined $reply_to_message && $text =~ /^(?:-|\+)\d+$/ ) {
error_too_much_karma($message);
return;
}
}
sub check_can_modify_karma {
my $message = shift;
my $user_id = $message->{from}{id};
my $chat_id = $message->{chat}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $user = $user_dao->recover_id( id => $user_id );
if ( $user->can_modify_karma ) {
$user_dao->update_last_karma_given_date(
user => $user,
last_karma_given_date => DateTime->now
);
return 1;
}
my $last_karma_given_date = $user->last_karma_given_date;
my $time_to_post =
$last_karma_given_date->add( minutes => 1 ) - DateTime->now();
$telegram->send_message(
chat_id => $chat_id,
text => "You cannot give karma yet wait a bit.
<b>@{[xml_escape($time_to_post->seconds)]} seconds to send karma</b>.",
);
return 0;
}
sub show_help {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $html = "<b><u>List of commands</u></b>\n\n";
for my $command (@commands) {
$html .=
"<b>@{[xml_escape('/'.$command->{command})]}</b> @{[xml_escape($command->{description})]}\n";
}
$telegram->send_message(
text => $html,
chat_id => $chat_id,
);
}
sub show_donate {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $html = <<'EOF';
You can donate btc using the following bitcoin address:
bc1qtas98jqjglezqtz5es8cpg0h72qquc4h83e0gz
EOF
$telegram->send_message(
chat_id => $chat_id,
text => $html
);
}
sub show_about {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $html = <<'EOF';
This bot is free software licensed under the <b>AGPLv3</b>.
You can grab a copy of the source code at:
<a href="https://gitea.sergiotarxz.freemyip.com/sergiotarxz/DoctorKarma">https://gitea.sergiotarxz.freemyip.com/sergiotarxz/DoctorKarma</a>
If you want to contribute contact with @sergiotarxz.
If you are interested in donate use the /donate command.
EOF
$telegram->send_message(
chat_id => $chat_id,
text => $html,
);
}
sub error_too_much_karma {
my $message = shift;
my $chat_id = $message->{chat}{id};
$telegram->send_message(
chat_id => $chat_id,
text => 'You cannoct substract or add more than 1 of karma.',
);
}
sub show_top_ten_hate {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $users = $user_dao->get_top_ten_hate_karma;
my $html = "<b>Top ten hated users:</b>\n\n";
my $i = 0;
for my $user (@$users) {
my $first_name = $user->first_name;
my $karma = $user->karma;
$i++;
$html .= "$i- <b>@{[xml_escape($first_name)]}</b> "
. "@{[xml_escape($karma)]}\n";
}
$logger->log_info("Showing top ten in $chat_id.");
$telegram->send_message(
chat_id => $chat_id,
text => $html
);
}
sub show_top_ten {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $users = $user_dao->get_top_ten_karma;
my $html = "<b>Top ten users:</b>\n\n";
my $i = 0;
for my $user (@$users) {
my $first_name = $user->first_name;
my $karma = $user->karma;
$i++;
$html .= "$i- <b>@{[xml_escape($first_name)]}</b> "
. "@{[xml_escape($karma)]}\n";
}
$logger->log_info("Showing top ten in $chat_id.");
$telegram->send_message(
chat_id => $chat_id,
text => $html
);
}
sub show_karma {
my $message = shift;
my $reply_to_message = $message->{reply_to_message};
my $user_id = $reply_to_message->{from}{id} // $message->{from}{id};
my $chat_id = $message->{chat}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $user = $user_dao->recover_id( id => $user_id );
my $first_name = $user->first_name;
my $karma = $user->karma;
my $html_message = <<"EOF";
<b>@{[xml_escape($first_name)]}</b> has @{[xml_escape($karma)]} points of karma.
EOF
$telegram->send_message(
chat_id => $chat_id,
text => $html_message,
);
}
sub substract_karma_to_replied_message_user {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $reply_to_message = $message->{reply_to_message};
my $user_giving_id = $message->{from}{id};
my $user_receiving_id = $reply_to_message->{from}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $sending_karma_user = $user_dao->recover_id( id => $user_giving_id );
if ( $user_giving_id == $user_receiving_id ) {
$logger->log_info(<<"EOF");
User @{[$sending_karma_user->first_name]}:@{[$sending_karma_user->username]}:@{[$sending_karma_user->id_user]} tried to substract karma to itself, refusing.
EOF
$telegram->send_message(
chat_id => $chat_id,
text => 'You cannot substract karma to yourself.'
);
return;
}
return unless check_can_modify_karma($message);
my $receiving_karma_user =
$user_dao->recover_id( id => $user_receiving_id );
if ( !defined $receiving_karma_user ) {
update_user($reply_to_message);
$receiving_karma_user =
$user_dao->recover_id( id => $user_receiving_id );
}
$user_dao->substract_1_karma( user => $receiving_karma_user );
my $id_receptor = $receiving_karma_user->id_user;
my $receptor_telegram_url = Mojo::URL->new('tg://user');
$receptor_telegram_url->query( id => $id_receptor );
my $first_name = $receiving_karma_user->first_name;
my $karma = $receiving_karma_user->karma;
$telegram->send_message(
chat_id => $chat_id,
text =>
"<b>@{[xml_escape($first_name)]}</b> has now @{[xml_escape($karma)]} of karma."
);
}
sub add_karma_to_replied_message_user {
my $message = shift;
my $chat_id = $message->{chat}{id};
my $reply_to_message = $message->{reply_to_message};
my $user_giving_id = $message->{from}{id};
my $user_receiving_id = $reply_to_message->{from}{id};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $sending_karma_user = $user_dao->recover_id( id => $user_giving_id );
if ( $user_giving_id == $user_receiving_id ) {
$logger->log_info(<<"EOF");
User @{[$sending_karma_user->first_name]}:@{[$sending_karma_user->username]}:@{[$sending_karma_user->id_user]} tried to give karma to itself, refusing.
EOF
$telegram->send_message(
chat_id => $chat_id,
text => 'You cannot give karma to yourself.'
);
return;
}
return unless check_can_modify_karma($message);
my $receiving_karma_user =
$user_dao->recover_id( id => $user_receiving_id );
if ( !defined $receiving_karma_user ) {
update_user($reply_to_message);
$receiving_karma_user =
$user_dao->recover_id( id => $user_receiving_id );
}
$user_dao->add_1_karma( user => $receiving_karma_user );
my $id_receptor = $receiving_karma_user->id_user;
my $receptor_telegram_url = Mojo::URL->new('tg://user');
my $first_name = $receiving_karma_user->first_name;
my $karma = $receiving_karma_user->karma;
$telegram->send_message(
chat_id => $chat_id,
text =>
"<b>@{[xml_escape($first_name)]}</b> has now @{[xml_escape($karma)]} of karma."
);
}
sub update_user {
my $message = shift;
my $user_id = $message->{from}{id};
my $username = $message->{from}{username};
my $first_name = $message->{from}{first_name};
my $user_dao = DoctorKarma::DAO::User->new( dbh => $db );
my $user = $user_dao->recover_id( id => $user_id );
if ( !defined $user ) {
$user = DoctorKarma::Model::User->new(
id_user => $user_id,
( defined $username ) ? ( username => $username ) : (),
karma => 0
);
$user_dao->store( user => $user );
}
if ( ( $user->username // '' ) ne ( $username // '' ) ) {
if ( defined $username ) {
my $user_already_with_username =
$user_dao->recover_username( username => $username );
$user_dao->update_username(
user => $user_already_with_username,
username => undef,
) if defined $user_already_with_username;
}
$user_dao->update_username(
user => $user,
username => $username
);
}
if ( ( $user->first_name // '' ) ne $first_name ) {
$user_dao->update_firstname(
user => $user,
first_name => $first_name
);
}
}