From: Karen Etheridge Date: Sun, 3 Feb 2013 01:09:47 +0000 (-0800) Subject: support for _get_default_configfile - RT#79746 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=004c25dc160c7b4c58a9b06432c6db6e4b710966;p=gitmo%2FMooseX-ConfigFromFile.git support for _get_default_configfile - RT#79746 --- diff --git a/ChangeLog b/ChangeLog index 9fc11cf..9d16329 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ Revision history for Perl extension MooseX::ConfigFromFile +0.05 + - new _get_default_configfile method added, which consumers can override + to provide a default value without having to redefine the attribute itself + (via RT#79746) + 0.04 - Dec 17, 2011 - Call the configfile attribute default sub if it is a sub, not just a string, just like MooseX::Getopt does (RT#73325, Karen Etheridge) diff --git a/lib/MooseX/ConfigFromFile.pm b/lib/MooseX/ConfigFromFile.pm index b08dde0..03b3227 100644 --- a/lib/MooseX/ConfigFromFile.pm +++ b/lib/MooseX/ConfigFromFile.pm @@ -17,6 +17,10 @@ has configfile => ( predicate => 'has_configfile', ); +# overridable in consuming class or role to provide a default value +# called before instantiation, so must be a class method! +sub _get_default_configfile { } + sub new_with_config { my ($class, %opts) = @_; @@ -26,12 +30,23 @@ sub new_with_config { $configfile = $opts{configfile} } else { - my $cfmeta = $class->meta->find_attribute_by_name('configfile'); + # This would only succeed if the consumer had changed the name of the + # reader method, and defined a new configfile sub in its place $configfile = try { to_File($class->configfile) }; - $configfile ||= $cfmeta->default if $cfmeta->has_default; + + # this is gross, but since a lot of users have swapped in their own + # default subs, we have to keep calling it rather than calling a + # builder sub directly - and it might not even be a coderef either + my $cfmeta = $class->meta->find_attribute_by_name('configfile'); + $configfile ||= $cfmeta->default; + if (ref $configfile eq 'CODE') { - $configfile = &$configfile($class); + $configfile = $configfile->($class); } + + $configfile ||= $class->_get_default_configfile; + + $opts{$cfmeta->init_arg} = $configfile if defined $configfile; } if (defined $configfile) { diff --git a/t/05_default_sub.t b/t/05_default_sub.t new file mode 100644 index 0000000..b36d06e --- /dev/null +++ b/t/05_default_sub.t @@ -0,0 +1,184 @@ +use strict; +use warnings; + +use Test::More tests => 20; +use Test::Fatal; +use Test::Deep '!blessed'; +use Test::NoWarnings 1.04 ':early'; +use Scalar::Util 'blessed'; + +my %loaded_file; +my %constructor_args; +my %default_sub; + + +# nothing special going on here +{ + package Generic; + use Moose; + with 'MooseX::SimpleConfig'; + sub get_config_from_file { } +} + +is( + exception { + my $obj = Generic->new_with_config; + is($obj->configfile, undef, 'no configfile set'); + }, + undef, + 'no exceptions', +); + + +# this is a classic legacy usecase that we must continue to support +{ + package OverriddenDefault; + use Moose; + with 'MooseX::SimpleConfig'; + sub get_config_from_file + { + my ($class, $file) = @_; + $loaded_file{$file}++; + +{} + } + has '+configfile' => ( + default => 'OverriddenDefault file', + ); +} + +is( + exception { + my $obj = OverriddenDefault->new_with_config; + is($obj->configfile, 'OverriddenDefault file', 'configfile set via overridden default'); + is($loaded_file{'OverriddenDefault file'}, 1, 'correct file was loaded from'); + }, + undef, + 'no exceptions', +); + + +# legacy usecase, and configfile init_arg has been changed +{ + package OverriddenDefaultAndChangedName; + use Moose; + with 'MooseX::SimpleConfig'; + sub get_config_from_file + { + my ($class, $file) = @_; + $loaded_file{$file}++; + +{} + } + has '+configfile' => ( + init_arg => 'my_configfile', + default => 'OverriddenDefaultAndChangedName file', + ); + around BUILDARGS => sub { + my ($orig, $class) = (shift, shift); + my $args = $class->$orig(@_); + $constructor_args{$class} = $args; + }; +} + +is( + exception { + my $obj = OverriddenDefaultAndChangedName->new_with_config; + is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default'); + cmp_deeply( + $constructor_args{blessed($obj)}, + { my_configfile => blessed($obj) . ' file' }, + 'correct constructor args passed', + ); + is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); + }, + undef, + 'no exceptions', +); + + +# newly-supported overridable method for configfile default +{ + package WrapperSub; + use Moose; + with 'MooseX::SimpleConfig'; + sub get_config_from_file + { + my ($class, $file) = @_; + $loaded_file{$file}++; + +{} + } + + sub _get_default_configfile { + my $class = shift; + $default_sub{$class}++; + $class . ' file' + } + + around BUILDARGS => sub { + my ($orig, $class) = (shift, shift); + my $args = $class->$orig(@_); + $constructor_args{$class} = $args; + }; +} + +is( + exception { + my $obj = WrapperSub->new_with_config; + is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); + cmp_deeply( + $constructor_args{blessed($obj)}, + { configfile => blessed($obj) . ' file' }, + 'correct constructor args passed', + ); + is($default_sub{blessed($obj)}, 1, 'default sub called just once'); + is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); + }, + undef, + 'no exceptions', +); + + +# newly-supported overridable method for configfile default, and configfile +# init_arg has been changed +{ + package WrapperSubAndChangedName; + use Moose; + with 'MooseX::SimpleConfig'; + has '+configfile' => ( + init_arg => 'my_configfile', + ); + sub get_config_from_file + { + my ($class, $file) = @_; + $loaded_file{$file}++; + +{} + } + + sub _get_default_configfile { + my $class = shift; + $default_sub{$class}++; + $class . ' file' + } + + around BUILDARGS => sub { + my ($orig, $class) = (shift, shift); + my $args = $class->$orig(@_); + $constructor_args{$class} = $args; + }; +} + +is( + exception { + my $obj = WrapperSubAndChangedName->new_with_config; + is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); + cmp_deeply( + $constructor_args{blessed($obj)}, + { my_configfile => blessed($obj) . ' file' }, + 'correct constructor args passed', + ); + is($default_sub{blessed($obj)}, 1, 'default sub called just once'); + is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); + }, + undef, + 'no exceptions', +); +