Re: Indentation (was Re: invalid installdirs values)

Index: lib/Module/Build/Base.pm
===================================================================
--- lib/Module/Build/Base.pm	(revision 11885)
+++ lib/Module/Build/Base.pm	(working copy)
@@ -665,7 +665,9 @@
     sub valid_properties_defaults {
       my %out;
       for (reverse shift->_mb_classes) {
-	@out{ keys %{ $valid_properties{$_} } } = values %{ $valid_properties{$_} };
+	@out{ keys %{ $valid_properties{$_} } } = map {
+            $_->()
+        } values %{ $valid_properties{$_} };
       }
       return \%out;
     }
@@ -685,55 +687,67 @@
     }
 
     sub add_property {
-      my ($class, $property, $default) = @_;
-      die "Property '$property' already exists" if $class->valid_property($property);
+        my ($class, $property) = (shift, shift);
+        die "Property '$property' already exists"
+            if $class->valid_property($property);
+        my %p = @_ == 1 ? ( default => shift ) : @_;
 
-      $valid_properties{$class}{$property} = $default;
+        my $type = ref $p{default};
+        $valid_properties{$class}{$property} = $type eq 'CODE'
+            ? $p{default}
+            : sub { $p{default} };
 
-      my $type = ref $default;
-      if ($type) {
-	push @{$additive_properties{$class}->{$type}}, $property;
-      }
+        push @{$additive_properties{$class}->{$type}}, $property
+            if $type;
 
-      unless ($class->can($property)) {
-        no strict 'refs';
-	if ( $type eq 'HASH' ) {
-          *{"$class\::$property"} = sub {
-            # XXX this needs 'use strict' again
+        return $class if $class->can($property);
+
+        my $check = $p{check} || sub { 1 };
+        my $sub = $type eq 'HASH' ? sub {
 	    my $self = shift;
-	    my $x = $self->{properties};
+            # Allow to work in class or object context.
+            my $x = do { no strict 'refs'; $self->{properties} };
 	    return $x->{$property} unless @_;
 
-	    if ( defined($_[0]) && !ref($_[0]) ) {
+            my $prop = $x->{$property};
+            if ( defined $_[0] && !ref $_[0] ) {
 	      if ( @_ == 1 ) {
-		return exists( $x->{$property}{$_[0]} ) ?
-		         $x->{$property}{$_[0]} : undef;
+                    return exists $prop->{$_[0]} ? $prop->{$_[0]} : undef;
               } elsif ( @_ % 2 == 0 ) {
-	        my %args = @_;
-	        while ( my($k, $v) = each %args ) {
-	          $x->{$property}{$k} = $v;
-	        }
+                    my %new = (%{ $prop }, @_);
+                    local $_ = \%new;
+                    $x->{$property} = \%new if $check->($self);
+                    return $x->{$property};
 	      } else {
 		die "Unexpected arguments for property '$property'\n";
 	      }
 	    } else {
-	      $x->{$property} = $_[0];
+                die "Unexpected arguments for property '$property'\n"
+                    if defined $_[0] && ref $_[0] ne 'HASH';
+                local $_ = $_[0];
+                $x->{$property} = shift if $check->($self);
 	    }
+        } : sub {
+            my $self = shift;
+            # Allow to work in class or object context.
+            my $x = do { no strict 'refs'; $self->{properties} };
+            return $x->{$property} unless @_;
+            local $_ = $_[0];
+            $x->{$property} = shift if $check->($self);
+            return $x->{$property};
 	  };
 
-        } else {
-          *{"$class\::$property"} = sub {
-            # XXX this needs 'use strict' again
-	    my $self = shift;
-	    $self->{properties}{$property} = shift if @_;
-	    return $self->{properties}{$property};
-	  }
-        }
+        no strict 'refs';
+        *{"$class\::$property"} = $sub;
 
-      }
       return $class;
     }
 
+    sub property_error {
+        my $self = shift;
+        die 'ERROR: ', @_;
+    }
+
     sub _set_defaults {
       my $self = shift;
 
@@ -772,7 +786,6 @@
 __PACKAGE__->add_property(build_bat => 0);
 __PACKAGE__->add_property(config_dir => '_build');
 __PACKAGE__->add_property(include_dirs => []);
-__PACKAGE__->add_property(installdirs => 'site');
 __PACKAGE__->add_property(metafile => 'META.yml');
 __PACKAGE__->add_property(recurse_into => []);
 __PACKAGE__->add_property(use_rcfile => 1);
@@ -782,6 +795,20 @@
 __PACKAGE__->add_property(test_file_exts => ['.t']);
 __PACKAGE__->add_property(use_tap_harness => 0);
 __PACKAGE__->add_property(tap_harness_args => {});
+__PACKAGE__->add_property(
+    'installdirs',
+    default => 'site',
+    check   => sub {
+        return 1 if /^(core|site|vendor)$/;
+        return shift->property_error(
+            $_ eq 'perl'
+            ? 'Perhaps you meant installdirs to be "core" rather than "perl"?'
+            : 'installdirs must be one of "core", "site", or "vendor"'
+        );
+        return shift->property_error("Perhaps you meant 'core'?") if $_ eq 'perl';
+        return 0;
+    },
+);
 
 {
   my $Is_ActivePerl = eval {require ActivePerl::DocTools};
Index: lib/Module/Build/API.pod
===================================================================
--- lib/Module/Build/API.pod	(revision 11885)
+++ lib/Module/Build/API.pod	(working copy)
@@ -791,9 +791,89 @@
 defaults to C<MyModuleBuilder>.  The C<code> parameter specifies Perl
 code to use as the body of the subclass.
 
+=item add_property
+
+[version 0.31]
+
+  package 'My::Build';
+  use base 'Module::Build';
+  __PACKAGE__->add_property( 'pedantic' );
+  __PACKAGE__->add_property( answer => 42 );
+  __PACKAGE__->add_property(
+      'epoch',
+      default => sub { time },
+      check   => sub {
+          return 1 if /^\d+$/;
+          shift->property_error( "'$_' is not an epoch time" );
+          return 0;
+      },
+  );
+
+Adds a property to a Module::Build class. Properties are those attributes of a
+Module::Build object which can be passed to the constructorand which have
+accessors to get and set them. All of the core properties, such as
+C<module_name> and C<license>, are defined using this class method.
+
+The first argument to C<add_property()> is always the name of the property.
+The second argument can be either a default value for the property, or a list
+of key/value pairs. The supported keys are:
+
+=over
+
+=item C<default>
+
+The default value. May optionally be specified as a code reference, in which
+case the return value from the execution of the code reference will be used.
+If you need the default to be a code reference, just use a code reference to
+return it, e.g.:
+
+      default => sub { sub { ... } },
+
+=item C<check>
+
+A code reference that checks that a value specified for the property is valid.
+During the execution of the code reference, the new value will be included in
+the C<$_> variable. If the value is correct, the C<check> code reference
+should return true. If the value is not correct, it send an error message to
+C<property_error()> and return false.
+
 =back
 
+When this method is called, a new property will be installed in the
+Module::Build class, and an accessor will be built to allow the property to be
+get or set on the build object.
 
+  print $build->pedantic, $/;
+  $build->pedantic(0);
+
+If the default value is a hash reference, this generetes a special-case
+accessor method, wherein individual key/value pairs may be set or fetched:
+
+  print "stuff{foo} is: ", $build->stuff( 'foo' ), $/;
+  $build->stuff( foo => 'bar' );
+  print $build->stuff( 'foo' ), $/; # Outputs "bar"
+
+Of course, you can still set the entire hash reference at once, as well:
+
+  $build->stuff( { foo => 'bar', baz => 'yo' } );
+
+In either case, if a C<check> has been specified for the property, it will be
+applied to the entire hash. So the check code reference should look something
+like:
+
+      check => sub {
+            return 1 if defined $_ && exists $_->{foo};
+            shift->property_error(qq{Property "stuff" needs "foo"});
+            return 0;
+      },
+
+=item property_error
+
+[version 0.31]
+
+=back
+
+
 =head2 METHODS
 
 =over 4
@@ -883,7 +963,6 @@
 compiling & linking C code.  If no such object is available (e.g. if
 the system has no compiler installed) an exception will be thrown.
 
-
 =item check_installed_status($module, $version)
 
 [version 0.11]