2 |
## $Id$ |
## $Id$ |
3 |
## ------------------------------------------------------------------------ |
## ------------------------------------------------------------------------ |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.4 2002/12/28 07:55:26 joko |
6 |
|
## - changed mechanism to read options |
7 |
|
## |
8 |
|
## Revision 1.3 2002/12/27 16:06:55 joko |
9 |
|
## + sub _checkRequired |
10 |
|
## + sub getPossibleOptionKeys |
11 |
|
## + sub get |
12 |
|
## |
13 |
## Revision 1.2 2002/12/23 04:27:03 joko |
## Revision 1.2 2002/12/23 04:27:03 joko |
14 |
## + refactored, more oo-style now |
## + refactored, more oo-style now |
15 |
## |
## |
31 |
my $opt; |
my $opt; |
32 |
|
|
33 |
sub _cb_readOption { |
sub _cb_readOption { |
34 |
|
|
35 |
#my $self = shift; |
#my $self = shift; |
36 |
|
|
37 |
|
#print Dumper(@_); |
38 |
|
#return; |
39 |
|
|
40 |
my $opt_name = shift; |
my $opt_name = shift; |
41 |
my $opt_value = shift; |
my $opt_value = shift; |
42 |
$opt_value ||= 1; |
$opt_value ||= 1; |
51 |
bless $self, $class; |
bless $self, $class; |
52 |
|
|
53 |
#my $fields = shift; |
#my $fields = shift; |
54 |
my @fields = @_; |
my @fields; |
55 |
|
foreach (@_) { |
56 |
|
#print ref $_, "\n"; |
57 |
|
if (ref $_ eq 'HASH') { |
58 |
|
$self->{__metadata} = $_; |
59 |
|
} else { |
60 |
|
push @fields, $_; |
61 |
|
} |
62 |
|
} |
63 |
|
|
64 |
# build mapping (hash with argument as key and callback (CODEref) as value) |
# build mapping (hash with argument as key and callback (CODEref) as value) |
65 |
$self->{__possible} = []; |
$self->{__possible} = []; |
80 |
} |
} |
81 |
|
|
82 |
GetOptions(@{$self->{__getopt_mapping}}); |
GetOptions(@{$self->{__getopt_mapping}}); |
83 |
|
#Getopt::Long::Configure("permute"); |
84 |
|
#GetOptions("<>" => \&_cb_readOption); |
85 |
|
|
86 |
foreach my $key (keys %{$opt}) { |
foreach my $key (keys %{$opt}) { |
87 |
push @{$self->{__available}}, $key; |
push @{$self->{__available}}, $key; |
89 |
# for convenience: store inside object itself, too |
# for convenience: store inside object itself, too |
90 |
$self->{$key} = $opt->{$key}; |
$self->{$key} = $opt->{$key}; |
91 |
} |
} |
92 |
|
|
93 |
|
$self->_checkRequired(); |
94 |
|
|
95 |
return $self; |
return $self; |
96 |
} |
} |
97 |
|
|
98 |
|
sub _checkRequired { |
99 |
|
my $self = shift; |
100 |
|
foreach my $entry (@{$self->{__metadata}->{required}}) { |
101 |
|
my $optionkey = $entry->[0]; |
102 |
|
my $coderef = $entry->[1]; |
103 |
|
if (!$self->{__result}->{$optionkey}) { |
104 |
|
#$self->{__metadata}->{required}->{$_}->($self); |
105 |
|
$coderef->($self); |
106 |
|
} |
107 |
|
} |
108 |
|
} |
109 |
|
|
110 |
sub getOptions { |
sub getOptions { |
111 |
my $self = shift; |
my $self = shift; |
112 |
return $self->{__result}; |
return $self->{__result}; |
113 |
} |
} |
114 |
|
|
115 |
|
sub getPossibleOptionKeys { |
116 |
|
my $self = shift; |
117 |
|
return $self->{__possible}; |
118 |
|
} |
119 |
|
|
120 |
|
sub get { |
121 |
|
my $self = shift; |
122 |
|
my $key = shift; |
123 |
|
return $self->{$key}; |
124 |
|
} |
125 |
|
|
126 |
1; |
1; |