src/ActiveDoc/CommandLineInterface.pm

#
# CommandLineInterface.pm
#
# Originally Written by Christopher Williams
#
# Description
# Do all the setting up required for the Query based on an input hash
# --- defaults taken from activedoc configuration setup
#
# Interface
# ---------
# new(CommandObjName, UserInterface)  : A new CommandLineInterface object
#                                       define userinterface for any CL querys
# setcommand(name,level,optionref)   : Add a command to recognise at the given
#                                       level(>0) of the parse. Associate an
#                                       optionhash with it (see parseoptions)
# setbase(optionref)                : set options for the base level
# parseoptions(@args)           : Parse a set of arguments for options/commands
#                                 retunrs number of commands levels found
# command(level)                : return the command given on the command line
#                                 at a given level
# allowedcommands(level)        : return list of allowed commands for level
# getargs(level)                : return a list of arguments corresponding
#                                 to a given level of command
# commandlevel()                : return the number of found commands
# parse(@args)                  : Hand it the args and it will setup dochandler
#                                 after calling the parse() method on the 
#                                 CommandObj
#
# - private interface -------------------------------
# getoptions(command, level)    : return the optionhash for a given command
# parsecmdoptions(optionhashref, \@args) : parse the options, setting the 
#                                       Query
#                                      appropriately as indicated by optionhash
#                                      The option hash ref should have the
#                                       format as given in example below
#                                       $ohr={
#                                               '-I'=> [ qw(dir >>) ], 
#                                               '-g'=> [ qw(debug true) ] }
#                                       ( >> means take next argument as value)
# 

package ActiveDoc::CommandLineInterface;
use ActiveDoc::Query;
use ActiveDoc::StarterDoc;
use ActiveDoc::UserInterface_basic;
#use ActiveDoc::DOChandler;
require 5.001;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->init(@_);
        return $self;
}

# --------------- Support Routines --------------------
sub init {
        my $self=shift;
        my $file=shift;
        my $UI=shift;

        # Set up a User Query Object
        $self->{UI}=$UI;
        $self->{Query}=ActiveDoc::Query->new();

        # Set up our command handling object
        eval "require $file" ;
        die $@ if $@;
        $self->{Commands}=$file->new($self);
        
        $self->{errormessg}="Error : ";
}

sub parse {
        my $self=shift;
        my @args=@_;

        # Get all parameters into Query
        $self->parseoptions(@_);

        # Initialise the DocHandler with what weve got so  far
        #$self->{dochandler}=ActiveDoc::DOChandler->new($self->{Query});
        $self->{StartDoc}=ActiveDoc::StarterDoc->new($self->{Query},
                                        $self->{UI} );

        $self->{Commands}->parse(@_);

}
 
sub error {
        my $self=shift;
        my $string=shift;

        die $self->{errormessg}.$string."\n";
}


# --------------- Interface routines --------------------


sub parsecmdoptions {
        my $self=shift;
        my $optionhashref=shift;
        my $argref=shift;

        my $option;

        $option=shift @$argref;

        while ( defined $option ) {
          # deal with options
          if ( $option=~/^\-/ ) {
           if ( ! exists $$optionhashref{$option} ) {
                $self->error("Unknown Option $option");
           }
           else {
                # take next word as argument -- indicate by >
                if ( $$optionhashref{$option}[1]=~/^\>\>/ ) {
                   $self->{Query}->setparam($$optionhashref{$option}[0],
                        (shift @$argref));
                } 
                else { # simply set value as in hashref
                   $self->{Query}->setparam($$optionhashref{$option}[0],
                                        $$optionhashref{$option}[1]);
                }
           }
          }
          else { # deal with commands
                unshift @$argref, $option;
                last;
          }
          $option=shift @$argref;
        } # end while  
}

sub parseoptions {
        my $self=shift;
        my @args=@_;

        my $command;
        my $commandhashref;
        my $level;

        $command='_base';

        # base level
        $level=0;
        $commandhashref=$self->getoptions($command, $level);
        $self->parsecmdoptions($commandhashref, \@args);
        @{$self->{"_arg_0"}}=();

        
        $self->{arglev}=$level;
        $level++;
        
        while ( ( $#args >= 0) && ( $level <= $#{$self->{commands}}) ) {
          $arg=shift @args;
          if ( exists ${$self->{commands}[$level]}{$arg} ) {
                $self->{Query}->setparam("_cmd_$level", $arg);
                $commandhashref=$self->getoptions($arg, $level);
                $self->parsecmdoptions($commandhashref, \@args);
                $self->{arglev}=$level;
                @{$self->{"_arg_$self->{arglev}"}}=(); #initialise new arg array
                $level++;
          }
          else { 
                # must be an argument to the last command
                push @{$self->{"_arg_$self->{arglev}"}} , $arg;
          }
        }
        # add any futher arguments to last argumentlist
        push @{$self->{"_arg_$self->{arglev}"}} , @args;
        return $self->{arglev};
}

sub commandlevel {
        my $self=shift;
        return $self->{arglev};
}

sub allowedcommands {
        my $self=shift;
        my $level=shift;

        return keys %{$self->{commands}[$level]};
}

sub getargs {
        my $self=shift;
        my $level=shift;

        return @{$self->{"_arg_$level"}};
}

sub getoptions {
        my $self=shift;
        my $name=shift;
        my $level=shift;

        return ${$self->{commands}[$level]}{$name};
}

sub setcommand {
        my $self=shift;
        my $name=shift;
        my $level=shift;
        my $optionref=shift;
        my $commandref=shift;

        ${$self->{commands}[$level]}{$name}=$optionref;
}


sub setbase {
        my $self=shift;
        my $optionref=shift;

        $self->setcommand("_base", 0 , $optionref);
}

sub command {
        my $self=shift;
        my $level=shift;

        return $self->{Query}->getparam("_cmd_$level");
}
Revision:	1.4
Committed:	Thu Dec 16 16:01:32 1999 UTC (25 years, 4 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.3:	+15 -20 lines
Log Message:	Change to new Query model
#	User	Rev	Content
1	williamc	1.1	#
2			# CommandLineInterface.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7	williamc	1.4	# Do all the setting up required for the Query based on an input hash
8	williamc	1.1	# --- defaults taken from activedoc configuration setup
9			#
10			# Interface
11			# ---------
12	williamc	1.3	# new(CommandObjName, UserInterface) : A new CommandLineInterface object
13	williamc	1.1	# define userinterface for any CL querys
14	williamc	1.2	# 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	williamc	1.3	# allowedcommands(level) : return list of allowed commands for level
23	williamc	1.2	# getargs(level) : return a list of arguments corresponding
24			# to a given level of command
25			# commandlevel() : return the number of found commands
26	williamc	1.3	# parse(@args) : Hand it the args and it will setup dochandler
27			# after calling the parse() method on the
28			# CommandObj
29	williamc	1.2	#
30			# - private interface -------------------------------
31			# getoptions(command, level) : return the optionhash for a given command
32			# parsecmdoptions(optionhashref, \@args) : parse the options, setting the
33	williamc	1.4	# Query
34	williamc	1.1	# appropriately as indicated by optionhash
35			# The option hash ref should have the
36			# format as given in example below
37			# $ohr={
38			# '-I'=> [ qw(dir >>) ],
39			# '-g'=> [ qw(debug true) ] }
40			# ( >> means take next argument as value)
41	williamc	1.2	#
42	williamc	1.1
43			package ActiveDoc::CommandLineInterface;
44	williamc	1.4	use ActiveDoc::Query;
45			use ActiveDoc::StarterDoc;
46			use ActiveDoc::UserInterface_basic;
47			#use ActiveDoc::DOChandler;
48	williamc	1.1	require 5.001;
49
50			sub new {
51			my $class=shift;
52			$self={};
53			bless $self, $class;
54			$self->init(@_);
55			return $self;
56			}
57
58			# --------------- Support Routines --------------------
59			sub init {
60			my $self=shift;
61	williamc	1.3	my $file=shift;
62	williamc	1.1	my $UI=shift;
63
64	williamc	1.3	# Set up a User Query Object
65	williamc	1.1	$self->{UI}=$UI;
66	williamc	1.4	$self->{Query}=ActiveDoc::Query->new();
67	williamc	1.1
68	williamc	1.3	# Set up our command handling object
69			eval "require $file" ;
70			die $@ if $@;
71			$self->{Commands}=$file->new($self);
72
73	williamc	1.1	$self->{errormessg}="Error : ";
74			}
75
76	williamc	1.3	sub parse {
77			my $self=shift;
78			my @args=@_;
79
80	williamc	1.4	# Get all parameters into Query
81	williamc	1.3	$self->parseoptions(@_);
82
83			# Initialise the DocHandler with what weve got so far
84	williamc	1.4	#$self->{dochandler}=ActiveDoc::DOChandler->new($self->{Query});
85			$self->{StartDoc}=ActiveDoc::StarterDoc->new($self->{Query},
86			$self->{UI} );
87	williamc	1.1
88	williamc	1.3	$self->{Commands}->parse(@_);
89
90			}
91
92	williamc	1.1	sub error {
93			my $self=shift;
94			my $string=shift;
95
96			die $self->{errormessg}.$string."\n";
97			}
98
99
100			# --------------- Interface routines --------------------
101
102
103	williamc	1.2	sub parsecmdoptions {
104	williamc	1.1	my $self=shift;
105			my $optionhashref=shift;
106	williamc	1.2	my $argref=shift;
107	williamc	1.1
108			my $option;
109
110	williamc	1.2	$option=shift @$argref;
111	williamc	1.1
112			while ( defined $option ) {
113			# deal with options
114			if ( $option=~/^\-/ ) {
115			if ( ! exists $$optionhashref{$option} ) {
116			$self->error("Unknown Option $option");
117			}
118			else {
119			# take next word as argument -- indicate by >
120			if ( $$optionhashref{$option}[1]=~/^\>\>/ ) {
121	williamc	1.4	$self->{Query}->setparam($$optionhashref{$option}[0],
122	williamc	1.2	(shift @$argref));
123	williamc	1.1	}
124			else { # simply set value as in hashref
125	williamc	1.4	$self->{Query}->setparam($$optionhashref{$option}[0],
126	williamc	1.1	$$optionhashref{$option}[1]);
127			}
128			}
129			}
130			else { # deal with commands
131	williamc	1.2	unshift @$argref, $option;
132	williamc	1.1	last;
133			}
134	williamc	1.2	$option=shift @$argref;
135	williamc	1.1	} # end while
136			}
137
138	williamc	1.2	sub parseoptions {
139			my $self=shift;
140			my @args=@_;
141
142			my $command;
143			my $commandhashref;
144			my $level;
145
146			$command='_base';
147
148			# base level
149			$level=0;
150			$commandhashref=$self->getoptions($command, $level);
151			$self->parsecmdoptions($commandhashref, \@args);
152			@{$self->{"_arg_0"}}=();
153
154
155			$self->{arglev}=$level;
156			$level++;
157
158			while ( ( $#args >= 0) && ( $level <= $#{$self->{commands}}) ) {
159			$arg=shift @args;
160			if ( exists ${$self->{commands}[$level]}{$arg} ) {
161	williamc	1.4	$self->{Query}->setparam("_cmd_$level", $arg);
162	williamc	1.2	$commandhashref=$self->getoptions($arg, $level);
163			$self->parsecmdoptions($commandhashref, \@args);
164			$self->{arglev}=$level;
165			@{$self->{"_arg_$self->{arglev}"}}=(); #initialise new arg array
166			$level++;
167			}
168			else {
169			# must be an argument to the last command
170			push @{$self->{"_arg_$self->{arglev}"}} , $arg;
171			}
172			}
173			# add any futher arguments to last argumentlist
174			push @{$self->{"_arg_$self->{arglev}"}} , @args;
175			return $self->{arglev};
176			}
177
178			sub commandlevel {
179			my $self=shift;
180			return $self->{arglev};
181			}
182
183	williamc	1.3	sub allowedcommands {
184			my $self=shift;
185			my $level=shift;
186
187			return keys %{$self->{commands}[$level]};
188			}
189
190	williamc	1.2	sub getargs {
191			my $self=shift;
192			my $level=shift;
193
194			return @{$self->{"_arg_$level"}};
195			}
196
197			sub getoptions {
198			my $self=shift;
199			my $name=shift;
200			my $level=shift;
201
202			return ${$self->{commands}[$level]}{$name};
203			}
204
205			sub setcommand {
206			my $self=shift;
207			my $name=shift;
208			my $level=shift;
209			my $optionref=shift;
210	williamc	1.3	my $commandref=shift;
211	williamc	1.2
212			${$self->{commands}[$level]}{$name}=$optionref;
213			}
214
215	williamc	1.3
216	williamc	1.2	sub setbase {
217			my $self=shift;
218			my $optionref=shift;
219
220			$self->setcommand("_base", 0 , $optionref);
221			}
222
223			sub command {
224			my $self=shift;
225			my $level=shift;
226
227	williamc	1.4	return $self->{Query}->getparam("_cmd_$level");
228	williamc	1.2	}