• Files
• Commits
• Log
• Graph
• Stats

#
#===============================================================================
#
#  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::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 => $ENV{HARNESS_ACTIVE});

role {
    my $p = shift;
    around $_ => sub {
        my $orig = shift;
        my $self = shift;
        # running live

$DB::single = 1; # for perl -d
        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::NotTestable

=head1 VERSION

This documentation refers to LIMS::Local::NotTestable version 0.1

=head1 SYNOPSIS

with 'LIMS::Local::NotTestable' => { unsafe => [qw/_live_noop noop2/] };

=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 HARNESS_TEST is not set
and is_in_production_mode is configured.

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 config/settings/<centre>.txt

sets B<is_in_production_mode>

=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.