package MooseX::Attribute::ENV;
+use Moose::Role;
+
+our $VERSION = "0.03";
+our $AUTHORITY = 'cpan:JJNAPIORK';
=head1 NAME
MooseX::Attribute::ENV - Set default of an attribute to a value from %ENV
-=head1 VERSION
-
-Version 0.01
-
-=cut
-
-our $VERSION = '0.01';
-
=head1 SYNOPSIS
-The following is example usage for this component.
+The following is example usage for this attribute trait.
- package Myapp::MyClass;
+ package MyApp::MyClass;
use Moose;
use MooseX::Attribute::ENV;
- has 'username' => (traits => ['ENV']);
- has 'password' => (traits => ['ENV'], env_key => 'GLOBAL_PASSWORD');
- has 'last_login' => (traits => ['ENV'], default => sub {localtime} );
+ ## Checks $ENV{username} and $ENV{USERNAME}
+ has 'username' => (
+ traits => ['ENV'],
+ );
+
+ ## Checks $ENV{GLOBAL_PASSWORD}
+ has 'password' => (
+ traits => ['ENV'],
+ env_key => 'GLOBAL_PASSWORD',
+ );
+
+ ## Checks $ENV{last_login}, $ENV{LAST_LOGIN} and then uses the default
+ has 'last_login' => (
+ traits => ['ENV'],
+ default => sub {localtime},
+ );
+
+ ## Checks $ENV{XXX_config_name} and $ENV{XXX_CONFIG_NAME}
+ has 'config_name' => (
+ traits => ['ENV'],
+ env_prefix => 'XXX',
+ );
+
+ ## Checks $ENV{MyApp_MyClass_extra} and $ENV{MYAPP_MYCLASS_EXTRA}
+ has 'extra' => (
+ traits => ['ENV'],
+ env_package_prefix => 1,
+ );
Please see the test cases for more detailed examples.
This is a L<Moose> attribute trait that you use when you want the default value
for an attribute to be populated from the %ENV hash. So, for example if you
-have set the environment variable MYAPP_MYCLASS_USERNAME = 'John' you can do:
+have set the environment variable USERNAME = 'John' you can do:
package MyApp::MyClass;
has 'attr' => (
is=>'ro',
default=> sub {
- $ENV{uc __PACKAGE_.'attr'};
+ $ENV{uc 'attr'};
},
);
but this module has a few other features that offer merit, as well as being a
-simple enough attribute trait that I hope it can serve as a learning tool. It
-also does it's best to respect existing builders, defaults and lazy_build
-options.
+simple enough attribute trait that I hope it can serve as a learning tool.
+
+If the named key isn't found in %ENV, then defaults will execute as normal.
+
+=head1 ATTRIBUTES
+
+This role defines the following attributes.
+
+=head2 env_key ($Str)
+
+By default we look for a key in %ENV based on the actual attribute name. If
+want or need to override this behavior, you can use this modifier.
+
+=cut
+
+has 'env_key' => (
+ is=>'ro',
+ isa=>'Str',
+ predicate=>'has_env_key',
+);
+
+=head2 env_prefix ($Str)
+
+A prefix to attach to the generated filename. The prefix is prepended with a
+trailing underscore. For example, if you attribute was 'attr' and your set a
+prefix of 'xxx' then we'd check for $ENV{xxx_attr} and $ENV{XXX_ATTR}.
+
+=cut
+
+has 'env_prefix' => (
+ is=>'ro',
+ isa=>'Str',
+ predicate=>'has_env_prefix',
+);
+
+=head2 env_package_prefix ($Bool)
+
+Similar to env_prefix, but automatically sets the prefix based on the consuming
+classes package name. So if your attribute is 'attr' and it's in a package
+called: 'Myapp::Myclass' the follow keys in %ENV will be examined:
+
+* Myapp_Myclass_attr
+* MYAPP_MYCLASS_ATTR
+
+Please be aware that if you use this feature, your attribute will automatically
+be converted to lazy, which might effect any default subrefs you also assign to
+this attribute.
+
+Please note that you can't currently use this option along with the option
+'lazy_build'. That might change in a future release, however since these
+attributes are likely to hold simple strings the lazy_build option probably
+won't be missed.
+
+=cut
+
+has 'env_package_prefix' => (
+ is=>'ro',
+ isa=>'Str',
+ predicate=>'has_env_package_prefix',
+);
=head1 METHODS
This module defines the following methods.
+=head2 _process_options
+
+Overload method so that we can assign the default to be what's in %ENV
+
+=cut
+
+around '_process_options' => sub
+{
+ my ($_process_options, $self, $name, $options) = (shift, @_);
+
+ ## get some stuff we need.
+ my $key = $options->{env_key} || $name;
+ my $default = $options->{default};
+ my $use_pp = $options->{env_package_prefix};
+
+ ## Make it lazy if we are using the package prefix option
+ if( defined $use_pp && $use_pp )
+ {
+ $options->{lazy} = 1;
+ }
+
+ ## Prepend any custom prefixes.
+ if($options->{env_prefix})
+ {
+ $key = join('_', ($options->{env_prefix}, $key));
+ }
+
+ ## override/update the default method for this attribute.
+ CHECK_ENV: {
+
+ $options->{default} = sub {
+
+ if(defined $use_pp && $use_pp)
+ {
+ my $class = blessed $_[0];
+ $class =~s/::/_/g;
+
+ $key = join ('_', ($class, $key));
+ }
+
+ ## Wish we could use perl 5.10 given instead :)
+ if(defined $ENV{$key})
+ {
+ return $ENV{$key};
+ }
+ elsif(defined $ENV{uc $key})
+ {
+ return $ENV{uc $key};
+ }
+ elsif(defined $default)
+ {
+ return ref $default eq 'CODE' ? $default->(@_) : $default;
+ }
+
+ return;
+ };
+ }
+
+ $_process_options->($self, $name, $options);
+};
+
=head1 AUTHOR
John Napiorkowski, C<< <jjnapiork at cpan.org> >>
=cut
+## Register the trait so this can be used without verbose invocation.
+package Moose::Meta::Attribute::Custom::Trait::ENV;
+sub register_implementation { 'MooseX::Attribute::ENV' }
+
1;
+++ /dev/null
-use strict;
-use warnings;
-
-BEGIN {
-
- use Test::More;
- use File::Find;
-}
-
-
-=head1 NAME
-
-t/newlines.t - test to make sure all text files are in unix linefeed format
-
-=head1 DESCRIPTION
-
-Descends through the distribution directory and verifies that all text files
-(files with an extention matching a pattern, such as *.txt) are in unix
-linefeed format.
-
-=head1 TESTS
-
-This module defines the following tests.
-
-=head2 Descend Distribution
-
-Starting at the Distribution root, look at all files in all subdirections and
-if the file matches a text type (according to a particular regex for it's
-extension) add it to a files of files to test.
-
-=cut
-
-my @files;
-
- find({
- wanted => \&process,
- follow => 0
- }, '.');
-
-sub process
-{
- my $file = $_;
-
- return if $File::Find::dir =~m/\.svn/;
- return if $File::Find::dir =~m/archive/;
-
- push @files, $File::Find::name
- if $file =~m/\.yml$|\.pm$|\.pod$|\.tt$|\.txt$|\.js$|\.css$|\.sql$|\.html$/;
-}
-
-
-=head2 test linefeedtype
-
-Check if the generated files are correctly unix linefeeds
-
-=cut
-
-my $CR = "\015"; # Apple II family, Mac OS thru version 9
-my $CRLF = "\015\012"; # CP/M, MP/M, DOS, Microsoft Windows
-my $FF = "\014"; # printer form feed
-my $LF = "\012"; # Unix, Linux, Xenix, Mac OS X, BeOS, Amiga
-
-my $test_builder = Test::More->builder;
-
-if( $#files )
-{
- $test_builder->plan(tests => ($#files+1)*2);
-
- foreach my $file (@files)
- {
- ## Get a good filehandle
- open( my $fh, '<', $file)
- or fail "Can't open $file, can't finish testing";
-
- ## Only need to test the first line.
- my ($first, $second) = <$fh>;
-
- ## Don't need this anymore
- close($fh);
-
- SKIP: {
-
- skip "$file is Empty!", 2 unless $first;
-
- ## Are we DOS or MACOS/APPLE?
- ok $first!~m/$CRLF$|$CR$|$FF$/, "$file isn't in a forbidden format";
-
- ## If there is more than one line, we HAVE to be UNIX
-
- SKIP: {
-
- skip "$file only has a single line", 1 unless $second;
- ok $first=~m/$LF$/, "$file Is unix linefeed";
- }
- }
- }
-}
-else
-{
- $test_builder->plan(skip_all => 'No Text Files Found! (This is probably BIG Trouble...');
-}
-
-=head1 AUTHOR
-
-John Napiorkowski, C<< <jjn1056 at yahoo.com> >>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2008 John Napiorkowski.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-
-1;
\ No newline at end of file
--- /dev/null
+
+use warnings;
+use strict;
+use Test::More tests => 9;
+
+ENV_ATTRIBUTES: {
+
+ local %ENV;
+
+ $ENV{test1} = '111';
+ $ENV{test2} = '222';
+ $ENV{'444_test4'} = '444';
+ $ENV{"MooseX_Attribute_ENV_Test_Class_test5"} = 'packagetest';
+
+ {
+ package MooseX::Attribute::ENV::Test::Class;
+
+ use Moose;
+ use MooseX::Attribute::ENV;
+
+ has 'test1' => (
+ traits=>[qw/ENV/],
+ is=>'ro',
+ );
+
+ has 'test1a' => (
+ traits=>[qw/ENV/],
+ env_key=>'test2',
+ is=>'ro',
+ );
+
+ has 'test3' => (
+ traits=>[qw/ENV/],
+ is=>'ro',
+ default=>'333',
+ );
+
+ has 'test3a' => (
+ traits=>[qw/ENV/],
+ env_key=>'test4',
+ is=>'ro',
+ default=>'444',
+ );
+
+ has 'test4' => (
+ traits=>[qw/ENV/],
+ env_prefix=>'444',
+ is=>'ro',
+ );
+
+ has 'test5' => (
+ traits=>[qw/ENV/],
+ env_package_prefix=>1,
+ is=>'ro',
+ );
+
+ has 'test6' => (
+ traits=>[qw/ENV/],
+ env_package_prefix=>1,
+ is=>'ro',
+ default=>sub{
+ return blessed shift;
+ }
+ );
+ }
+
+ ok( my $env = 'MooseX::Attribute::ENV::Test::Class'->new(), "Got a good object");
+ isa_ok( $env, 'MooseX::Attribute::ENV::Test::Class' );
+
+ is $env->test1, 111, "correct value";
+ is $env->test1a, 222, "correct value";
+ is $env->test3, 333, "correct value";
+ is $env->test3a, 444, "correct value";
+ is $env->test4, '444', "correct value";
+ is $env->test5, 'packagetest', "correct value";
+ is $env->test6, 'MooseX::Attribute::ENV::Test::Class', "correct value";
+}
+
+
+
projects / gitmo/MooseX-Attribute-ENV.git / commitdiff