lib/SGN/Role/Site/TestMode.pm

   1 =head1 NAME
   2
   3 SGN::Role::Site::TestMode - adds the concept of 'test mode' to a site
   4
   5 =cut
   6
   7 package SGN::Role::Site::TestMode;
   8
   9 use Moose::Role;
  10 use namespace::autoclean;
  11
  12 use Carp;
  13 use File::Spec;
  14
  15 use Data::Visitor::Callback;
  16
  17 requires 'config', 'path_to', 'finalize_config';
  18
  19 after 'finalize_config' => \&_reroot_test_mode_files;
  20
  21 =head1 DESCRIPTION
  22
  23 This role requires that Catalyst::Plugin::ConfigLoader (or other
  24 plugin providing finalize_config) be activated.
  25
  26 It does two things: adds a C<test_mode> attribute, and reroots
  27 paths to files and directories in the global configuration if the app
  28 is in test mode.
  29
  30 =head1 METHODS
  31
  32 =head2 test_mode
  33
  34 read-only sub, boolean telling whether the site is now running in
  35 test mode.
  36
  37 By default, this attribute is true if either the MYAPP_TEST_MODE
  38 environment variable is set to a true value, or if
  39 $c->config->{test_mode} is true.
  40
  41 =cut
  42
  43 sub test_mode {
  44     my $c = shift;
  45     my $app_name = ref($c) || $c;
  46     my $env_name = uc($app_name).'_TEST_MODE';
  47     return _env($c)->{$env_name} || ref($c) && $c->config->{test_mode};
  48 }
  49 sub _env {
  50     my ( $c ) = @_;
  51     return ref($c) && $c->engine->can('env') && $c->engine->env ? $c->engine->env : \%ENV;
  52 }
  53
  54
  55 =head1 CONFIGURATION PATH REROOTING
  56
  57 At load time, if the app is running in test mode, this role will
  58 reroot paths in the global configuration to point into a tree of test
  59 data instead of wherever they were pointing before.
  60
  61 Example configuration:
  62
  63     MyApp->config(
  64
  65       # TestMode configuration
  66       'Plugin::Site::TestMode' => {
  67           reroot_conf    => [ 'foo', 'bar/baz' ],
  68           test_data_dir => '__path_to(t/data)__',
  69       },
  70
  71       # other conf data
  72       foo => 'my/relative/path',
  73       bar => {
  74          quux => '/some/path',
  75          baz  => '/absolute/path',
  76       }
  77     )
  78
  79 This configuration, if MYAPP_TEST_MODE is set, will be rerootd by the
  80 TestMode plugin into:
  81
  82     MyApp->config(
  83
  84       # TestMode configuration
  85       'Plugin::Site::TestMode' => {
  86           reroot_conf    => [ 'foo', 'bar/baz' ],
  87           test_data_dir => '__path_to(t/data)__',
  88       },
  89
  90       # other conf data
  91       foo => 't/data/my/relative/path',
  92       bar => {
  93          quux => '/some/path',
  94          baz  => '/path/to/myapp/t/data/absolute/path',
  95       }
  96     )
  97
  98
  99 This is controlled by the C<reroot_conf> and C<test_data_dir>
 100 configuration variables.  C<reroot_conf> takes an arrayref of conf
 101 variable names to reroot as if they were path names (using a
 102 /-separated syntax to denote non-top-level conf variables), and
 103 C<test_data_dir> takes the absolute path to the directory in which the
 104 test data file tree resides.
 105
 106 Note that relative paths are kept relative, and assumed to be intended
 107 as relative to the site's home directory.  You cannot currently reroot
 108 a relative path unless it is relative to the site home directory.
 109
 110 Additionally, you can force a rerooted conf var to be treated as either
 111 absolute or relative by adding a prefix of either C<(abs)> or C<(rel)>
 112 to the beginning of the conf name.
 113
 114 =cut
 115
 116 ########### helper subs #######
 117
 118 # if in test mode, filter conf variables, if
 119 sub _reroot_test_mode_files {
 120     my $c = shift;
 121
 122     return unless $c->test_mode;
 123
 124     my $filter_conf_keys = $c->config->{'Plugin::TestMode'}->{reroot_conf}
 125         or return;
 126
 127
 128     # parse any (rel) or (abs) declarations on the conf keys
 129     $filter_conf_keys = [
 130         map {
 131             [ m/^ (\( (?:abs|rel) \))? (.+)/x ]
 132         } @$filter_conf_keys
 133     ];
 134
 135     my $test_files_path_abs = $c->config->{'Plugin::TestMode'}->{test_data_dir};
 136     my $test_files_path_rel = File::Spec->abs2rel( $test_files_path_abs, $c->path_to );
 137
 138     for my $key_rec ( @$filter_conf_keys ) {
 139         my ( $prefix, $path ) = @$key_rec;
 140
 141         my ( $conf, $varname ) = $c->_resolve_conf_key_path( $path );
 142         next unless $conf && $conf->{$varname};
 143
 144         my $test_mode_applyer = Data::Visitor::Callback->new(
 145             plain_value => sub {
 146                 my $force_abs = $prefix && $prefix eq '(abs)';
 147                 my $force_rel = $prefix && $prefix eq '(rel)';
 148
 149                 if( $force_rel || !File::Spec->file_name_is_absolute( $_ ) ) {
 150                     if( $force_rel and my $leading_slash = m!^/! ) {
 151                         $_ = "/$test_files_path_rel$_";
 152                     } else {
 153                         $_ = File::Spec->catfile( $test_files_path_rel, $_ );
 154                     }
 155                 }
 156                 else {
 157                     $_ = File::Spec->catfile( $test_files_path_abs, File::Spec->abs2rel( $_, File::Spec->rootdir)  );
 158                 }
 159             },
 160            );
 161         $test_mode_applyer->visit( $conf->{$varname} )
 162     }
 163 }
 164
 165 # takes a path expression into the conf like
 166 # 'Plugin::ConfigLoader/blah_blah' and finds the parent hashref that
 167 # holds that conf key, and the conf key itself
 168 sub _resolve_conf_key_path {
 169     my ( $c, $path_expr ) = @_;
 170
 171     my @path_components = split /\//, $path_expr;
 172     # no leading blanks
 173     shift @path_components while @path_components && !$path_components[0];
 174
 175     my $path_end = pop @path_components;
 176     my $parent = $c->config;
 177     $parent = $parent->{ shift @path_components } while $parent && @path_components;
 178     return ( $parent, $path_end );
 179 }
 180
 181
 182 1;