metabot/extern/cel-bot/CelBot/Plugin/UserDB.pm
2021-05-20 17:59:36 -04:00

542 lines
11 KiB
Perl

package CelBot::Plugin::UserDB;
use strict;
use constant PLUGIN_TYPE => "userdb";
use CelBot::Commands;
use Module::PluginFinder;
my $userdb_finder = Module::PluginFinder->new(
search_path => "CelBot::Plugin::UserDB",
typefunc => "DB_TYPE",
);
sub new
{
my $class = shift;
my ( $core, $config ) = @_;
my $irc = $core->get_plugin( "irc" );
my $dbtype = $config->get_string( '@dbtype' );
$class = $userdb_finder->find_module( $dbtype );
my $self = bless {
core => $core,
irc => $irc,
dirty => 0,
autosave => 1,
autosave_delay => 300,
}, $class;
$self->init( $config );
return $self;
}
sub get_global_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
if( $data->{global} ) {
my $globaldata = $data->{global};
return $globaldata->{$key} if exists $globaldata->{$key};
}
return undef;
}
sub get_channel_data
{
my $self = shift;
my ( $handle, $channame, $key ) = @_;
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
if( $data->{channel} and $data->{channel}{$channame} ){
my $channeldata = $data->{channel}{$channame};
return $channeldata->{$key} if exists $channeldata->{$key};
}
return $self->get_global_data( $handle, $key );
}
sub get_channels_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
my %ret;
$ret{global} = $data->{global}{$key};
foreach my $channame ( keys %{ $data->{channel} } ) {
$ret{$channame} = $data->{channel}{$channame}{$key} if exists $data->{channel}{$channame}{$key};
}
return \%ret;
}
sub get_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
my $value = $data->{$key};
return undef unless defined $value;
# SHALLOW clone
$value = [ @$value ] if ref $value eq "ARRAY";
$value = { %$value } if ref $value eq "HASH";
return $value;
}
sub set_global_data
{
my $self = shift;
my ( $handle, $key, $value ) = @_;
die "Cannot set global data in $self" unless $self->can( "save" );
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
if( defined $value ) {
# SHALLOW clone
$value = [ @$value ] if ref $value eq "ARRAY";
$value = { %$value } if ref $value eq "HASH";
$data->{global}{$key} = $value;
}
else {
delete $data->{global}{$key};
}
$self->mark_dirty;
}
sub set_channel_data
{
my $self = shift;
my ( $handle, $channame, $key, $value ) = @_;
die "Cannot set channel data in $self" unless $self->can( "save" );
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
if( defined $value ) {
# SHALLOW clone
$value = [ @$value ] if ref $value eq "ARRAY";
$value = { %$value } if ref $value eq "HASH";
$data->{channel}{$channame}{$key} = $value;
}
else {
delete $data->{channel}{$channame}{$key};
delete $data->{channel}{$channame} if not keys %{ $data->{channel}{$channame} };
}
$self->mark_dirty;
}
sub set_data
{
my $self = shift;
my ( $handle, $key, $value ) = @_;
die "Cannot set data in $self" unless $self->can( "save" );
return undef unless defined $handle;
my $data = $self->get_all_data( $handle );
# TODO: Consider merging behaviour
# SHALLOW clone
$value = [ @$value ] if ref $value eq "ARRAY";
$value = { %$value } if ref $value eq "HASH";
$data->{$key} = $value;
$self->mark_dirty;
}
sub mark_dirty
{
my $self = shift;
return if $self->{dirty};
$self->{dirty} = 1;
return unless $self->{autosave};
my $core = $self->{core};
my $loop = $core->get_loop;
$core->log( "INFO", "<UserDB>", "Marking UserDB dirty; will autosave in $self->{autosave_delay} seconds" );
$self->{savetimer_id} = $loop->enqueue_timer(
delay => $self->{autosave_delay},
code => sub {
$self->save;
$self->{dirty} = 0;
$core->log( "INFO", "<UserDB>", "UserDB saved to disk; is clean again" );
},
);
}
sub mark_clean
{
my $self = shift;
$self->{dirty} = 0;
if( $self->{savetimer_id} ) {
my $core = $self->{core};
my $loop = $core->get_loop;
$loop->cancel_timer( $self->{savetimer_id} );
undef $self->{savetimer_id};
}
}
###
# Signals
###
sub ask_handle_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return $self->get_data( $handle, $key );
}
sub ask_handle_global_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return $self->get_global_data( $handle, $key );
}
sub ask_handle_channel_data
{
my $self = shift;
my ( $handle, $channame, $key ) = @_;
return $self->get_channel_data( $handle, $channame, $key );
}
sub ask_handle_channels_data
{
my $self = shift;
my ( $handle, $key ) = @_;
return $self->get_channels_data( $handle, $key );
}
sub do_handle_set_data
{
my $self = shift;
my ( $handle, $key, $value ) = @_;
$self->set_data( $handle, $key, $value );
return 1;
}
sub do_handle_set_global_data
{
my $self = shift;
my ( $handle, $key, $value ) = @_;
$self->set_global_data( $handle, $key, $value );
return 1;
}
sub do_handle_set_channel_data
{
my $self = shift;
my ( $handle, $channame, $key, $value ) = @_;
$self->set_channel_data( $handle, $channame, $key, $value );
return 1;
}
sub ask_map_nick_to_handles
{
my $self = shift;
my ( $nick ) = @_;
return $self->map_nick_to_handles( $nick );
}
###
# Commands
###
sub register_commands
{
my $self = shift;
my ( $commands_plugin ) = @_;
$commands_plugin->register(
plugin => $self,
command => "userdb",
subcmds => {
reload => {
perm => "owner",
args => [],
summary => "Reload the database from last saved storage",
},
save => {
perm => "owner",
args => [],
summary => "Save the database to storage",
},
},
summary => "Interact with the user information database",
);
}
sub command_userdb_reload
{
my $self = shift;
my ( $context ) = @_;
if( $self->{dirty} ) {
# TODO: Implement a 'force' option
return ( "Database is dirty - will not reload" );
}
$self->reload;
$self->mark_clean;
return ( "OK" );
}
sub command_userdb_save
{
my $self = shift;
my ( $context ) = @_;
$self->save;
$self->mark_clean;
return ( "OK" );
}
sub register_usermgmt_commands
{
my $self = shift;
my ( $usermgmt_plugin ) = @_;
my $irc = $self->{irc};
my $users = $irc->get_users_plugin;
$usermgmt_plugin->register_command(
plugin => $self,
command => "find",
perm => 'master',
needhandle => 0,
args => [
CelBot::Commands::ArgSpec::Bareword->new( 'pattern' ),
],
summary => "List handles matching a pattern",
);
# The method for this command is provided by the concrete subclass
$usermgmt_plugin->register_command(
plugin => $self,
command => "get",
perm => "self|master",
needhandle => 1,
args => [],
summary => "Fetch a record from the userdb",
);
if( $self->can( "add_handle" ) ) {
$usermgmt_plugin->register_command(
plugin => $self,
command => "add",
perm => 'master',
needhandle => 0,
args => [
CelBot::Commands::ArgSpec::Bareword->new( 'newhandle' ),
$users->gen_argspec( 'asuser', optional => 1 ),
],
summary => "Add a new user account",
);
}
$usermgmt_plugin->register_command(
plugin => $self,
command => "sync",
perm => 'master',
needhandle => 1,
args => [
$users->gen_argspec,
],
summary => "Synchronise a user account from an IRC user",
);
}
sub command_useracc_find
{
my $self = shift;
my ( $context, $pattern ) = @_;
$pattern =~ s/\./\\./g; # Make '.' literal
$pattern =~ s/\*/.*/g; # Make '*' match .*
$pattern =~ s/\?/./g; # Make '?' match .
my $re = qr/^$pattern$/i; # case-insensitive
my @handles = grep { $_ =~ $re } $self->list_handles;
my $count = @handles;
if( @handles > 20 ) {
return ( "$count matches: " . join( " ", @handles[0 .. 19] ) . " ..." );
}
else {
return ( "$count matches: " . join( " ", @handles ) );
}
}
sub command_useracc_get
{
my $self = shift;
my ( $context ) = @_;
my $handle = $context->{handle};
return "No such userdb handle $handle" unless $self->exists_handle( $handle );
my %ret;
my $core = $self->{core};
$core->run_plugins( "get_useracc_for_display", $handle, \%ret );
# TODO: Sort somehow
my @ret = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %ret;
return @ret;
}
sub command_useracc_add
{
my $self = shift;
my ( $context, $newhandle, $asuser ) = @_;
return "Cannot add '$newhandle' - already exists" if $self->exists_handle( $newhandle );
$self->add_handle( $newhandle );
if( defined $asuser ) {
my $core = $self->{core};
$core->run_plugins( "on_handle_sync_from_user", $newhandle, $asuser, $context );
}
return "Added '$newhandle' to user database";
}
sub command_useracc_sync
{
my $self = shift;
my ( $context, $user ) = @_;
my $handle = $context->{handle};
return "Cannot sync handle '$handle' - does not exist" unless $self->exists_handle( $handle );
my $core = $self->{core};
$core->run_plugins( "on_handle_sync_from_user", $handle, $user, $context );
return "Synchronised '$handle' from " . $user->nick;
}
###
# Settings
###
sub register_settings
{
my $self = shift;
my ( $settings_plugin ) = @_;
my $core = $self->{core};
my $loop = $core->get_loop;
$settings_plugin->register(
type => 'boolean',
name => "autosave",
perm => 'owner',
storage => \$self->{autosave},
after => sub {
if( $self->{autosave} and $self->{dirty} and !$self->{savetimer_id} ) {
$self->{savetimer_id} = $loop->enqueue_timer(
delay => $self->{autosave_delay},
code => sub {
$self->save;
$self->{dirty} = 0;
$core->log( "INFO", "<UserDB>", "UserDB saved to disk; is clean again" );
},
);
}
if( !$self->{autosave} and $self->{savetimer_id} ) {
$loop->cancel_timer( $self->{savetimer_id} );
undef $self->{savetimer_id};
}
},
desc => "Whether user database is automatically saved after edits",
);
$settings_plugin->register(
type => 'int',
name => "autosave_delay",
perm => 'owner',
storage => \$self->{autosave_delay},
desc => "Delay after database edits before it will be saved (if enabled)",
);
}
# Keep perl happy, keep Britain tidy
1;