From: John Napiorkowski Date: Sun, 8 Jun 2008 02:31:51 +0000 (+0000) Subject: first version ready for release X-Git-Tag: 0.02~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Attribute-ENV.git;a=commitdiff_plain;h=ce989a700adaf9ecb1737aa3c1894d88b1c440ee first version ready for release --- diff --git a/Changes b/Changes index 53e25f5..7ca334a 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,5 @@ Revision history for Perl extension MooseX-Attribute-ENV. -0.01 Tues, 05 June 2008 - - Initial release +0.01 07 June 2008 + - Setup repository, created application skeleton + - Created tests, released. diff --git a/Makefile.PL b/Makefile.PL index 7e338af..23c6a74 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -8,7 +8,6 @@ author 'John Napiorkowski '; requires 'Moose' => '0.48'; build_requires 'Test::More'; -build_requires 'File::Find'; auto_install; diff --git a/lib/MooseX/Attribute/ENV.pm b/lib/MooseX/Attribute/ENV.pm index cbfd96f..850c6ed 100644 --- a/lib/MooseX/Attribute/ENV.pm +++ b/lib/MooseX/Attribute/ENV.pm @@ -1,30 +1,51 @@ 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. @@ -32,7 +53,7 @@ Please see the test cases for more detailed examples. This is a L 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; @@ -52,19 +73,137 @@ This is basically similar functionality to something like: 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<< >> @@ -117,4 +256,8 @@ under the same terms as Perl itself. =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; diff --git a/t-author/newlines.t b/t-author/newlines.t deleted file mode 100644 index 9264562..0000000 --- a/t-author/newlines.t +++ /dev/null @@ -1,117 +0,0 @@ -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<< >> - -=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 diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100755 index 0000000..32ae0bd --- /dev/null +++ b/t/01-basic.t @@ -0,0 +1,80 @@ + +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"; +} + + +