182 lines
4.2 KiB
Perl
182 lines
4.2 KiB
Perl
package CelBot::Plugin::MessageLog;
|
|
|
|
use strict;
|
|
use constant PLUGIN_TYPE => "messagelog";
|
|
|
|
use File::Basename qw( dirname );
|
|
use File::Path qw( make_path );
|
|
use POSIX qw( strftime );
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my ( $core, $config ) = @_;
|
|
|
|
my $self = bless {
|
|
core => $core,
|
|
targets => {}, # $targetname => [ $filename, $filehandle ]
|
|
}, $class;
|
|
|
|
$self->reconfigure( $config );
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub reconfigure
|
|
{
|
|
my $self = shift;
|
|
my ( $config ) = @_;
|
|
|
|
$self->{timestamp_format} = $config->get_string( '@timestamp_format',
|
|
default => "%H:%M:%S"
|
|
);
|
|
|
|
$self->{filename_format} = $config->get_string( '@filename_format',
|
|
default => 'logs/$target-%Y-%m-%d.log'
|
|
);
|
|
|
|
$self->{file_mode} = oct $config->get_string( '@file_mode', default => '0600' );
|
|
}
|
|
|
|
my %template = map { split( m/=/, $_, 2 ) } split( m/\n/, <<'EOF' );
|
|
join=*** Joins: $nick [$userhost] has joined $channel
|
|
part=*** Parts: $nick [$userhost] has left $channel ($partmsg)
|
|
kick=*** Kicks: $kicked [$kickedhost] was kicked from $channel by $kicker ($kickmsg)
|
|
quit=*** Quits: $nick [$userhost] ($quitmsg)
|
|
nick=*** $oldnick is now known as $newnick
|
|
topic=*** Topic change by $nick on $channel: $topic
|
|
mode=*** Mode change for $channel by $nick: $mode
|
|
msg=<$nick> $text
|
|
notice=-$nick- $text
|
|
act=* $nick $text
|
|
EOF
|
|
|
|
sub log_event
|
|
{
|
|
my $self = shift;
|
|
my ( $target, $event, %args ) = @_;
|
|
|
|
my $message = $template{$event} or return;
|
|
$message =~ s{\$(\w+)}{$args{$1}}g;
|
|
|
|
my @now = localtime;
|
|
|
|
my $filename = $self->{filename_format};
|
|
$filename = strftime( $filename, @now );
|
|
$filename =~ s{\$target}{$target};
|
|
|
|
my $timestamp = strftime( $self->{timestamp_format}, @now );
|
|
|
|
if( !$self->{targets}{$target}[0] or $self->{targets}{$target}[0] ne $filename ) {
|
|
my $full_timestamp = strftime( "%Y-%m-%d %H:%M:%S", @now );
|
|
|
|
if( my $old_fh = $self->{targets}{$target}[1] ) {
|
|
$old_fh->print( "Closing file at $full_timestamp\n" );
|
|
}
|
|
|
|
my $dir = dirname( $filename );
|
|
unless( -d $dir ) {
|
|
make_path( $dir );
|
|
}
|
|
|
|
open my $fh, ">>", $filename or die "Cannot open file $filename - $!";
|
|
$fh->autoflush(1);
|
|
|
|
chmod $self->{file_mode}, $filename; # best-effort ignore failure
|
|
|
|
$self->{targets}{$target} = [ $filename, $fh ];
|
|
|
|
$fh->print( "Opening file at $full_timestamp\n" );
|
|
}
|
|
|
|
my $fh = $self->{targets}{$target}[1];
|
|
|
|
$fh->write( "$timestamp $message\n" );
|
|
}
|
|
|
|
# Capture the actual events to log
|
|
|
|
sub on_channel_privmsg
|
|
{
|
|
my $self = shift;
|
|
my ( $channel, $user, $text ) = @_;
|
|
|
|
$self->log_event( $channel->name, msg => (
|
|
nick => $user->nick,
|
|
text => $text,
|
|
) );
|
|
}
|
|
|
|
sub on_channel_ctcp_ACTION
|
|
{
|
|
my $self = shift;
|
|
my ( $channel, $user, $text ) = @_;
|
|
|
|
$self->log_event( $channel->name, act => (
|
|
nick => $user->nick,
|
|
text => $text,
|
|
) );
|
|
}
|
|
|
|
sub on_channel_join
|
|
{
|
|
my $self = shift;
|
|
my ( $channel, $user ) = @_;
|
|
|
|
$self->log_event( $channel->name, join => (
|
|
channel => $channel->name,
|
|
userhost => $user->host,
|
|
nick => $user->nick,
|
|
) );
|
|
}
|
|
|
|
sub on_channel_leave
|
|
{
|
|
my $self = shift;
|
|
my ( $channel, $user, $command, $reason, $kicker ) = @_;
|
|
|
|
if( $command eq "PART" ) {
|
|
$self->log_event( $channel->name, part => (
|
|
channel => $channel->name,
|
|
nick => $user->nick,
|
|
userhost => $user->host,
|
|
partmsg => $reason,
|
|
) );
|
|
}
|
|
elsif( $command eq "KICK" ) {
|
|
$self->log_event( $channel->name, kick => (
|
|
channel => $channel->name,
|
|
kicked => $user->nick,
|
|
kickedhost => $user->host,
|
|
kicker => $kicker->nick,
|
|
kickerhost => $kicker->host,
|
|
kickmsg => $reason,
|
|
) );
|
|
}
|
|
elsif( $command eq "QUIT" ) {
|
|
$self->log_event( $channel->name, quit => (
|
|
channel => $channel->name,
|
|
nick => $user->nick,
|
|
userhost => $user->host,
|
|
quitmsg => $reason,
|
|
) );
|
|
}
|
|
}
|
|
|
|
sub on_channel_user_rename
|
|
{
|
|
my $self = shift;
|
|
my ( $channel, $oldname, $newname ) = @_;
|
|
|
|
$self->log_event( $channel->name, nick => (
|
|
oldnick => $oldname,
|
|
newnick => $newname,
|
|
) );
|
|
}
|
|
|
|
# topic
|
|
# mode
|
|
# notice
|
|
|
|
# Keep perl happy, keep Britain tidy
|
|
1;
|