lib/MooseX/Attribute/ENV.pm

   1 package MooseX::Attribute::ENV;
   2
   3 use Moose::Role;
   4
   5 our $VERSION = "0.01";
   6 our $AUTHORITY = 'cpan:JJNAPIORK';
   7
   8 =head1 NAME
   9
  10 MooseX::Attribute::ENV - Set default of an attribute to a value from %ENV
  11
  12 =head1 SYNOPSIS
  13
  14 The following is example usage for this attribute trait.
  15
  16         package MyApp::MyClass;
  17
  18         use Moose;
  19         use MooseX::Attribute::ENV;
  20
  21         ## Checks $ENV{username} and $ENV{USERNAME}
  22         has 'username' => (
  23                 traits => ['ENV'],
  24         );
  25
  26         ## Checks $ENV{GLOBAL_PASSWORD}
  27         has 'password' => (
  28                 traits => ['ENV'],
  29                 env_key => 'GLOBAL_PASSWORD',
  30         );
  31
  32         ## Checks $ENV{last_login}, $ENV{LAST_LOGIN} and then uses the default
  33         has 'last_login' => (
  34                 traits => ['ENV'],
  35                 default => sub {localtime},
  36         );
  37
  38         ## Checks $ENV{XXX_config_name} and $ENV{XXX_CONFIG_NAME}
  39         has 'config_name' => (
  40                 traits => ['ENV'],
  41                 env_prefix => 'XXX',
  42         );
  43
  44         ## Checks $ENV{MyApp_MyClass_extra} and $ENV{MYAPP_MYCLASS_EXTRA}
  45         has 'extra' => (
  46                 traits => ['ENV'],
  47                 env_package_prefix => 1,
  48         );
  49
  50 Please see the test cases for more detailed examples.
  51
  52 =head1 DESCRIPTION
  53
  54 This is a L<Moose> attribute trait that you use when you want the default value
  55 for an attribute to be populated from the %ENV hash.  So, for example if you
  56 have set the environment variable USERNAME = 'John' you can do:
  57
  58         package MyApp::MyClass;
  59
  60         use Moose;
  61         use MooseX::Attribute::ENV;
  62
  63         has 'username' => (is=>'ro', traits=>['ENV']);
  64
  65         package main;
  66
  67         my $myclass = MyApp::MyClass->new();
  68
  69         print $myclass->username; # STDOUT => 'John';
  70
  71 This is basically similar functionality to something like:
  72
  73         has 'attr' => (
  74                 is=>'ro',
  75                 default=> sub {
  76                         $ENV{uc 'attr'};
  77                 },
  78         );
  79
  80 but this module has a few other features that offer merit, as well as being a
  81 simple enough attribute trait that I hope it can serve as a learning tool.
  82
  83 If the named key isn't found in %ENV, then defaults will execute as normal.
  84
  85 =head1 ATTRIBUTES
  86
  87 This role defines the following attributes.
  88
  89 =head2 env_key ($Str)
  90
  91 By default we look for a key in %ENV based on the actual attribute name.  If
  92 want or need to override this behavior, you can use this modifier.
  93
  94 =cut
  95
  96 has 'env_key' => (
  97         is=>'ro',
  98         isa=>'Str',
  99         predicate=>'has_env_key',
 100 );
 101
 102 =head2 env_prefix ($Str)
 103
 104 A prefix to attach to the generated filename.  The prefix is prepended with a
 105 trailing underscore. For example, if you attribute was 'attr' and your set a
 106 prefix of 'xxx' then we'd check for $ENV{xxx_attr} and $ENV{XXX_ATTR}.
 107
 108 =cut
 109
 110 has 'env_prefix' => (
 111         is=>'ro',
 112         isa=>'Str',
 113         predicate=>'has_env_prefix',
 114 );
 115
 116 =head2 env_package_prefix ($Bool)
 117
 118 Similar to env_prefix, but automatically sets the prefix based on the consuming
 119 classes package name.  So if your attribute is 'attr' and it's in a package
 120 called: 'Myapp::Myclass' the follow keys in %ENV will be examined:
 121
 122 * Myapp_Myclass_attr
 123 * MYAPP_MYCLASS_ATTR
 124
 125 Please be aware that if you use this feature, your attribute will automatically
 126 be converted to lazy, which might effect any default subrefs you also assign to
 127 this attribute.
 128
 129 Please note that you can't currently use this option along with the option
 130 'lazy_build'.  That might change in a future release, however since these
 131 attributes are likely to hold simple strings the lazy_build option probably
 132 won't be missed.
 133
 134 =cut
 135
 136 has 'env_package_prefix' => (
 137         is=>'ro',
 138         isa=>'Str',
 139         predicate=>'has_env_package_prefix',
 140 );
 141
 142 =head1 METHODS
 143
 144 This module defines the following methods.
 145
 146 =head2 _process_options
 147
 148 Overload method so that we can assign the default to be what's in %ENV
 149
 150 =cut
 151
 152 around '_process_options' => sub
 153 {
 154     my ($_process_options, $self, $name, $options) = (shift, @_);
 155
 156     ## get some stuff we need.
 157         my $key = $options->{env_key} || $name;
 158         my $default = $options->{default};
 159         my $use_pp = $options->{env_package_prefix};
 160
 161         ## Make it lazy if we are using the package prefix option
 162         if( defined $use_pp && $use_pp )
 163         {
 164                 $options->{lazy} = 1;
 165         }
 166
 167         ## Prepend any custom prefixes.
 168         if($options->{env_prefix})
 169         {
 170                 $key = join('_', ($options->{env_prefix}, $key));
 171         }
 172
 173         ## override/update the default method for this attribute.
 174         CHECK_ENV: {
 175
 176                 $options->{default} = sub {
 177
 178                         if(defined $use_pp && $use_pp)
 179                         {
 180                                 my $class = blessed $_[0];
 181                                 $class =~s/::/_/g;
 182
 183                                 $key = join ('_', ($class, $key));
 184                         }
 185
 186                         ## Wish we could use perl 5.10 given instead :)
 187                         if(defined $ENV{$key})
 188                         {
 189                                 return $ENV{$key};
 190                         }
 191                         elsif(defined $ENV{uc $key})
 192                         {
 193                                 return $ENV{uc $key};
 194                         }
 195                         elsif(defined $default)
 196                         {
 197                                 return ref $default eq 'CODE' ? $default->(@_) : $default;
 198                         }
 199
 200                         return;
 201                 };
 202         }
 203
 204     $_process_options->($self, $name, $options);
 205 };
 206
 207 =head1 AUTHOR
 208
 209 John Napiorkowski, C<< <jjnapiork at cpan.org> >>
 210
 211 =head1 BUGS
 212
 213 Please report any bugs or feature requests to:
 214
 215         C<MooseX-Attribute-ENV at rt.cpan.org>
 216
 217 or through the web interface at:
 218
 219         L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Attribute-ENV>
 220
 221 I will be notified, and then you'll automatically be notified of progress on
 222 your bug as I make changes.
 223
 224 =head1 SUPPORT
 225
 226 You can find documentation for this module with the perldoc command.
 227
 228     perldoc MooseX::Attribute::ENV
 229
 230 You can also look for information at:
 231
 232 =over 4
 233
 234 =item * RT: CPAN's request tracker
 235
 236 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Attribute-ENV>
 237
 238 =item * AnnoCPAN: Annotated CPAN documentation
 239
 240 L<http://annocpan.org/dist/MooseX-Attribute-ENV>
 241
 242 =item * CPAN Ratings
 243
 244 L<http://cpanratings.perl.org/d/MooseX-Attribute-ENV>
 245
 246 =item * Search CPAN
 247
 248 L<http://search.cpan.org/dist/DBIx-Class-PopulateMore>
 249
 250 =back
 251
 252 =head1 LICENSE
 253
 254 This program is free software; you can redistribute it and/or modify it
 255 under the same terms as Perl itself.
 256
 257 =cut
 258
 259 ## Register the trait so this can be used without verbose invocation.
 260 package Moose::Meta::Attribute::Custom::Trait::ENV;
 261 sub register_implementation { 'MooseX::Attribute::ENV' }
 262
 263 1;