forked from hdp/module-build
-
Notifications
You must be signed in to change notification settings - Fork 0
/
patch.2004-03-13
160 lines (152 loc) · 4.18 KB
/
patch.2004-03-13
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Index: lib/Module/Build/Base.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v
retrieving revision 1.267
diff -u -b -r1.267 Base.pm
--- lib/Module/Build/Base.pm 4 Mar 2004 00:08:20 -0000 1.267
+++ lib/Module/Build/Base.pm 13 Mar 2004 21:41:33 -0000
@@ -332,13 +332,14 @@
include_dirs
bindoc_dirs
libdoc_dirs
+ config
);
sub valid_property { exists $valid_properties{$_[1]} }
- # Create an accessor for each property that doesn't already have one
- foreach my $property (keys %valid_properties) {
- next if __PACKAGE__->can($property);
+# Create an accessor for each property that doesn't already have one
+foreach my $property (keys %valid_properties) {
+ unless( __PACKAGE__->can($property)) {
no strict 'refs';
*{$property} = sub {
my $self = shift;
@@ -346,6 +347,16 @@
return $self->{properties}{$property};
};
}
+ my $set_property_method = "_set_property_$property";
+ unless( __PACKAGE__->can($set_property_method)) {
+ no strict 'refs';
+ *{$set_property_method} = sub {
+ my $self = shift;
+ $self->{properties}{$property} = shift if @_;
+ return $self->{properties}{$property};
+ };
+ }
+}
}
sub extra_compiler_flags {
@@ -914,6 +925,25 @@
}
}
+## parse "key=val" into {key=>"val"}
+sub _parse_shared_args {
+ my ($self, $prop, $sh_args ) =@_;
+
+ unless(defined($sh_args)) { $sh_args = []; }
+ $sh_args = [ $sh_args ] unless ref $sh_args;
+ return $sh_args unless( ref $sh_args eq 'ARRAY' ); # if is Href
+
+ # is Aref
+ my $hash={};
+ foreach my $arg ( @{$sh_args} ) {
+ $arg =~ /(\w+)=(.+)/
+ or die "Malformed '$prop' argument: '$arg' ".
+ "should be something like 'foo=bar'";
+ $hash->{$1} = $2;
+ }
+ return $hash;
+}
+
sub read_args {
my $self = shift;
my ($action, %args, @argv);
@@ -930,44 +960,22 @@
}
}
$args{ARGV} = \@argv;
-
- # 'config' and 'install_path' are additive by hash key
- my %additive = map {$_, 1} qw(config install_path);
-
- # Hashify these parameters
- for (keys %additive) {
- next unless exists $args{$_};
- my %hash;
- $args{$_} ||= [];
- $args{$_} = [ $args{$_} ] unless ref $args{$_};
- foreach my $arg ( @{$args{$_}} ) {
- $arg =~ /(\w+)=(.+)/
- or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";
- $hash{$1} = $2;
- }
- $args{$_} = \%hash;
- }
-
return \%args, $action;
}
sub merge_args {
my ($self, $action, %args) = @_;
- my %additive = (config => $self->{config},
- install_path => $self->{properties}{install_path} ||= {});
$self->{action} = $action if defined $action;
# Extract our 'properties' from $cmd_args, the rest are put in 'args'.
while (my ($key, $val) = each %args) {
- my $add_to = ($additive{$key} ? $additive{$key}
- : $self->valid_property($key) ? $self->{properties}
- : $self->{args});
-
- if ($additive{$key}) {
- $add_to->{$_} = $val->{$_} foreach keys %$val;
- } else {
- $add_to->{$key} = $val;
+ if( $self->valid_property($key) ) {
+ my $method = "_set_property_$key";
+ $self->$method($val);
+ }
+ else {
+ $self->{args}->{$key} = $val;
}
}
}
@@ -976,6 +984,40 @@
my $self = shift;
my ($args, $action) = $self->read_args(@_);
$self->merge_args($action, %$args);
+}
+
+## should only be called when parsing
+## command line arguments
+sub _set_property_config {
+ my $self = shift;
+ if(@_) {
+ my $val={};
+ if( @_ == 1 ) {
+ $val = $self->_parse_shared_args('config',shift);
+ }
+ else {
+ %$val = @_;
+ }
+ $self->{config}->{$_} = $val->{$_} foreach keys %$val;
+ }
+ return $self->{config};
+}
+
+## should only be called when parsing
+## command line arguments
+sub _set_property_install_path {
+ my $self = shift;
+ if(@_) {
+ my $val={};
+ if( @_ == 1 ) {
+ $val=$self->_parse_shared_args('install_path',shift);
+ }
+ else {
+ %$val = @_;
+ }
+ $self->{properties}{install_path}{$_} = $val->{$_} foreach keys %$val;
+ }
+ return $self->{properties}{install_path};
}
sub super_classes {