98 lines
1.9 KiB
Perl
98 lines
1.9 KiB
Perl
package CelBot::Plugin::Console;
|
|
|
|
use strict;
|
|
use constant PLUGIN_TYPE => "console";
|
|
|
|
use base qw( CelBot::Plugin::LogBase );
|
|
|
|
use String::Tagged;
|
|
|
|
use POSIX qw( strftime );
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my ( $core, $config ) = @_;
|
|
|
|
my $console = $core->get_console;
|
|
my $tab = $console->add_tab(
|
|
name => $core->{tag},
|
|
|
|
on_line => sub {
|
|
my ( $console, $line ) = @_;
|
|
eval {
|
|
$core->run_plugins( "on_console_line", $console->active_tab, $line );
|
|
1;
|
|
} or warn "Unable to 'on_line' - $@";
|
|
}
|
|
);
|
|
|
|
my $self = bless {
|
|
core => $core,
|
|
tab => $tab,
|
|
}, $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub do_log_really
|
|
{
|
|
my $self = shift;
|
|
my ( $subject, $message ) = @_;
|
|
|
|
if( $message =~ m/[\x00-\x1f]/ ) {
|
|
my $st = String::Tagged->new( $message );
|
|
while( $message =~ m/([\x00-\x1f])/g ) {
|
|
$st->set_substr( $-[1], 1, chr( 64 + ord $1 ) );
|
|
$st->apply_tag( $-[1], 1, rv => 1 );
|
|
}
|
|
$message = $st;
|
|
}
|
|
|
|
my $timestamp = strftime( "%H:%M", localtime );
|
|
|
|
my $tab = $self->{tab};
|
|
$tab->add_line( "[$timestamp]: $subject - " . $message, indent => 9 );
|
|
}
|
|
|
|
sub permit_command_scope
|
|
{
|
|
my $self = shift;
|
|
my ( $scope, $context ) = @_;
|
|
|
|
# Anything is always allowed on the console
|
|
if( $context->scope eq 'console' ) {
|
|
return 1;
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub permit_command_perm
|
|
{
|
|
my $self = shift;
|
|
my ( $perm, $context ) = @_;
|
|
|
|
# Anything is always allowed on the console if there's no user
|
|
if( $context->scope eq 'console' and not defined $context->cmduser ) {
|
|
return 1;
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub permit_command_nonpublic
|
|
{
|
|
my $self = shift;
|
|
my ( $context ) = @_;
|
|
|
|
# Anything is always allowed on the console if there's no user
|
|
if( $context->scope eq 'console' and not defined $context->cmduser ) {
|
|
return 1;
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
# Keep perl happy, keep Britain tidy
|
|
1;
|