Added htlogger back+front-end; very primitive remote logging mechanism.

cgi-bin/htlog/htlog.cgi

@@ -0,0 +1,46 @@
+#!/usr/bin/perl -w
+
+## Author: Alois Mahdal at zxcvb cz
+# Back-end for very primitive remote logging. Front-end is htlogr.pm
+
+# 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 CGI;
+
+my $LOG_FILE = 'htlog.log';
+open my $fh, ">>", $LOG_FILE or die "cannot open log file for appending: $!";
+
+my $q = CGI->new;
+my $msg = ( defined $q->param('msg')    ? $q->param('msg')  : '' );
+my $tag = ( defined $q->param('tag')    ? $q->param('tag')  : '-none-' );
+
+my $message = sprintf("Time: %s, Origin: %s, Tag: %s, Message: %s\n",
+    time,
+    $ENV{'REMOTE_ADDR'},
+    $tag,
+    $msg
+);
+
+
+print $fh $message;
+
+print $q->header(
+    -type               => 'text/javascript',
+    -expires            => 'now',
+);
+
+print "Message logged: $msg\n";
+
+close $fh or die "cannot close log file: $!";
+

lib/htlogr.pm

@@ -0,0 +1,51 @@
+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 $uri;
+    $uri .= $self->{path};
+    $uri .= "?msg=" . uri_escape($msg);
+    $uri .= "&tag=" . uri_escape($tag)    if $tag;
+    $self->{http}->request($uri) or croak("could not htlog message: $!");
+    return $self->{http}->body();
+}
+
+1;