tools/chimps-client.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use FindBin;
   6 use lib "$FindBin::Bin/../lib";
   7
   8 use Config;
   9 use File::Spec;
  10 use Test::Chimps::Client;
  11 use Test::TAP::Model::Visual;
  12
  13 chdir "$FindBin::Bin/..";
  14
  15 my @tests = map glob, qw(t/*.t);
  16 my $start = time;
  17 my $model = Test::TAP::Model::Visual->new_with_tests(@tests);
  18
  19 my $client = Test::Chimps::Client->new(
  20     server => 'http://dev.socklabs.com/cgi-bin/chimps-server.pl',
  21     model  => $model,
  22     report_variables => {
  23         archname  => $Config{archname},
  24         committer => $ENV{USER} || $ENV{USERNAME},
  25         osname    => $Config{osname},
  26         osvers    => $Config{osvers},
  27         project   => 'Test-NoTabs',
  28         duration  => time - $start,
  29         revision  => get_revision(),
  30     },
  31 );
  32
  33 my ($status, $msg) = $client->send;
  34 if (! $status) {
  35     print "Error: $msg\n";
  36     exit(1);
  37 }
  38
  39 sub get_revision {
  40     return
  41         # extract_revision('svk', 'svk info', qr/Mirrored From: .*Rev\. (\d+)/) ||
  42         extract_revision('svn', 'svn info', qr/Revision: (\d+)/) ||
  43         extract_svn_revision('.svn/entries') ||
  44        'unknown';
  45 }
  46
  47 sub extract_revision {
  48     my($cmd, $command, $re) = @_;
  49
  50     return unless has_command($cmd);
  51
  52     my $out = qx($command) or return;
  53     $out =~ /$re/;
  54     return $1;
  55 }
  56
  57 sub has_command {
  58     my $cmd = shift;
  59     grep { -e File::Spec->catfile($_, $cmd) } split /:/, $ENV{PATH};
  60 }
  61
  62 sub extract_svn_revision {
  63     my $file = shift;
  64     open my($fh), $file or return;
  65     while (<$fh>) {
  66         /revision="(\d+)"/ and return $1;
  67     }
  68     return;
  69 }