#
#=============================================================================
#
# DESCRIPTION: checks HARNESS_ACTIVE and is_in_production_mode and reroutes
# away from 'live only' code that we dont want to run in test or dev mode.
# names will clash so be careful using this module. suggest using subs with
# names prefixed with _live_. eg. _live_sendmail. if HARNESS_ACTIVE
# then runs _test_live_sendmail if not is_in_production_mode then runs
# _dev_live_sendmail
#
# set production and testing parameters for role to override real settings and
# test live code
#===============================================================================
package LIMS::Local::Role::NotTestable;
use Modern::Perl;
use utf8;
use LIMS::Local::Config;
use B 'svref_2object';
use Moose::Role;
use MooseX::Role::Parameterized;
use namespace::autoclean;
# could use
# my %args = @_
# $args{consumer}->get_all_method_names (Class::MOP::Class) and grep for
# methods with leading _live_ instead of passing them as 'unsafe' parameters
my $config = LIMS::Local::Config->instance;
my $production_mode = $config->{settings}->{is_in_production_mode};
parameter 'unsafe' => ( isa => 'ArrayRef' );
parameter 'production' => ( isa => 'Int', default => $production_mode );
parameter 'testing' => (
isa => 'Int',
default => sub { $ENV{HARNESS_ACTIVE} // $ENV{TESTING} // 0 }
);
role {
my $p = shift;
around $_ => sub {
my $orig = shift;
my $self = shift;
# running live
if ( $p->production and not $p->testing ) {
return $orig->( $self, @_ );
}
else {
# get $orig name
my $subroutine_name = svref_2object($orig)->GV->NAME;
warn "$subroutine_name() only runs in production mode";
# not testing
if ( not $p->testing ) {
my $dev = $self->can("_dev$subroutine_name");
return $dev->( $self, @_ ) if $dev;
}
# testing
my $test = $self->can("_testing$subroutine_name");
return $test->( $self, @_ ) if $test;
}
}
for @{ $p->unsafe };
};
1;
__END__
=head1 NAME
LIMS::Local::Role::NotTestable
=head1 VERSION
This documentation refers to LIMS::Local::Role::NotTestable version 0.1
=head1 SYNOPSIS
with 'LIMS::Local::Role::NotTestable' => { unsafe => [qw/_live_sub another_sub/] };
=over 4
=item C<sub _live_sub { ... }>
=item C<sub _testing_live_sub { ... }>
=item C<sub _dev_live_sub { ... }>
=back
=head1 DESCRIPTION
Moose Role which given a list of methods from consuming class, wraps them in
an around method modifier and only runs original method if not testing or developing
Testing is defined as:
=over 4
=item HARNESS_TEST is set (this is set when you run C<prove>
=item TESTING environment variable is set
=back
Developing is defined as:
=over 4
=item is_in_production_mode is configured
=back
Otherwise the method is replaced with a test method if available.
=head1 CONFIGURATION AND ENVIRONMENT
relys on two settings:
=over 2
=item C<prove>
sets B<HARNESS_ACTIVE>
=item or manually set testing mode
C<TESTING=1 ./script_name.pl>
=item config/settings/<centre>.txt
set B<is_in_production_mode=1>
=back
=head1 DEPENDENCIES
MooseX::Role::Parameterized
=head1 INCOMPATIBILITIES
As yet not fully tested. This module was written to replace previous system
using attributes to mark code that needed protecting from running under test
environments but was incompatable with Test::Class::Moose and
CGI::Application::Plugin::Autorun
=head1 BUGS AND LIMITATIONS
There are no known bugs in this module.
Please report problems to Garry Quested (garry.quested@nhs.net)
Patches are welcome.
=head1 AUTHOR
Garry Quested (garry.quested@nhs.net)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2017 Garry Quested (<garry.quested@nhs.net>). All rights
reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
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.