105 lines
2.1 KiB
Perl
105 lines
2.1 KiB
Perl
package CelBot::Plugin::UserDB::XML;
|
|
|
|
use strict;
|
|
use constant DB_TYPE => "xml";
|
|
use constant PLUGIN_TYPE => undef;
|
|
|
|
use base qw( CelBot::Plugin::UserDB );
|
|
|
|
sub init
|
|
{
|
|
my $self = shift;
|
|
my ( $config ) = @_;
|
|
|
|
my %users;
|
|
$self->{users} = \%users;
|
|
|
|
$config->associate_nodeset(
|
|
'user',
|
|
'@handle',
|
|
|
|
add => sub {
|
|
my ( $handle, $config ) = @_;
|
|
|
|
my $user = $users{lc $handle} = { handle => $handle };
|
|
|
|
$user->{nicks} = [ $config->get_list( 'nick/text()' ) ];
|
|
$user->{hostmasks} = [ $config->get_list( 'hostmask/text()' ) ];
|
|
|
|
$user->{globaldata} = $config->get_map( 'flag', '@name', 'text()' );
|
|
},
|
|
|
|
keep => sub {
|
|
my ( $handle, $config ) = @_;
|
|
|
|
my $user = $users{lc $handle};
|
|
|
|
$user->{nicks} = [ $config->get_list( 'nick/text()' ) ];
|
|
$user->{hostmasks} = [ $config->get_list( 'hostmask/text()' ) ];
|
|
|
|
$user->{globaldata} = $config->get_map( 'flag', '@name', 'text()' );
|
|
},
|
|
|
|
remove => sub {
|
|
my ( $handle ) = @_;
|
|
|
|
delete $users{lc $handle};
|
|
},
|
|
);
|
|
}
|
|
|
|
sub describe
|
|
{
|
|
my $self = shift;
|
|
return "Inline XML";
|
|
}
|
|
|
|
sub exists_handle
|
|
{
|
|
my $self = shift;
|
|
my ( $handle ) = @_;
|
|
|
|
return exists $self->{users}->{lc $handle};
|
|
}
|
|
|
|
sub map_nick_to_handles
|
|
{
|
|
my $self = shift;
|
|
my ( $nick ) = @_;
|
|
|
|
my @handles;
|
|
|
|
foreach my $u ( values %{ $self->{users} } ) {
|
|
push @handles, $u->{handle} if grep { $_ eq $nick } @{ $u->{nicks} };
|
|
}
|
|
|
|
return @handles;
|
|
}
|
|
|
|
sub list_handles
|
|
{
|
|
my $self = shift;
|
|
# Can't use keys %users because they're casefolded
|
|
return map { $_->{handle} } values %{ $self->{users} };
|
|
}
|
|
|
|
sub get_all_data
|
|
{
|
|
my $self = shift;
|
|
my ( $handle ) = @_;
|
|
|
|
$handle = lc $handle;
|
|
|
|
return undef unless exists $self->{users}->{$handle};
|
|
|
|
my $data = $self->{users}->{$handle};
|
|
|
|
return {
|
|
global => $data->{globaldata},
|
|
nicks => [ $data->{nicks} ? @{ $data->{nicks} } : () ],
|
|
hostmasks => [ $data->{hostmasks} ? @{ $data->{hostmasks} } : () ],
|
|
};
|
|
}
|
|
|
|
# Keep perl happy, keep Britain tidy
|
|
1;
|