Simple xmpp bot, post all log message from dir to specified jabber accounts

gistfile1.pl

#!/usr/bin/perl
use strict;
use warnings;

use FindBin qw/$Bin/;
use lib "$Bin/../..";

use POSIX qw/setsid/;
use File::Basename qw/basename/;
use AnyEvent;
use AnyEvent::XMPP::Client;

use constant DEBUG => 0;


my $config = {
    pid_file   => "$Bin/notificator.pid",
    log_file   => "$Bin/notificator.log",
    log_dir    => '/tmp/logs',
    src_accs   => [
        {
            jid        => '[email protected]',
            jid_pass   => 'kill all humans!',
        },
    ],
    recipients => [
        '[email protected]',
    ],
};

daemonize();
write_pid();

my ($client, $error, $main_timer, $cv, $reconn_timer, $start_timer);

$cv     = AE::cv;
$client = AnyEvent::XMPP::Client->new;

for my $acc ( @{$config->{src_accs}} ) {
    $client->add_account(
        $acc->{jid},
        $acc->{jid_pass}
    );
}
$reconn_timer = 1;

$client->reg_cb(
    session_ready => sub {
        my ($client, $acc) = @_;

        debug("connected to " . $acc->jid);

        undef $reconn_timer;
        undef $start_timer;

        unless ($main_timer) {
            ## MAIN ACTION
            $main_timer = AE::timer( 1, 30, \&main_loop);
        }
    },
    error => sub {
        my ($client, $acc, $err) = @_;

        $error = $err->string;
        error("some error: $error");
        $client->disconnect
    },
    disconnect => sub {
        my ($client, $acc, $h, $p, $reas) = @_;

        return if $reconn_timer;
        error("disconnected: " . $reas);

        my $reset_timer;
        $reconn_timer = AE::timer(1, 10, sub {
            warning("try to restart connection");
            $client->start;
        });
   },
);

$start_timer = AE::timer(1, 15, sub {
    debug("try to connect to all accounts");
    $client->start;
});

$cv->recv;

info("the end\n");

sub main_loop {
    if ($client->get_connected_accounts) {
        info("have connected accounts");
    }
    else {
        warning("no connected accounts");
        return;
    }

    while (my $log_file = get_log_file()) {
        my $log = parse_log($log_file);

        my $time = get_time($log->{time});
        my $msg  = "Source: $log->{source}. Level: $log->{level}.\n" .
                   "Time: $time;\n $log->{msg}";

        for my $jid (@{$config->{recipients}}) {
            $client->send_message($msg, $jid, undef, 'chat');
            info("sent to $jid; message:\n$msg");
        }

        save_log($log);
        unlink $log_file;
    }
}

sub get_log_file {
    my @files = glob "$config->{log_dir}/*.log";

    return '' unless @files;

    my ($oldest_log) = 
        map  { $_->[0] }
        sort { $a->[1] <=> $b->[1] }
        map  { [$_, (stat $_)[9]] }
        @files;

    debug("got log file: $oldest_log");

    return $oldest_log;
}

sub parse_log {
    my $file = shift;
    my (%log, $contents);

    open my $fh, "<", $file;
    local $/;
    $contents = <$fh>;
    close $fh;

    @log{qw/level time source msg/} = split /\n/, $contents, 4;

    return \%log;
}

sub save_log {
    my $log = shift;

    my ($fname)    = split /:/, $log->{source};
    my $time       = get_time($log->{time});
    my $msg        = "[$time] $log->{level} $log->{source}:\n$log->{msg}\n";
    my $arch_fname = "$config->{log_dir}/archive/" . basename($fname) . '.log';
    
    open my $fh, '>>', $arch_fname;
    print {$fh} ("=====" x 10) . "\n";
    print {$fh} $msg;
    print {$fh} ("=====" x 10) . "\n";
    close $fh;

    debug("saved log to $arch_fname");

    return 0;
}

## utils

sub daemonize {
    die q[Cant fork] unless defined (my $child = fork);
    exit if $child;

    setsid();

    close STDIN;
    close STDOUT;
    close STDERR;

    return;
}

sub write_pid {
    my $pid_file = $config->{pid_file};

    open my $fh, '>', $pid_file;

    unless ($fh) {
        error("cant save pid_file: $!");
        exit 1;
    }
    debug("pid file is successfully opened: $pid_file");
    print {$fh} $$;
    close $fh;

    return 0;
}

sub _loggy {
    my ($level, @msg) = @_;

    if (!DEBUG && $level ne 'ERROR') {
        return;
    }

    open my $fh, '>>', $config->{log_file}
        or die "log error: $!";

    my $time = get_time();
    print {$fh} "[$time] $level: " , join(" ", @msg) . "\n";
    close $fh;

    return 0;
}

sub error   { _loggy('ERROR', @_) }
sub warning { _loggy('WARN',  @_) }
sub info    { _loggy('INFO',  @_) }
sub debug   { _loggy('DEBUG', @_) }

sub get_time {
    my @time = localtime(shift || time);

    $time[5] += 1900;
    $time[4] += 1;

    return sprintf "%02u.%02u.%04u %02u:%02u:%02u", @time[3, 4, 5, 2, 1, 0];
}