bin/send_tr_reports.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 # $Id: send_tr_reports.pl,v 1.10 2010/09/03 20:48:26 eserte Exp $
   5 # Author: Slaven Rezic
   6 #
   7 # Copyright (C) 2008 Slaven Rezic. All rights reserved.
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the same terms as Perl itself.
  10 #
  11 # Mail: slaven@rezic.de
  12 # WWW:  http://www.rezic.de/eserte/
  13 #
  14
  15 use strict;
  16 use Getopt::Long;
  17 use Test::Reporter;
  18 use Metabase::Resource::cpan::distfile;
  19 use File::Basename;
  20
  21 my $use_mail;
  22 my $opt_transport_uri;
  23 GetOptions("mail"            => \$use_mail,
  24            "transport-uri=s" => \$opt_transport_uri,
  25     )
  26     or die "usage: $0 [--mail] [--transport-uri=TRANSPORT-URI]";
  27
  28 $opt_transport_uri //= 'https://metabase.cpantesters.org/api/v1/';
  29 my $reportdir = shift || "$ENV{HOME}/var/ctr";
  30
  31 my $sync_dir = "$reportdir/sync";
  32 my $done_dir = "$reportdir/done";
  33 my $process_dir = "$reportdir/process";
  34 my $quarantine_dir = "$reportdir/quarantine";
  35
  36 if (!-d $sync_dir) {
  37     warn "Create $sync_dir and move reports to this directory...";
  38 }
  39 for my $dir ($done_dir, $process_dir, $quarantine_dir) {
  40     if (!-d $dir) {
  41         mkdir $dir    or die "While creating $dir: $!";
  42     }
  43 }
  44
  45 my @files = map { $_->[0] }
  46     sort { $b->[1] <=> $a->[1] }
  47     map { [ $_, -M $_ ] }
  48              glob("$sync_dir/pass.*.rpt"),
  49              glob("$sync_dir/unknown.*.rpt"),
  50              glob("$sync_dir/na.*.rpt"),
  51              glob("$sync_dir/fail.*.rpt"),
  52 ;
  53 FILE: for my $filei (0..$#files) {
  54     my $file = $files[$filei];
  55     warn "File $file does not exist anymore?", next if !-r $file;
  56     warn sprintf "[%d/%d;%.4f]%s\n", 1+$filei, scalar @files, -M $file, $file;
  57     my $quarantine_file = $quarantine_dir . "/" . basename($file);
  58     if ($file =~ m|/pass\.-0\.01\.|) {
  59         warn "skipping to avoid a CPAN::DistnameInfo bug (# 72512)";
  60         rename $file, $quarantine_file or die "Could not rename...: $!";
  61         next FILE;
  62     }
  63     {
  64         open my $fh, $file or die "Could not open '$file': $!";
  65         local $/ = "\n";
  66         my $vdistro;
  67         while (<$fh>) {
  68             next unless /X-Test-Reporter-Distfile:\s*(\S+)/;
  69             $vdistro = $1;
  70             last;
  71         }
  72         if ($vdistro) {
  73             my $result = eval { Metabase::Resource::cpan::distfile->_validate_distfile($vdistro) };
  74             unless ($result) {
  75                 warn "skipping to avoid killing the toolchain (see 2012-10-20 in 'upgradeadventures')";
  76                 rename $file, $quarantine_file or die "Could not rename...: $!";
  77                 next FILE;
  78             }
  79         }
  80     }
  81     my $process_file = $process_dir . "/" . basename($file);
  82     rename $file, $process_file
  83         or die "Cannot move $file to $process_file: $!";
  84     my @tr_args;
  85     if ($use_mail) {
  86         die "not supported";
  87         @tr_args = (from => "srezic\@cpan.org",
  88                     transport => "Net::SMTP",
  89                     mx => ["localhost"],
  90                    );
  91     } else {
  92         @tr_args = (transport => 'Metabase',
  93                     transport_args => [
  94                                        uri => $opt_transport_uri,
  95                                        id_file => '/home/sand/.metabase/id.json',
  96                                       ],
  97                    );
  98     }
  99     my $r = Test::Reporter->new(@tr_args)->read($process_file);
 100     # XXX fix t::r bug?
 101     $r->{_subject} =~ s{\n}{}g;
 102     unless ($r->send) {
 103         warn sprintf "Alert: renaming '$process_file' to '$file' for further considerations";
 104         rename $process_file, $file or warn "Could not rename back: $!";
 105         die "Alert: error while running $^X $0 against $file: " . $r->errstr . ". Stop.\n";
 106     }
 107     my $done_file = $done_dir . "/" . basename($file);
 108     rename $process_file, $done_file
 109         or die "Cannot move $process_file to $done_file: $!";
 110 }
 111
 112 __END__
 113
 114 =head1 WORKFLOW
 115
 116 See CPAN/CPAN::Reporter configuration below:
 117
 118 The good (non-fail) reports. On the windows machine
 119
 120     ssh 192.168.1.253
 121     cd /cygdrive/c/Users/eserte/ctr
 122     ls sync/* && echo "sync is not empty" || mv *.rpt sync/
 123     rsync -v -a sync/*.rpt eserte@biokovo:var/ctr/new/ && mv sync/*.rpt done/
 124
 125 On the unix machine
 126
 127     ctr_good_or_invalid.pl
 128     send_tr_reports.pl
 129
 130 Now review the fail reports on the windows machine. Invalid ones move
 131 to the invalid/ subdirectory.
 132
 133 =head1 CPAN::REPORTER CONFIGURATION
 134
 135 In /cygdrive/c/Users/eserte/Documents/.cpanreporter/config.ini:
 136
 137     edit_report=default:no
 138     email_from=srezic@cpan.org
 139     send_report=default:yes
 140     transport=File C:\Users\eserte\ctr
 141
 142 Basically the same configuration can be used for cygwin
 143 ~/.cpanreporter/config.ini, just use the cygwin path style for the
 144 transport directory.
 145
 146     edit_report=default:no
 147     email_from=srezic@cpan.org
 148     send_report=default:yes
 149     transport=File /cygdrive/c/Users/eserte/ctr
 150
 151 =cut
 152