minions/lib/htlogr.pm

package htlogr;

## Author: Alois Mahdal at zxcvb cz
# Front-end for very primitive remote logging service. Use htlog.cgi
# as back-end: put it on a HTTP server and provide URL as "path" option
# when instantiating this class

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


use HTTP::Lite;
use URI::Escape;
use Carp;

sub new {
    my ($class, $opts)  = @_;
    my $self            = {};

    foreach (qw/ path /) {
        $self->{$_} = $opts->{$_} or croak("missing mandatory option: $_");
    }

    $self->{http} = HTTP::Lite->new;

    return bless $self, $class;
}

sub log {
    my $self    = shift;
    my $msg     = shift;
    my $tag     = shift;
    my $i       = shift;

    $tag = &{$tag}()    if ref($tag) eq 'CODE';
    $i = &{$i}()        if ref($i) eq 'CODE';

    my $uri;
    $uri .= $self->{path};
    $uri .= "?msg=" . uri_escape($msg);
    $uri .= "&tag=" . uri_escape($tag)  if $tag;
    $uri .= "&i="   . uri_escape($i)    if $i;
    my $response = $self->{http}->request($uri)
        or croak("could not htlog message: $!");
    carp("logging server returned error $response, message not logged")
        unless $response eq "200";
    return $self->{http}->body();
}

sub data {
    my $self    = shift;
    my $data    = shift;
    my $tag     = shift;
    my $i       = shift;

    #TODO: Make them global
    my $DIV_FIELD =";";
    my $DIV_VALUE ="=";

    carp("data must be a hash reference") unless ref $data == 'HASH';

    my @fields;
    foreach (sort keys %$data) {
        push @fields, join $DIV_VALUE, $_, $data->$_;
    }

    $self->log( (join $DIV_FIELD, @fields), $tag, $i );
}

1;