1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677 |
- 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;
-
- 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;
|