| 11 |
|
# --------- |
| 12 |
|
# new(UserInterface) : A new CommandLineInterface object |
| 13 |
|
# define userinterface for any CL querys |
| 14 |
< |
# parseoptions(optionhashref, @args) : parse the options, setting the UserQuery |
| 14 |
> |
# setcommand(name,level,optionref) : Add a command to recognise at the given |
| 15 |
> |
# level(>0) of the parse. Associate an |
| 16 |
> |
# optionhash with it (see parseoptions) |
| 17 |
> |
# setbase(optionref) : set options for the base level |
| 18 |
> |
# parseoptions(@args) : Parse a set of arguments for options/commands |
| 19 |
> |
# retunrs number of commands levels found |
| 20 |
> |
# command(level) : return the command given on the command line |
| 21 |
> |
# at a given level |
| 22 |
> |
# getargs(level) : return a list of arguments corresponding |
| 23 |
> |
# to a given level of command |
| 24 |
> |
# commandlevel() : return the number of found commands |
| 25 |
> |
# |
| 26 |
> |
# - private interface ------------------------------- |
| 27 |
> |
# getoptions(command, level) : return the optionhash for a given command |
| 28 |
> |
# parsecmdoptions(optionhashref, \@args) : parse the options, setting the |
| 29 |
> |
# UserQuery |
| 30 |
|
# appropriately as indicated by optionhash |
| 31 |
|
# The option hash ref should have the |
| 32 |
|
# format as given in example below |
| 34 |
|
# '-I'=> [ qw(dir >>) ], |
| 35 |
|
# '-g'=> [ qw(debug true) ] } |
| 36 |
|
# ( >> means take next argument as value) |
| 37 |
+ |
# |
| 38 |
|
|
| 39 |
|
package ActiveDoc::CommandLineInterface; |
| 40 |
|
use ActiveDoc::UserQuery; |
| 76 |
|
return $self->{dochandler}; |
| 77 |
|
} |
| 78 |
|
|
| 79 |
< |
sub parseoptions { |
| 79 |
> |
sub parsecmdoptions { |
| 80 |
|
my $self=shift; |
| 81 |
|
my $optionhashref=shift; |
| 82 |
< |
my @args=@_; |
| 82 |
> |
my $argref=shift; |
| 83 |
|
|
| 84 |
|
my $option; |
| 85 |
|
|
| 86 |
< |
$option=shift @args; |
| 86 |
> |
$option=shift @$argref; |
| 87 |
|
|
| 88 |
|
while ( defined $option ) { |
| 89 |
|
# deal with options |
| 95 |
|
# take next word as argument -- indicate by > |
| 96 |
|
if ( $$optionhashref{$option}[1]=~/^\>\>/ ) { |
| 97 |
|
$self->{InputQuery}->setparam($$optionhashref{$option}[0], |
| 98 |
< |
(shift @args)); |
| 98 |
> |
(shift @$argref)); |
| 99 |
|
} |
| 100 |
|
else { # simply set value as in hashref |
| 101 |
|
$self->{InputQuery}->setparam($$optionhashref{$option}[0], |
| 104 |
|
} |
| 105 |
|
} |
| 106 |
|
else { # deal with commands |
| 107 |
< |
unshift @args, $option; |
| 107 |
> |
unshift @$argref, $option; |
| 108 |
|
last; |
| 109 |
|
} |
| 110 |
< |
$option=shift @args; |
| 110 |
> |
$option=shift @$argref; |
| 111 |
|
} # end while |
| 112 |
|
} |
| 113 |
|
|
| 114 |
+ |
sub parseoptions { |
| 115 |
+ |
my $self=shift; |
| 116 |
+ |
my @args=@_; |
| 117 |
+ |
|
| 118 |
+ |
my $command; |
| 119 |
+ |
my $commandhashref; |
| 120 |
+ |
my $level; |
| 121 |
+ |
|
| 122 |
+ |
$command='_base'; |
| 123 |
+ |
|
| 124 |
+ |
# base level |
| 125 |
+ |
$level=0; |
| 126 |
+ |
$commandhashref=$self->getoptions($command, $level); |
| 127 |
+ |
$self->parsecmdoptions($commandhashref, \@args); |
| 128 |
+ |
@{$self->{"_arg_0"}}=(); |
| 129 |
+ |
|
| 130 |
+ |
|
| 131 |
+ |
$self->{arglev}=$level; |
| 132 |
+ |
$level++; |
| 133 |
+ |
|
| 134 |
+ |
while ( ( $#args >= 0) && ( $level <= $#{$self->{commands}}) ) { |
| 135 |
+ |
$arg=shift @args; |
| 136 |
+ |
if ( exists ${$self->{commands}[$level]}{$arg} ) { |
| 137 |
+ |
$self->{InputQuery}->setparam("_cmd_$level", $arg); |
| 138 |
+ |
$commandhashref=$self->getoptions($arg, $level); |
| 139 |
+ |
$self->parsecmdoptions($commandhashref, \@args); |
| 140 |
+ |
$self->{arglev}=$level; |
| 141 |
+ |
@{$self->{"_arg_$self->{arglev}"}}=(); #initialise new arg array |
| 142 |
+ |
$level++; |
| 143 |
+ |
} |
| 144 |
+ |
else { |
| 145 |
+ |
# must be an argument to the last command |
| 146 |
+ |
push @{$self->{"_arg_$self->{arglev}"}} , $arg; |
| 147 |
+ |
} |
| 148 |
+ |
} |
| 149 |
+ |
# add any futher arguments to last argumentlist |
| 150 |
+ |
push @{$self->{"_arg_$self->{arglev}"}} , @args; |
| 151 |
+ |
return $self->{arglev}; |
| 152 |
+ |
} |
| 153 |
+ |
|
| 154 |
+ |
sub commandlevel { |
| 155 |
+ |
my $self=shift; |
| 156 |
+ |
return $self->{arglev}; |
| 157 |
+ |
} |
| 158 |
+ |
|
| 159 |
+ |
sub getargs { |
| 160 |
+ |
my $self=shift; |
| 161 |
+ |
my $level=shift; |
| 162 |
+ |
|
| 163 |
+ |
return @{$self->{"_arg_$level"}}; |
| 164 |
+ |
} |
| 165 |
+ |
|
| 166 |
+ |
sub getoptions { |
| 167 |
+ |
my $self=shift; |
| 168 |
+ |
my $name=shift; |
| 169 |
+ |
my $level=shift; |
| 170 |
+ |
|
| 171 |
+ |
return ${$self->{commands}[$level]}{$name}; |
| 172 |
+ |
} |
| 173 |
+ |
|
| 174 |
+ |
sub setcommand { |
| 175 |
+ |
my $self=shift; |
| 176 |
+ |
my $name=shift; |
| 177 |
+ |
my $level=shift; |
| 178 |
+ |
my $optionref=shift; |
| 179 |
+ |
|
| 180 |
+ |
${$self->{commands}[$level]}{$name}=$optionref; |
| 181 |
+ |
} |
| 182 |
+ |
|
| 183 |
+ |
sub setbase { |
| 184 |
+ |
my $self=shift; |
| 185 |
+ |
my $optionref=shift; |
| 186 |
+ |
|
| 187 |
+ |
$self->setcommand("_base", 0 , $optionref); |
| 188 |
+ |
} |
| 189 |
+ |
|
| 190 |
+ |
sub command { |
| 191 |
+ |
my $self=shift; |
| 192 |
+ |
my $level=shift; |
| 193 |
+ |
|
| 194 |
+ |
return $self->{InputQuery}->getparam("_cmd_$level"); |
| 195 |
+ |
} |
