view release on metacpan or  search on metacpan

Fallback.pm  view on Meta::CPAN

package Test::Reporter::Transport::Metabase::Fallback;

# $Id: Fallback.pm 54 2018-01-25 02:06:01Z stro $

use strict;
use warnings;
use parent 'Test::Reporter::Transport';

use Carp;
use Test::Reporter;
use Test::Reporter::Transport::File;
use Test::Reporter::Transport::Metabase;

our $MAX_FILES = 25;

BEGIN {
  $Test::Reporter::Transport::Metabase::Fallback::VERSION = '1.001';
}

my @metabase_required_args = ( 'uri', 'id_file' );
my @metabase_allowed_args  = ( 'client', @metabase_required_args );
my @file_allowed_args      = ( 'File' );
my @this_allowed_args      = ( 'max_files' );

sub new {
    my $class = shift;

    Carp::confess __PACKAGE__ . " requires transport args in key/value pairs\n" if @_ % 2;
    my %args = @_;

    foreach my $k ( @metabase_required_args ) {
        Carp::confess __PACKAGE__ . " requires $k argument\n" unless exists $args{$k};
    }

    foreach my $k ( keys %args ) {
        Carp::confess __PACKAGE__ . " unknown argument '$k'\n" unless grep { $k eq $_ } @metabase_allowed_args, @file_allowed_args, @this_allowed_args;
    }

    unless ($args{'File'}) {
        require CPAN::Reporter::Config;
        $args{'File'} = CPAN::Reporter::Config::_get_config_dir();
    }

    $args{'__file'} = Test::Reporter::Transport::File->new( $args{'File'} );

    $args{'__metabase'} = Test::Reporter::Transport::Metabase->new( map { $_ => $args{$_} } grep { $args{$_} } @metabase_allowed_args );

    $args{'max_files'} = $MAX_FILES unless $args{'max_files'};

    return bless \%args => $class;
}


sub send {
    my ($self, $report) = @_;

    my @errors;

    # Try Metabase
    if (my $rv_m = eval { $self->{'__metabase'}->send($report) } ) {
        # Metabase seems working, let's see if we have some files queued
        if (opendir(my $DIR => $self->{'File'})) {
            my @files = map { File::Spec->catfile($self->{'File'}, $_) } grep { /\.rpt/ } readdir $DIR;
            closedir $DIR;
            foreach my $file (splice(@files, 0, $self->{'max_files'})) {
                my $tr = Test::Reporter->new(
                    'transport' => 'Metabase',
                    'transport_args' => [
                        map { $_ => $self->{$_} } grep { $self->{$_} } @metabase_allowed_args
                    ],
                )->read( $file );
                print __PACKAGE__ . ': sending queued report ' . $file . "\n";
                if ($tr and $tr->send()) {
                    unlink $file;
                    sleep 1; # Don't try to hammer the Metabase
                } else {
                    print __PACKAGE__ . ': cannot submit the file to Metabase, stop queue processing.' . "\n";
                    # Cannot send file to Metabase. Let's stop.
                    last;
                }
            }
        }
    } else {
        push @errors, __PACKAGE__ . ' Metabase error: ' . $@,
                      __PACKAGE__ . ' Saving report in the queue.';

        # Try File
        my $rv_f;
        unless ($rv_f = eval { $self->{'__file'}->send($report) }) {
            push @errors, __PACKAGE__ . ' File error: ' . $@;
        }

        Carp::carp join("\n", @errors, '') if @errors;

        return $rv_f;
    }

    return 1;
}

1;

# ABSTRACT: Metabase transport for Test::Reporter with fallback to File transport

=head1 NAME

Test::Reporter::Transport::Metabase::Fallback

=head1 SYNOPSIS