File Coverage

blib/lib/Test/Smoke/App/RepostFromArchive.pm

Criterion	Covered	Total	%
statement	45	73	61.6
branch	6	20	30.0
condition	1	5	20.0
subroutine	9	10	90.0
pod	2	2	100.0
total	63	110	57.2

package Test::Smoke::App::RepostFromArchive;
use warnings;
use strict;

our $VERSION = '0.002';

use base 'Test::Smoke::App::Base';

use File::Spec::Functions qw(catfile curdir);
use Test::Smoke::Poster;
use POSIX qw(strftime);

=head1 NAME

Test::Smoke::App::RepostFromArchive - The tsrepostjsn.pl application.

=head1 SYNOPSIS

Interactive:

   $ tsrepostjsn.pl -c smokecurrent
    Show the last 10 reports:
      1 jsn7a29e8d2c80588346422b4b6b936e6f8b56a3af4.jsn (2022-09-04 05:16:49 +0200)
      2 jsn69bc7167fa24b1e8d3f810ce465d84bdddf413f6.jsn (2022-09-03 05:15:11 +0200)
      3 jsncd55125d69f5f698ef7cbdd650cda7d2e59fc388.jsn (2022-09-02 05:14:42 +0200)
      4 jsn0c33882a943825845dde164b60900bf224b131cc.jsn (2022-09-01 05:15:05 +0200)
      5 jsnb885e42dc2078e29df142cfcefaa86725199d15b.jsn (2022-08-31 05:15:16 +0200)
      6 jsne772cf349a3609ba583f441d10e1e92c5e338377.jsn (2022-08-30 05:15:01 +0200)
      7 jsnf603e191e0bea582034a16f05909a56bcc05a564.jsn (2022-08-29 05:15:14 +0200)
      8 jsn51634b463845a03d4f22b9d23f6c5e2fb98af9c8.jsn (2022-08-28 05:15:47 +0200)
      9 jsn305697f3995f7ddfba2e200c5deb2e274e1136c0.jsn (2022-08-27 05:15:34 +0200)
     10 jsn18fa8a6f818cbe2838cfe9b1bfa0c5d9c311930c.jsn (2022-08-26 05:15:41 +0200)
   Type the numbers (with white space inbetween): 1 2 3

Or direct:

    $ tsrepostjsn.pl -c smokecurrent --sha 7a29e8d2c8058 --sha 69bc7167fa2 --sha cd55125d69f5f698ef7cbdd6

=head1 OPTIONS

  --max-reports      Number of reports to choose from (10)

  --sha       Commit SHA for the smoke (repeat for more reports)

  --jsonreport  The actual json-file to re-post

Override the config:

  --adir          Archive directory
  --smokedb_url   Where to POST to for CoreSmokeDB
  --poster     Use another poster

=head1 DESCRIPTION

=head2 Test::Smoke::App::RepostFromArchive->new()

Creates a new attribute C of class L.

=cut

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->{_poster} = Test::Smoke::Poster->new(
        $self->option('poster') => $self->options,

        # We will need to fake 'ddir' in order to get the reports from the
        # archive
        ddir => $self->option('adir'),
        v    => $self->option('verbose'),
    );

    return $self;
}

=head2 $reposter->run()

Get a list of C<< jsn.jsn >> filenames from the C archive
directory an try to send them to the report server at C again.

=cut

sub run {
    my $self = shift;

    my @to_post = $self->pick_reports();
    for my $report (@to_post) {
        $self->log_info("Reposting '%s' to %s\n", $report, $self->option('smokedb_url'));
        $self->poster->jsnfile($report);
        my $id = $self->poster->post($report);
        $self->log_info("Report posted with id: %s", $id || "");
    }
}

=head2 $reposter->pick_reports()

First checks for reports passed on the command line with C<< --sha
>>.  If none were passed it fetches the latest reports C<--max-reports> from the
archive directory C and lets you pick 1 or more.

=head3 Returns

A list of filenames representing the json files from the archive.

=cut

sub pick_reports {
    my $self = shift;

    if (my $jsonreport = $self->option('jsonreport')) {
        die("Cannot find '$jsonreport'") unless -f $jsonreport;
        if ($jsonreport =~ m{^ / }x) {
            $self->poster->ddir('');
        }
        else {
            $self->poster->ddir(curdir());
        }
        return ($jsonreport);
    }

    my $entries = $self->fetch_jsn_from_archive;
    my $max_entries = scalar(keys %$entries);

    my $commits = $self->option('commit_sha');
    if (@$commits) {
        # tranlate (partial) sha into filenames
        my @reports;
        for my $commit (@$commits) {
            my @candidates = grep { $_ =~ m{^ jsn $commit [0-9a-f]* \.jsn $}x } keys %$entries;
            push @reports, $candidates[0] if @candidates;
        }
        return @reports;
    }

    my $max = $self->option('max_reports');
    $max > $max_entries and $max = $max_entries;

    my @short_list = (
        sort {
            $entries->{$b}{mtime} <=> $entries->{$a}{mtime}
        } keys %$entries
    )[0..$max - 1];

    $max = @short_list;
    my @reports;
    printf "Show the last %u reports:\n", $max;
    for my $cnt (1..$max) {
        printf
            "%3u %-35s (%s)\n",
            $cnt, $short_list[$cnt - 1],
            strftime(
                "%Y-%m-%d %H:%M:%S %z",
                localtime($entries->{ $short_list[$cnt - 1] }{mtime})
            );
    }
    print "Type the numbers (with white space inbetween): ";
    chomp(my $input = );
    my @picks = grep { m{^ [0-9]+ $}x && $_ >= 1 && $_ <= $max } split(" ", $input);
    for my $pick (@picks) {
        push @reports, $short_list[$pick - 1];
    }
    return @reports;
}

sub fetch_jsn_from_archive {
    my $self = shift;

    my %entries;
    my $adir = $self->option('adir');
    opendir(my $dh, $adir) or die "Cannot opendir($adir): $!";
    while (my $entry = readdir($dh)) {
        my $fn = catfile($adir, $entry);
        next unless -f $fn;
        next unless $entry =~ m{^ jsn [0-9a-f]+ \.jsn $}x;
        $entries{$entry} = {
            mtime     => (stat $fn)[9],
            fullname  => $fn,
        };
    }
    closedir($dh);

    return \%entries;
}

1;

=head1 COPYRIGHT

E 2002-2022, Abe Timmerman  All rights reserved.

With contributions from Jarkko Hietaniemi, Merijn Brand, Campo
Weijerman, Alan Burlison, Allen Smith, Alain Barbet, Dominic Dunlop,
Rich Rauenzahn, David Cantrell.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See:

=over 4

=item * L

=item * L

=back

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut