Merge remote branch 'ovid/pr/config_objects' into review/ovid/strict_…

…config

Conflicts:
	CHANGES

CHANGES

@@ -16,6 +16,10 @@
     * Explain in POD that if there are multiple fields with the same name,
       params('fieldname') returns an arrayref of them (alexrj).
 
+    [ ENHANCEMENTS ]
+    * Added 'strict_config' option to have the config return an object instead
+      of a hashref. (Ovid)
+
 1.3093      29.02.2012
 
     [ BUG FIXES ]

MANIFEST

@@ -125,6 +125,7 @@ t/01_config/04_config_file.t
 t/01_config/05_serializers.t
 t/01_config/06_config_api.t
 t/01_config/06_stack_trace.t
+t/01_config/07_strict_config.t
 t/01_config/environments/development.pl
 t/01_config/yaml_dependency.t
 t/02_request/000_create_fake_env.t

lib/Dancer/Config.pm

@@ -5,6 +5,7 @@ use warnings;
 use base 'Exporter';
 use vars '@EXPORT_OK';
 
+use Dancer::Config::Object 'hashref_to_object';
 use Dancer::Deprecation;
 use Dancer::Template;
 use Dancer::ModuleLoader;
@@ -175,6 +176,9 @@ sub load {
     foreach my $key (grep { $setters->{$_} } keys %$SETTINGS) {
         $setters->{$key}->($key, $SETTINGS->{$key});
     }
+    if ( $SETTINGS->{strict_config} ) {
+        $SETTINGS = hashref_to_object($SETTINGS);
+    }
 
     return 1;
 }
@@ -408,6 +412,11 @@ C<template> keyword. Check C<Dancer> manpage for details.
 
 =head2 Logging, debugging and error handling
 
+=head2 strict_config (boolean, default: false)
+
+If true, C<config> will return an object instead of a hash reference. See
+L<Dancer::Config::Object> for more information.
+
 =head3 import_warnings (boolean, default: enabled)
 
 If true, or not present, C<use warnings> will be in effect in scripts in which

lib/Dancer/Config/Object.pm

