#! perl # Copyright (C) 2005-2007, The Perl Foundation. # $Id: smokeserv-client.pl 21252 2007-09-13 06:36:05Z paultcochrane $ use strict; use warnings; use Getopt::Long; use LWP::UserAgent; use constant VERSION => 0.4; sub debug($); our $compress = sub { return }; GetOptions( "smokeserv=s" => \( my $smokeserv = "http://smoke.parrotcode.org/smoke/" ), "help" => \&usage, "compress|c!" => \( my $compression_wanted = 1 ), "version" => sub { print "smokeserv-client.pl v" . VERSION . "\n"; exit }, ) or usage(); @ARGV == 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 =~ /^($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 <