Made smoke testing even easier

[sdlgit/SDL_perl.git] / tools / smolder_smoke_signal

#!/usr/bin/perl 

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;

BEGIN {
    eval { require WWW::Mechanize };
    if ($@) {
        warn "\nCannot load WWW::Mechanize. "
          . "\nPlease install it before using smolder_smoke_signal.\n";
        exit(1);
    }
}

=pod

=head1 NAME

smolder_smoke_signal

=head1 SYNOPSIS

    ./bin/smolder_smoke_signal --server smolder.foo.com \
        --username myself --password s3cr3t --file test_report.xml \
        --project MyProject

=head1 DESCRIPTION

Script used to upload a Smoke test report to a running smolder server.
This is extremely useful for scripted/automatic test runs but also
helpful when using a CLI makes things faster.

=head1 OPTIONS

=head2 REQUIRED

=over

=item server

This is the hostname (and port if not 80) of the running Smolder server.

=item project

The name of the Smolder project to use for the upload.

=item username

The name of the Smolder user to use for the upload.

=item password

The password for the Smolder user given by C<username>.

=item file

The name of the file to upload. Please see F<docs/upload_file_format.pod>
for more details about the format that Smolder expects this file to
take.

=back

=head2 OPTIONAL

=over

=item port

If your Smolder server is running on a port other than 80, then you
can specify it here.

=item architecture

The architecture for the given smoke test run. If none is given
it will use the default architecture for the project.

=item platform

The platform for the given smoke test run. If none is given
it will use the default platform for the project.

=item revision

The revision control number for this test run. Only applies to
projects that use revision control (shouldn't they all) and only
applies to tests run against a checkout from revision control.

This is just a free form text option so it will work with any
revision number that your preferred revision control system uses.

=item tags

A comma separated list of tags that are given for this smoke report run.

    ./bin/smolder_smoke_signal --server smolder.foo.com \
        --username myself --password s3cr3t --file test_report.xml \
        --project MyProject --tags "Foo, My Bar"

=item comments

Any comments that you want to associate with the smoke test run.

=item verbose

Print verbose output of our actions to STDOUT.

=cut

# default options
my ($server, $project, $user, $pw, $file, $arch, $platform, $tags, $comments, $verbose, $rev,
    $port);
my ($help, $man);

GetOptions(
    'server=s'       => \$server,
    'port=s'         => \$port,
    'project=s'      => \$project,
    'username=s'     => \$user,
    'password=s'     => \$pw,
    'file=s'         => \$file,
    'architecture=s' => \$arch,
    'platform=s'     => \$platform,
    'tags=s'         => \$tags,
    'comments=s'     => \$comments,
    'revision=s'     => \$rev,
    'verbose!'       => \$verbose,
    'help'           => \$help,
    'man'            => \$man,
) || pod2usage();

if ($help) {
    pod2usage(
        -exitval => 0,
        -verbose => 1,
    );
} elsif ($man) {
    pod2usage(
        -exitval => 0,
        -verbose => 2,
    );
}

# make sure all the required fields are there
_missing_required('server')   unless $server;
_missing_required('project')  unless $project;
_missing_required('username') unless $user;
_missing_required('password') unless $pw;
_missing_required('file')     unless $file;

# make sure our file is there and is of the right type
if (-r $file) {
    unless ($file =~ /\.tar(\.gz)?$/) {
        warn "File '$file' is not of the correct type!\n";
        exit(1);
    }
} else {
    warn "File '$file' does not exist, or is not readable!\n";
    exit(1);
}

# try and reach the smolder server
print "Trying to reach Smolder server at $server.\n" if ($verbose);
$port ||= 80;
my $mech     = WWW::Mechanize->new();
my $base_url = "http://$server:$port/app";
eval { $mech->get($base_url) };
unless ($mech->status eq '200') {
    warn "Could not reach $server:$port successfully. Received status " . $mech->status . "\n";
    exit(1);
}

# now login
print "Trying to login with username '$user'.\n" if ($verbose);
$mech->get($base_url . '/public_auth/login');
my $form = $mech->form_name('login');
if ($mech->status ne '200' || !$form) {
    warn "Could not reach Smolder login form. Are you sure $server:$port is a Smolder server?\n";
    exit(1);
}
$mech->set_fields(
    username => $user,
    password => $pw,
);
$mech->submit();
my $content = $mech->content;
if ($mech->status ne '200' || $content !~ /Welcome \Q$user\E/) {
    warn "Could not login with username '$user' and password '$pw'!\n";
    exit(1);
}

# now go to this project's page
print "Retrieving project listing for user '$user'.\n" if ($verbose);
$mech->get($base_url . '/developer_projects');
$content = $mech->content;
$content =~ />\Q$project\E<!--ID:(\d+)-->/;
my $project_id = $1;
if ($mech->status ne '200' || !$project_id) {
    warn "Could not get your project listing, or you are not a member of the '$project' project!\n";
    exit(1);
}

# now go to the add-smoke-report page for this project
print "Adding smoke report to project '$project'.\n" if ($verbose);
$mech->get($base_url . "/developer_projects/add_report/$project_id");
$content = $mech->content;
if ($mech->status ne '200' || $content !~ /New Smoke Report/) {
    warn "Could not reach the Add Smoke Report form!\n";
    exit(1);
}
$mech->form_name('add_report');
my %fields = (report_file => $file);
$fields{platform}     = $platform if $platform;
$fields{architecture} = $arch     if $arch;
$fields{tags}         = $tags     if $tags;
$fields{comments}     = $comments if $comments;
$fields{revision}     = $rev      if $rev;
$mech->set_fields(%fields);
$mech->submit();

$content = $mech->content;
if ($mech->status ne '200' || $content !~ /Recent Smoke Reports/) {
    warn "Could not upload smoke report with the given information!\n";
    exit(1);
}
$content =~ /#(\d+) Added/;
my $report_id = $1;

print "\nReport successfully uploaded as #$report_id.\n";

##########################################################
# helper methods
##########################################################
sub _missing_required {
    my $field = shift;
    warn "Missing required field '$field'!\n";
    pod2usage();
}