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 |
14 |
|
## + refactored, more oo-style now |
15 |
|
## |
16 |
## Revision 1.1 2002/12/22 14:16:23 joko |
## Revision 1.1 2002/12/22 14:16:23 joko |
17 |
## + initial check-in |
## + initial check-in |
18 |
## |
## |
30 |
|
|
31 |
my $opt; |
my $opt; |
32 |
|
|
33 |
|
sub _cb_readOption { |
34 |
|
|
35 |
|
#my $self = shift; |
36 |
|
|
37 |
|
#print Dumper(@_); |
38 |
|
#return; |
39 |
|
|
40 |
|
my $opt_name = shift; |
41 |
|
my $opt_value = shift; |
42 |
|
$opt_value ||= 1; |
43 |
|
$opt->{$opt_name} = $opt_value; |
44 |
|
#$self->{$opt_name} = $opt_value; |
45 |
|
} |
46 |
|
|
47 |
sub new { |
sub new { |
48 |
my $invocant = shift; |
my $invocant = shift; |
49 |
my $class = ref($invocant) || $invocant; |
my $class = ref($invocant) || $invocant; |
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 |
my $getopt_optionmapping = []; |
$self->{__possible} = []; |
66 |
|
$self->{__available} = []; |
67 |
|
$self->{__result} = {}; |
68 |
|
$self->{__getopt_mapping} = []; |
69 |
#foreach (@$fields) { |
#foreach (@$fields) { |
70 |
foreach (@fields) { |
foreach (@fields) { |
71 |
#$option_mapping->{$_} = \&rOpt; |
|
72 |
push @$getopt_optionmapping, $_; |
my $key = $_; |
73 |
push @$getopt_optionmapping, \&rOpt; |
$key =~ s/=.*$//; |
74 |
|
push @{$self->{__possible}}, $key; |
75 |
|
|
76 |
|
|
77 |
|
#$option_mapping->{$_} = \&readOption; |
78 |
|
push @{$self->{__getopt_mapping}}, $_; |
79 |
|
push @{$self->{__getopt_mapping}}, \&_cb_readOption; |
80 |
} |
} |
81 |
|
|
82 |
# V1: |
GetOptions(@{$self->{__getopt_mapping}}); |
83 |
# GetOptions( |
#Getopt::Long::Configure("permute"); |
84 |
# 'force' => \&rOpt, |
#GetOptions("<>" => \&_cb_readOption); |
|
# ); |
|
|
|
|
|
# V2: |
|
|
GetOptions(@$getopt_optionmapping); |
|
85 |
|
|
86 |
foreach my $key (keys %{$opt}) { |
foreach my $key (keys %{$opt}) { |
87 |
|
push @{$self->{__available}}, $key; |
88 |
|
$self->{__result}->{$key} = $opt->{$key}; |
89 |
|
# 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 rOpt { |
sub _checkRequired { |
99 |
#my $self = shift; |
my $self = shift; |
100 |
my $opt_name = shift; |
foreach my $entry (@{$self->{__metadata}->{required}}) { |
101 |
my $opt_value = shift; |
my $optionkey = $entry->[0]; |
102 |
$opt_value ||= 1; |
my $coderef = $entry->[1]; |
103 |
$opt->{$opt_name} = $opt_value; |
if (!$self->{__result}->{$optionkey}) { |
104 |
#$self->{$opt_name} = $opt_value; |
#$self->{__metadata}->{required}->{$_}->($self); |
105 |
|
$coderef->($self); |
106 |
|
} |
107 |
|
} |
108 |
|
} |
109 |
|
|
110 |
|
sub getOptions { |
111 |
|
my $self = shift; |
112 |
|
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; |