htlogr.pm 2.2KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. package htlogr;
  2. ## Author: Alois Mahdal at zxcvb cz
  3. # Front-end for very primitive remote logging service. Use htlog.cgi
  4. # as back-end: put it on a HTTP server and provide URL as "path" option
  5. # when instantiating this class
  6. # This program is free software: you can redistribute it and/or modify
  7. # it under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation, either version 3 of the License, or
  9. # (at your option) any later version.
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. # GNU General Public License for more details.
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. use HTTP::Lite;
  17. use URI::Escape;
  18. use Carp;
  19. sub new {
  20. my ($class, $opts) = @_;
  21. my $self = {};
  22. foreach (qw/ path /) {
  23. $self->{$_} = $opts->{$_} or croak("missing mandatory option: $_");
  24. }
  25. $self->{http} = HTTP::Lite->new;
  26. return bless $self, $class;
  27. }
  28. sub log {
  29. my $self = shift;
  30. my $msg = shift;
  31. my $tag = shift;
  32. my $i = shift;
  33. $tag = &{$tag}() if ref($tag) eq 'CODE';
  34. $i = &{$i}() if ref($i) eq 'CODE';
  35. my $uri;
  36. $uri .= $self->{path};
  37. $uri .= "?msg=" . uri_escape($msg);
  38. $uri .= "&tag=" . uri_escape($tag) if $tag;
  39. $uri .= "&i=" . uri_escape($i) if $i;
  40. my $response = $self->{http}->request($uri)
  41. or croak("could not htlog message: $!");
  42. carp("logging server returned error $response, message not logged")
  43. unless $response eq "200";
  44. return $self->{http}->body();
  45. }
  46. sub data {
  47. my $self = shift;
  48. my $data = shift;
  49. my $tag = shift;
  50. my $i = shift;
  51. #TODO: Make them global
  52. my $DIV_FIELD =";";
  53. my $DIV_VALUE ="=";
  54. carp("data must be a hash reference") unless ref $data == 'HASH';
  55. my @fields;
  56. foreach (sort keys %$data) {
  57. push @fields, join $DIV_VALUE, $_, $data->$_;
  58. }
  59. $self->log( (join $DIV_FIELD, @fields), $tag, $i );
  60. }
  61. 1;