File Coverage

blib/lib/Scientist.pm
Criterion Covered Total %
statement 52 52 100.0
branch 16 16 100.0
condition n/a
subroutine 12 12 100.0
pod 4 4 100.0
total 84 84 100.0


line stmt bran cond sub pod time code
1             package Scientist;
2              
3             # Explicitly enabling strict and warnings, despite Moo doing this also
4             # for two reasons, A) to make perlcritic pass and B) in case we change
5             # modules later to use soemthing else. Suggestions welcomed though.
6 8     8   1387966 use strict;
  8         49  
  8         182  
7 8     8   32 use warnings;
  8         11  
  8         252  
8              
9             our $VERSION = '0.012'; # VERSION
10              
11 8     8   3459 use Moo;
  8         71644  
  8         34  
12 8     8   9303 use Test2::Compare qw/compare strict_convert/;
  8         13  
  8         329  
13 8     8   3384 use Time::HiRes qw/time/;
  8         8970  
  8         29  
14 8     8   4926 use Types::Standard qw/Bool Str CodeRef HashRef/;
  8         472297  
  8         67  
15              
16             # ABSTRACT: Perl module inspired by https://github.com/github/scientist
17             # https://github.com/lancew/Scientist
18              
19             has 'context' => (
20             is => 'rw',
21             isa => HashRef,
22             );
23              
24             has 'enabled' => (
25             is => 'rw',
26             isa => Bool,
27             default => 1,
28             );
29              
30             has 'experiment' => (
31             is => 'ro',
32             isa => Str,
33             builder => 'name',
34             );
35              
36             has 'use' => (
37             is => 'rw',
38             isa => CodeRef,
39             );
40              
41             has 'result' => (
42             is => 'rw',
43             isa => HashRef,
44             );
45              
46             has 'try' => (
47             is => 'rw',
48             isa => CodeRef,
49             );
50              
51             sub name {
52 13     13 1 55396 return 'experiment';
53             }
54              
55             sub publish {
56 1009     1009 1 1100 my $self = shift;
57             # Stub publish sub, extend this to enable your own own
58             # unique publishing requirements
59 1009         1090 return;
60             }
61              
62             sub run {
63 1014     1014 1 4392 my $self = shift;
64              
65             # If experiment not enabled just return the control code results.
66 1014 100       13411 return $self->use->() unless $self->enabled;
67              
68 1011         27865 my %result = (
69             context => $self->context,
70             experiment => $self->experiment,
71             );
72              
73 1011         5704 my $wantarray = wantarray;
74              
75 1011         1083 my ( @control, @candidate );
76             my $run_control = sub {
77 1011     1011   1452 my $start = time;
78 1011 100       12580 @control = $wantarray ? $self->use->() : scalar $self->use->();
79 1010         6820 $result{control}{duration} = time - $start;
80 1011         11649 };
81              
82             my $run_candidate = sub {
83 1011     1011   1480 my $start = time;
84             @candidate = $wantarray
85 1         13 ? eval { $self->try->() }
86 1011 100       1484 : eval { scalar $self->try->() };
  1010         12348  
87 1011         7204 $result{candidate}{duration} = time - $start;
88 1011         2002 };
89              
90 1011 100       1961 if ( rand > 0.5 ) {
91 488         870 $run_control->();
92 488         662 $run_candidate->();
93             }
94             else {
95 523         887 $run_candidate->();
96 523         663 $run_control->();
97             }
98              
99 1010         2292 my $delta = compare(\@candidate, \@control, \&strict_convert);
100 1010 100       209924 my $diag = join "\n", $delta ? $delta->table : ();
101              
102 1010         30885 $result{matched} = $diag eq '';
103 1010         1506 $result{mismatched} = $diag ne '';
104              
105             $result{observation} = {
106 1010 100       2864 candidate => $wantarray ? @candidate : $candidate[0],
    100          
107             control => $wantarray ? @control : $control[0],
108             diagnostic => $diag,
109             };
110              
111 1010         16716 $self->result( \%result );
112 1010         20429 $self->publish;
113              
114 1009 100       5035 return $wantarray ? @control : $control[0];
115             }
116              
117             # Use better column header names in the observation diagnostic table.
118             sub BUILD {
119 15     15 1 10601 Test2::Compare::Delta->set_column_alias(GOT => 'CONTROL');
120 15         152 Test2::Compare::Delta->set_column_alias(CHECK => 'CANDIDATE');
121 15         136 return;
122             }
123              
124             1;
125              
126             =head1 LICENSE
127              
128             This software is Copyright (c) 2016 by Lance Wicks.
129              
130             This is free software, licensed under:
131              
132             The MIT (X11) License
133              
134             The MIT License
135              
136             Permission is hereby granted, free of charge, to any person
137             obtaining a copy of this software and associated
138             documentation files (the "Software"), to deal in the Software
139             without restriction, including without limitation the rights to
140             use, copy, modify, merge, publish, distribute, sublicense,
141             and/or sell copies of the Software, and to permit persons to
142             whom the Software is furnished to do so, subject to the
143             following conditions:
144              
145             The above copyright notice and this permission notice shall
146             be included in all copies or substantial portions of the
147             Software.
148              
149             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT
150             WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
151             INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
152             MERCHANTABILITY, FITNESS FOR A PARTICULAR
153             PURPOSE AND NONINFRINGEMENT. IN NO EVENT
154             SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
155             LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
156             LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
157             TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
158             CONNECTION WITH THE SOFTWARE OR THE USE OR
159             OTHER DEALINGS IN THE SOFTWARE.