milkbone/plugins/Log.pl

package Log;

use Milkbone qw(user_dir);
use File::Path;

use strict;
use warnings;

our $dir;

register_hook("signed_in", sub {
    $dir = user_dir . "log";
    mkpath($dir);
});

register_hook("msg_in", \&on_msg_in);
register_hook("protocol_send_im", \&on_protocol_send_im);
register_hook("buddy_in", \&on_buddy_in);
register_hook("buddy_out", \&on_buddy_out);

sub on_msg_in
{
    my ($hour, $min, $sec) = (localtime)[2,1,0];
    log_item(user_log_file($ARGS{-user}), "<font color=\"blue\">" . 
	     $ARGS{-user} . " ($hour:$min:$sec) " .
	     ": $ARGS{-msg} </font><br>\n");
}

sub on_buddy_in
{
    return unless -e user_dir . "log/" . "/$ARGS{-buddy}";
    my ($hour, $min, $sec) = (localtime)[2,1,0];
    log_item(user_log_file($ARGS{-buddy}), "<font color=\"blue\">" . 
	     $ARGS{-buddy} . " signed in at $hour:$min:$sec.</font><br>\n\n");
}

sub on_buddy_out
{
    return unless -e user_log_file($ARGS{-buddy});
    my ($hour, $min, $sec) = (localtime)[2,1,0];
    log_item(user_log_file($ARGS{-buddy}), "<font color=\"blue\">" . 
	     $ARGS{-buddy} . " signed out at $hour:$min:$sec.</font><br>\n\n");
}

sub on_protocol_send_im
{
    my ($hour, $min, $sec) = (localtime)[2,1,0];
    log_item(user_log_file($ARGS{-dest}), "<font color=\"red\">" . 
	     data("me") . " ($hour:$min:$sec) " .
	     ": $ARGS{-msg} </font><br>\n");
}

sub log_item
{
    my ($file, $text) = @_;

    open(LOG, ">>$file");
    print LOG $text;
    close(LOG);
}

sub user_log_file
{
    my ($user) = @_;
    my ($month, $day, $year) = (localtime)[4, 3, 5];
    $month++;
    $year %= 100;

    my $path = "$dir/$user";
    mkpath $path;

    return "$path/$month-$day-$year.html";
}

1;