1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677 |
- package htlogr;
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- 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;
-
-
- my $DIV_FIELD =";";
- my $DIV_VALUE ="=";
-
- carp("data must be a hash reference") unless ref $data == 'HASH';
-
- my @fields;
- foreach (keys %$data) {
- push @fields, join $DIV_VALUE, $_, $data->$_;
- }
-
- $self->log( (join $DIV_FIELD, @fields), $tag, $i );
- }
-
- 1;
|