Author: coke
Date: Tue Sep 20 02:29:39 2005
New Revision: 9221
Added:
branches/leo-ctx5/util/smokeserv-README
branches/leo-ctx5/util/smokeserv-client.pl (contents, props changed)
Log:
Er, why do these not look committed?
Added: branches/leo-ctx5/util/smokeserv-README
==============================================================================
--- (empty file)
+++ branches/leo-ctx5/util/smokeserv-README Tue Sep 20 02:29:39 2005
@@ -0,0 +1,46 @@
+=head1 NAME
+
+smokeserv - Pugs Smoke Reports Server
+
+=head1 DESCRIPTION
+
+C<smokeserv-client.pl> is a Perl 5 program which submits smokes as generated by
+the C<smoke-*> make targets (C<smoke>, C<smoke-perl5>, C<smoke-js>) to a public
+smokeserver.
+
+C<smokeserv-server.pl> is the smokeserver which accepts the smokes submitted
+by C<smokeserv-client.pl>.
+
+=head1 USAGE
+
+=head2 Client
+
+Using the client is easy. In the first place, you have to generate a
+C<smoke.html>. You can achieve this by running C<make>:
+
+ $ make smoke # or
+ $ make smoke-js # or
+ $ make smoke-perl5 # or
+ $ make smoke-pir
+
+Then you can upload the resulting smoke:
+
+ $ ./util/smokeserv/smokeserv-client.pl ./smoke.html
+
+You don't need to be careful to only submit a smoke only once, etc. -- the
+smokeserver takes care of this.
+
+=head2 Server
+
+Setting up a server is easy, too, all you have to do is to install several CPAN
+modules (C<CGI>, C<CGI::Carp>, C<Fcntl>, C<Storable>, C<HTML::Template>,
+C<Algorithm::TokenBucket>, C<Time::Piece>, C<Time::Seconds>, C<Compress::Zlib>,
+and C<Compress::Bzip2>) and change the constants at the top of
+C<smokeserv-server.pl>.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself. See L<perlgpl> and L<perlartistic> for details.
+
+=cut
Added: branches/leo-ctx5/util/smokeserv-client.pl
==============================================================================
--- (empty file)
+++ branches/leo-ctx5/util/smokeserv-client.pl Tue Sep 20 02:29:39 2005
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use LWP::UserAgent;
+
+use constant VERSION => 0.4;
+sub debug($);
+
+our $compress = sub { return };
+
+GetOptions(
+ "smokeserv=s" =>
+ \(my $smokeserv = "http://www.woobling.org:8080/";),
+ "help" => \&usage,
+ "compress|c!" => \(my $compression_wanted = 1),
+ "version" => sub { print "smokeserv-client.pl v" . VERSION . "\n"; exit
},
+) or usage();
[EMAIL PROTECTED] == 1 or usage();
+
+debug "smokeserv-client v" . VERSION . " started.\n";
+
+setup_compression() if $compression_wanted;
+
+my %request = (upload => 1, version => VERSION, smokes => []);
+
+{
+ my $file = shift @ARGV;
+ debug "Reading smoke \"$file\" to upload... ";
+
+ open my $fh, "<", $file or die "Couldn't open \"$file\" for reading: $!\n";
+ local $/;
+ my $smoke = <$fh>;
+
+ unless($smoke =~ /^<!DOCTYPE html/) {
+ debug "doesn't look like a smoke; aborting.\n";
+ exit 1;
+ }
+
+ $request{smoke} = $compress->($smoke) || $smoke;
+ debug "ok.\n";
+}
+
+{
+ debug "Sending data to smokeserver \"$smokeserv\"... ";
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("pugs-smokeserv-client/" . VERSION);
+ $ua->env_proxy;
+
+ my $resp = $ua->post($smokeserv => \%request);
+ if($resp->is_success) {
+ if($resp->content =~ /^ok/) {
+ debug "success!\n";
+ exit 0;
+ } else {
+ debug "error: " . $resp->content . "\n";
+ exit 1;
+ }
+ } else {
+ debug "error: " . $resp->status_line . "\n";
+ exit 1;
+ }
+}
+
+sub usage { print STDERR <<USAGE; exit }
+Usage: $0 [options] -- smoke1.html smoke2.html ...
+
+Available options:
+ --smokeserv=http://path/to/smokeserv.pl
+ Sets the path to the smoke server.
+ --version
+ Outputs the version of this program and exits.
+ --help
+ Show this help.
+
+Options may be abbreviated to uniqueness.
+USAGE
+
+# Nice debugging output.
+{
+ my $fresh;
+ sub debug($) {
+ my $msg = shift;
+
+ print STDERR "* " and $fresh++ unless $fresh;
+ print STDERR $msg;
+ $fresh = 0 if substr($msg, -1) eq "\n";
+ 1;
+ }
+}
+
+sub setup_compression {
+ eval { require Compress::Bzip2; debug "Bzip2 compression on\n" } and
+ return $compress = sub { Compress::Bzip2::memBzip(shift) };
+ eval { require Compress::Zlib; debug "Gzip compression on\n" } and
+ $compress = sub { Compress::Zlib::memGzip(shift) };
+}
