# #============================================================================= # # 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 =item C =item C =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 =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 sets B =item or manually set testing mode C =item config/settings/.txt set B =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 (). 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. 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.