package htlogr; ## Author: Alois Mahdal at vornet 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 . 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;