Test::Chimps::Client - Send smoke test results to a server


Test-Chimps-Client documentation Contained in the Test-Chimps-Client distribution.

Index


Code Index:

NAME

Top

Test::Chimps::Client - Send smoke test results to a server

VERSION

Top

Version 0.05

SYNOPSIS

Top

This module simplifies the process of sending smoke test results (in the form of Test::TAP::Models) to a smoke server.

    use Test::Chimps::Client;
    use Test::TAP::Model::Visual;

    chdir "some/module/directory";

    my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t"));

    my $client = Test::Chimps::Client->new(
      server => 'http://www.example.com/cgi-bin/smoke-server.pl',
      model  => $model
    );

    my ($status, $msg) = $client->send;

    if (! $status) {
      print "Error: $msg\n";
      exit(1);
    }




METHODS

Top

new ARGS

Creates a new Client object. ARGS is a hash whose valid keys are:

* compress

Optional. Does not currently work

* model

Mandatory. The value must be a Test::TAP::Model. These are the test results that will be submitted to the server.

* report_variables

Optional. A hashref of report variables and values to send to the server.

* server

Mandatory. The URI of the server script to upload the model to.

send

Submit the specified model to the server. This function's return value is a list, the first of which indicates success or failure, and the second of which is an error string.

ACCESSORS

Top

There are read-only accessors for compress, model, report_variables, and server.

AUTHOR

Top

Zev Benjamin, <zev at cpan.org>

BUGS

Top

Please report any bugs or feature requests to bug-test-chimps at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Chimps-Client. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Test::Chimps::Client

You can also look for information at:

* Mailing list

Chimps has a mailman mailing list at chimps@bestpractical.com. You can subscribe via the web interface at http://lists.bestpractical.com/cgi-bin/mailman/listinfo/chimps.

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Test-Chimps-Client

* CPAN Ratings

http://cpanratings.perl.org/d/Test-Chimps-Client

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Chimps-Client

* Search CPAN

http://search.cpan.org/dist/Test-Chimps-Client

ACKNOWLEDGEMENTS

Top

Some code in this module is based on smokeserv-client.pl from the Pugs distribution.

COPYRIGHT & LICENSE

Top


Test-Chimps-Client documentation Contained in the Test-Chimps-Client distribution.
package Test::Chimps::Client;

use warnings;
use strict;

use Carp;
use Params::Validate qw/:all/;
use LWP::UserAgent;
use Storable qw/nfreeze/;

use constant PROTO_VERSION => 0.2;

our $VERSION = '0.05';

use base qw/Class::Accessor/;

__PACKAGE__->mk_ro_accessors(qw/model server compress report_variables/);

sub new {
  my $class = shift;
  my $obj = bless {}, $class;
  $obj->_init(@_);
  return $obj;
}

sub _init {
  my $self = shift;
  my %args = validate_with(
    params => \@_,
    called => 'The Test::Chimps::Client constructor',
    spec   => {
      model            => { isa => 'Test::TAP::Model' },
      server           => 1,
      compress         => 0,
      report_variables => {
        optional => 1,
        type     => HASHREF,
        default  => {}
      }
    }
  );

  foreach my $key (keys %args) {
    $self->{$key} = $args{$key};
  }

}

sub send {
  my $self = shift;
  
  my $ua = LWP::UserAgent->new;
  $ua->agent("Test-Chimps-Client/" . PROTO_VERSION);
  $ua->env_proxy;

  my %request = (upload => 1, version => PROTO_VERSION,
                 model_structure => nfreeze($self->model->structure),
                 report_variables => nfreeze($self->report_variables));

  my $resp = $ua->post($self->server => \%request);
  if($resp->is_success) {
    if($resp->content =~ /^ok/) {
      return (1, '');
    } else {
      return (0, $resp->content);
    }
  } else {
    return (0, $resp->status_line);
  }
}

1;