Author: ericwilhelm
Date: Sun Sep 28 01:08:26 2008
New Revision: 11891
Modified:
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/t/ext.t
Log:
** attempting to disentangle the "no strict 'refs'" accessor generator
** snafu which was setting properties in the global named %Module::Build
lib/Module/Build/Base.pm:
- log_info() and log_verbose() were calling quiet/verbose as class
methods
- add_property() refactored to generate the accessors elsewhere
- created _make_hash_accessor(), make_accessor() functions
- warnings message for calling a property accessor as a class method
* NOTE: cull_options() calls get_options() and gets a warning
t/ext.t - removed the unholy crap
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Sun Sep 28 01:08:26 2008
@@ -177,8 +177,14 @@
################## End constructors #########################
-sub log_info { print @_ unless shift()->quiet }
-sub log_verbose { shift()->log_info(@_) if $_[0]->verbose }
+sub log_info {
+ my $self = shift;
+ print @_ unless(ref($self) and $self->quiet);
+}
+sub log_verbose {
+ my $self = shift;
+ $self->log_info(@_) if(ref($self) and $self->verbose);
+}
sub log_warn {
# Try to make our call stack invisible
shift;
@@ -697,41 +703,15 @@
}
unless ($class->can($property)) {
+ my $maker = $type eq 'HASH' ?
+ '_make_hash_accessor' : '_make_accessor';
+ # TODO probably should put these in a util package
+ $maker = $class->can($maker) or die "where did it go?";
+ my $sub = $maker->($property);
no strict 'refs';
- if ( $type eq 'HASH' ) {
- *{"$class\::$property"} = sub {
- # XXX this needs 'use strict' again
- my $self = shift;
- my $x = $self->{properties};
- return $x->{$property} unless @_;
-
- if ( defined($_[0]) && !ref($_[0]) ) {
- if ( @_ == 1 ) {
- return exists( $x->{$property}{$_[0]} ) ?
- $x->{$property}{$_[0]} : undef;
- } elsif ( @_ % 2 == 0 ) {
- my %args = @_;
- while ( my($k, $v) = each %args ) {
- $x->{$property}{$k} = $v;
- }
- } else {
- die "Unexpected arguments for property '$property'\n";
- }
- } else {
- $x->{$property} = $_[0];
- }
- };
-
- } else {
- *{"$class\::$property"} = sub {
- # XXX this needs 'use strict' again
- my $self = shift;
- $self->{properties}{$property} = shift if @_;
- return $self->{properties}{$property};
- }
- }
-
+ *{"$class\::$property"} = $sub;
}
+
return $class;
}
@@ -765,6 +745,65 @@
} # end closure
########################################################################
+sub _make_hash_accessor {
+ my ($property) = @_;
+
+ return sub {
+ my $self = shift;
+
+ # This is only here to deprecate the historic accident of calling
+ # properties as class methods - I suspect it only happens in our
+ # test suite.
+ unless(ref($self)) {
+ carp("\n$property not a class method (@_)");
+ return;
+ }
+
+ my $x = $self->{properties};
+ return $x->{$property} unless @_;
+
+ if(defined($_[0]) && !ref($_[0])) {
+ if(@_ == 1) {
+ return
+ exists($x->{$property}{$_[0]})
+ ? $x->{$property}{$_[0]}
+ : undef;
+ }
+ elsif(@_ % 2 == 0) {
+ my %args = @_;
+ while(my ($k, $v) = each %args) {
+ $x->{$property}{$k} = $v;
+ }
+ }
+ else {
+ die "Unexpected arguments for property '$property'\n";
+ }
+ }
+ else {
+ $x->{$property} = $_[0];
+ }
+ };
+}
+########################################################################
+sub _make_accessor {
+ my ($property) = @_;
+
+ return sub {
+ my $self = shift;
+
+ # This is only here to deprecate the historic accident of calling
+ # properties as class methods - I suspect it only happens in our
+ # test suite.
+ unless(ref($self)) {
+ carp("\n$property not a class method (@_)");
+ return;
+ }
+
+ $self->{properties}{$property} = shift if @_;
+ return $self->{properties}{$property};
+ };
+}
+########################################################################
# Add the default properties.
__PACKAGE__->add_property(blib => 'blib');
Modified: Module-Build/trunk/t/ext.t
==============================================================================
--- Module-Build/trunk/t/ext.t (original)
+++ Module-Build/trunk/t/ext.t Sun Sep 28 01:08:26 2008
@@ -106,8 +106,8 @@
# Make sure data can make a round-trip through an external perl
# process, which can involve the shell command line
- # Holy crap, I can't believe this works:
- local $Module::Build{properties}{quiet} = 1;
+ # silence the printing for easier matching
+ local *Module::Build::log_info = sub {};
my @data = map values(%$_), @unix_splits, @win_splits;
for my $d (@data) {
@@ -124,7 +124,9 @@
# Make sure data can make a round-trip through an external backtick
# process, which can involve the shell command line
- local $Module::Build{properties}{quiet} = 1;
+ # silence the printing for easier matching
+ local *Module::Build::log_info = sub {};
+
my @data = map values(%$_), @unix_splits, @win_splits;
for my $d (@data) {
chomp(my $out = Module::Build->_backticks('perl', '-le', 'print join " ",
map "{$_}", @ARGV', @$d));
