htlogr.pm 2.1KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677
  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. my $uri;
  34. $uri .= $self->{path};
  35. $uri .= "?msg=" . uri_escape($msg);
  36. $uri .= "&tag=" . uri_escape($tag) if $tag;
  37. $uri .= "&i=" . uri_escape($i) if $i;
  38. my $response = $self->{http}->request($uri)
  39. or croak("could not htlog message: $!");
  40. carp("logging server returned error $response, message not logged")
  41. unless $response eq "200";
  42. return $self->{http}->body();
  43. }
  44. sub data {
  45. my $self = shift;
  46. my $data = shift;
  47. my $tag = shift;
  48. my $i = shift;
  49. #TODO: Make them global
  50. my $DIV_FIELD =";";
  51. my $DIV_VALUE ="=";
  52. carp("data must be a hash reference") unless ref $data == 'HASH';
  53. my @fields;
  54. foreach (keys %$data) {
  55. push @fields, join $DIV_VALUE, $_, $data->$_;
  56. }
  57. $self->log( (join $DIV_FIELD, @fields), $tag, $i );
  58. }
  59. 1;