@@ -0,0 +1,171 @@
+package Dancer::Config::Object;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+use Carp 'croak';
+use Dancer::Exception qw(:all);
+use Scalar::Util 'blessed';
+
+register_exception('BadConfigMethod',
+    message_pattern =>
+      qq{Can't locate config attribute "%s".\nAvailable attributes: %s});
+
+our @EXPORT_OK = qw(hashref_to_object);
+
+{
+    my $index = 1;
+
+    sub hashref_to_object {
+        my ($hashref) = @_;
+        my $class = __PACKAGE__;
+        my $target = "${class}::__ANON__$index";
+        $index++;
+        if ('HASH' ne ref $hashref) {
+            if ( blessed $hashref ) {
+                # we have already converted this to an object. This can happen
+                # in cases where Dancer::Config->load is called more than
+                # once.
+                return $hashref;
+            }
+            else {
+                # should never happen
+                raise 'Core::Config' => "Argument to $class must be a hashref";
+            }
+        }
+        my $object = bless $hashref => $target;
+        _add_methods($object);
+
+        return $object;
+    }
+}
+
+
+sub _add_methods {
+    my ($object) = @_;
+    my $target = ref $object;
+
+    foreach my $key ( keys %$object ) {
+        my $value = $object->{$key};
+        if ( 'HASH' eq ref $value ) {
+            $value = hashref_to_object($value);
+        }
+        elsif ( 'ARRAY' eq ref $value ) {
+            foreach (@$value) {
+                $_ = 'HASH' eq ref($_) ? hashref_to_object($_) : $_;
+            }
+        }
+
+        # match a (more or less) valid identifier
+        next unless $key =~ qr/^[[:alpha:]_][[:word:]]*$/;
+        my $method = "${target}::$key";
+        no strict 'refs';
+        *$method = sub {$value};
+    }
+    _setup_bad_method_trap($target);
+}
+
+# AUTOLOAD will only be called if a non-existent method is called. It's used
+# to generate the list of available methods. It's slow, but we're going to
+# die. Who wants to die quickly?
+sub _setup_bad_method_trap {
+    my ($target) = @_;
+    no strict;    ## no critic (ProhibitNoStrict)
+    *{"${target}::AUTOLOAD"} = sub {
+        $AUTOLOAD =~ /.*::(.*)$/;
+
+        # should never happen
+        my $bad_method = $1    ## no critic (ProhibitCaptureWithoutTest)
+          or croak "Could not determine method called via $AUTOLOAD";
+        return if 'DESTROY' eq $bad_method;
+        my $symbol_table = "${target}::";
+
+        # In these fake classes, we only have methods
+        my $methods =
+          join ', ' => grep { !/^(?:AUTOLOAD|DESTROY|$bad_method)$/ }
+          sort keys %$symbol_table;
+        raise BadConfigMethod => $bad_method, $methods;
+    };
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Dancer::Config::Object - Access the config via methods instead of hashrefs
+
+=head1 DESCRIPTION
+
+If C<strict_config> is set to a true value in the configuration, the
+C<config()> subroutine will return an object instead of a hashref. Instead of
+this:
+
+ my $serializer = config->{serializer};
+ my $username   = config->{auth}{username};
+
+You get this:
+
+ my $serializer = config->serializer;
+ my $username   = config->auth->username;
+
+This helps to prevent typos. If you mistype a configuration name:
+
+ my $pass = config->auth->pass;
+
+An exception will be thrown, tell you it can't find the method name, but
+listing available methods:
+
+ Can't locate config attribute "pass".
+ Available attributes: password, username
+
+If the hash key cannot be converted into a proper method name, you can still
+access it via a hash reference:
+
+ my $some_value = config->{'99_bottles'};
+
+And call methods on it, if possible:
+
+ my $sadness = config->{'99_more_bottles'}->last_bottle;
+
+Hash keys pointing to hash references will in turn have those "objectified".
+Arrays will still be returned as array references. However, hashrefs inside of
+the array refs may still have their keys allowed as methods:
+
+ my $some_value = config->some_list->[1]->host;
+
+=head1 METHOD NAME DEFINITION
+
+We use the following regular expression to determine if a hash key qualifies
+as a method:
+
+ /^[[:alpha:]_][[:word:]]*$/;
+
+Note that this means C<naïve> (note the dots over the i) can be a method name,
+but unless you C<use utf8;> to declare that your source code is UTF-8, you may
+have disappointing results calling C<< config->naïve >>. Further, depending on
+your version of Perl and the software to read your config file ... well, you
+get the idea. We recommend sticking with ASCII identifiers if you wish your
+code to be portable.
+
+Patches/suggestions welcome.
+
+=head1 AUTHOR
+
+This module has been written by Alexis Sukrieh <sukria@cpan.org> and others,
+see the AUTHORS file that comes with this distribution for details.
+
+=head1 LICENSE
+
+This module is free software and is released under the same terms as Perl
+itself.
+
+=head1 SEE ALSO
+
+L<Dancer> and L<Dancer::Config>.
+
+=cut

t/01_config/07_strict_config.t

@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+use Test::More import => ['!pass'];
+
+plan skip_all => "YAML needed to run this tests"
+    unless Dancer::ModuleLoader->load('YAML');
+plan skip_all => "File::Temp 0.22 required"
+    unless Dancer::ModuleLoader->load( 'File::Temp', '0.22' );
+plan tests => 12;
+
+use Dancer ':syntax';
+use File::Spec;
+use lib File::Spec->catdir( 't', 'lib' );
+use TestUtils;
+
+my $dir = File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
+set appdir => $dir;
+my $envdir = File::Spec->catdir($dir, 'environments');
+mkdir $envdir;
+
+my $conffile = Dancer::Config->conffile;
+
+# create the conffile
+my $conf = <<"END";
+port: 4500
+startup_info: 0
+99_bottles: "can't touch this"
+99_more_bottles:
+  this_method: "can be called"
+alist:
+  - first_element:
+    foo: bar
+  - second_element:
+    baz: quux
+    this: rocks
+charset: "UTF8"
+logger: file
+auth:
+  username: ovid
+  password: hahahah
+strict_config: 1
+END
+write_file($conffile => $conf);
+ok(Dancer::Config->load, 'Config load works with a conffile');
+ok(Dancer::Config->load, '... and it should be safe to call more than once');
+
+can_ok config, 'port';
+is config->port, '4500', 'basic methods should work with strict configs';
+is config->auth->username, 'ovid', '... and as should chained methods';
+is config->{port}, '4500',
+  '... but we should still be able to reach into the config';
+
+ok !config->can('99_bottles'), 'We do not try to build invalid method names';
+is config->{'99_bottles'}, "can't touch this",
+  "... but we do not discard them, either";
+is config->{'99_more_bottles'}->this_method, 'can be called',
+  "... but they can still chain methods";
+
+is config->alist->[1]->baz, 'quux', '... and we still can call list methods';
+
+eval { config->auth->pass };
+my $error = $@;
+
+like $error, qr/Can't locate config attribute "pass"/,
+    'Calling non-existent config methods should die';
+
+like $error, qr/Available attributes: password, username/,
+    '... and tell us which attributes are available';
+
+Dancer::Logger::logger->{fh}->close;
+unlink Dancer::Config->environment_file;
+unlink $conffile;
+File::Temp::cleanup();