定期的にDBを読んで新規ユーザが登録されてたらMatrixに報告する

checkNewUsers.pl

#!/usr/bin/perl --
use strict;
use warnings;
use feature qw(say);
use utf8;
use Encode;

use FindBin 1.51 qw( $RealBin );
use lib $RealBin;
use MatrixPoster;

my $mastodonServer = 'mastodon.juggler.jp';
my $matrixRoomId = '!hhHXgRobyeOzxDPGkA:matrix.juggler.jp';

#############################
my $utf8 = Encode::find_encoding('utf8');
binmode $_,":encoding(utf8)" for \*STDOUT,\*STDERR;

my $poster;
sub post($){
    my($text)=@_;
    $poster or $poster = MatrixPoster->new( configFile => './matrixLoginSecret.txt');
    $poster->postText( $matrixRoomId , $text );
}

#############################
my $sql = <<"END";
select timezone('JST', u.created_at::timestamptz) as created_at , u.email, a.username, a.display_name
from users as u
left join accounts as a on(u.account_id=a.id)
where u.confirmed_at is not null
and u.created_at >= (CURRENT_TIMESTAMP - interval '1 hour')
order by u.created_at desc
limit 10;
END

$sql =~ s/#.*/ /g;
$sql =~ s/\s+/ /g;
$sql =~ s/([\\"])/\\$1/g;

##say $sql;
my @result = `docker exec m1j_db_backend_1 psql -U postgres postgres -A -c "$sql"`;
#say @result;

for(@result){
    s/[\x0d\x0a]+//g;
    $_ = $utf8->decode($_);
    my($createdAt,$mail,$userName) = split /\|/,$_;
    next if !$createdAt || $createdAt =~ /row|created_at/;
    my $url = "https://$mastodonServer/\@$userName";
    my $text = "マストドンのサーバにユーザ登録がありました。 $createdAt $url";
    post($text);
}

matrixLoginSecret.txt.sample

;; コメントは ;; です。 (matrixだと # や // を多用するため)
userAgent Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.72 Safari/537.36
server matrix.org
user XXXXXXXXXXX

;; password を記入してtokenをコメントアウトしてverboseが真だとログインしてトークンをコンソールに出力します
password xxxxxxxxxxxxxxxx
verbose 1
;; token XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

MatrixPoster.pm

package MatrixPoster;
$MatrixPoster::VERSION = '0.20210314'; # YYYYMMDD

use strict;
use warnings;
use utf8;
use Encode;
use Data::Dump qw(dump);
use JSON::XS;
use URI::Escape;
use HTML::Entities;
use LWP::UserAgent;
use Attribute::Constant;
use feature qw(say);

my $utf8 = Encode::find_encoding("utf8");

sub new{
    my($class,%others)=@_;
    my $self = \%others;

    my $configFile = $self->{configFile};
    if($configFile){
         open(my $fh,"<:utf8",$configFile) or die "$! $configFile";
         while(<$fh>){
             s/[\x0f\x0a]+//g;
             s/;;.*//g;
             s/^\s+//;
             s/\s+$//;
             next if not length;
             my($name,$value)=split /\s+/,$_,2;
             defined($value) or die "not in form 'name value'. [$_]";
             $self->{$name}=$value;
        }
        close($fh) or die "$! $configFile";
    }

    if( not $self->{ua}){
        my $ua = $self->{ua} = LWP::UserAgent->new(
             timeout => 30,
             agent => $self->{userAgent} || "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/89.0.4389.72 Safari/537.36",
        );
        $ua->env_proxy;
    }

    die "missing 'server'." unless $self->{server};
    die "missing 'token' or pair of 'user' and 'password'." unless $self->{token} || ($self->{user} && $self->{password});

    return bless $self,$class;
}

sub encodeQuery($){
    my($hash)=@_;
    return join "&",map{ uri_escape($_)."=".uri_escape($hash->{$_}) } sort keys %$hash;
}

sub showUrl{
    my($self,$method,$url)=@_;
    if($self->{verbose}){
        $url =~ s/access_token=[^&]+/access_token=xxx/g;
        $self->{verbose} and warn "$method $url\n";
    }
}

my $methodPost : Constant("POST");
my $methodGet : Constant("GET");

sub matrixApi{
    my($self,$method,$path,$params)=@_;
    my $url = "https://$self->{server}/_matrix/client/r0$path";
    if($self->{token}){
        my $delm = index($url,"?")==-1? "?":"&";
        $url = $url . $delm .encodeQuery({access_token=>$self->{token}})
    }
    my $res;
    if( $method eq $methodPost){
        $self->showUrl($method,$url);
        $res = $self->{ua}->post($url,Content => encode_json($params || {}));
    }else{
        die "matrixApi: unsupport method $method";
    }

    $res->is_success or die "request failed. $url ",$res->status_line;

    my $content = $res->decoded_content;
    $self->{lastContent} = $content;
    return decode_json($content);
}

sub login{
    my($self)=@_;
    my $root = $self->matrixApi("POST","/login",{
        type=>"m.login.password",
        user=>$self->{user},
        password=>$self->{password},
    });
    $self->{token} = $root->{access_token};
    die "missing token in API response. $self->{lastContent}" unless $self->{token};
    $self->{verbose} and say "login successful. token=$self->{token}";
}

sub postText{
    my($self,$roomId, $text)=@_;
    $self->login if not $self->{token};

     my $params =

    my $root = $self->matrixApi(
        "POST",
        "/rooms/".uri_escape($roomId)."/send/m.room.message",
        {
            msgtype=>"m.text",
            body=>$text,
        }
    );
    my $eventId =  $root->{event_id};
    die "missing eventId in API response." unless $eventId;
    return $eventId;
}

1;
__END__