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} );

        # call method on CommandObject
        $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.5
Committed:	Thu Jan 20 18:18:45 2000 UTC (25 years, 3 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	v102p1, V1_0_1, V1_0_0, V1_pre0, SCRAM_V1, SCRAMV1_IMPORT, V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1, V0_19_0, V0_18_5, V0_18_4, V_18_3_TEST, VO_18_3, V0_18_2, V0_18_1, ProtoEnd
Branch point for:	V1_pre1, SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.4:	+3 -2 lines
Log Message:	HIP additions
#	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	williamc	1.5	# $self->{StartDoc}=ActiveDoc::StarterDoc->new($self->{Query},
86	williamc	1.4	$self->{UI} );
87	williamc	1.1
88	williamc	1.5	# call method on CommandObject
89	williamc	1.3	$self->{Commands}->parse(@_);
90
91			}
92	williamc	1.5
93	williamc	1.1	sub error {
94			my $self=shift;
95			my $string=shift;
96
97			die $self->{errormessg}.$string."\n";
98			}
99
100
101			# --------------- Interface routines --------------------
102
103
104	williamc	1.2	sub parsecmdoptions {
105	williamc	1.1	my $self=shift;
106			my $optionhashref=shift;
107	williamc	1.2	my $argref=shift;
108	williamc	1.1
109			my $option;
110
111	williamc	1.2	$option=shift @$argref;
112	williamc	1.1
113			while ( defined $option ) {
114			# deal with options
115			if ( $option=~/^\-/ ) {
116			if ( ! exists $$optionhashref{$option} ) {
117			$self->error("Unknown Option $option");
118			}
119			else {
120			# take next word as argument -- indicate by >
121			if ( $$optionhashref{$option}[1]=~/^\>\>/ ) {
122	williamc	1.4	$self->{Query}->setparam($$optionhashref{$option}[0],
123	williamc	1.2	(shift @$argref));
124	williamc	1.1	}
125			else { # simply set value as in hashref
126	williamc	1.4	$self->{Query}->setparam($$optionhashref{$option}[0],
127	williamc	1.1	$$optionhashref{$option}[1]);
128			}
129			}
130			}
131			else { # deal with commands
132	williamc	1.2	unshift @$argref, $option;
133	williamc	1.1	last;
134			}
135	williamc	1.2	$option=shift @$argref;
136	williamc	1.1	} # end while
137			}
138
139	williamc	1.2	sub parseoptions {
140			my $self=shift;
141			my @args=@_;
142
143			my $command;
144			my $commandhashref;
145			my $level;
146
147			$command='_base';
148
149			# base level
150			$level=0;
151			$commandhashref=$self->getoptions($command, $level);
152			$self->parsecmdoptions($commandhashref, \@args);
153			@{$self->{"_arg_0"}}=();
154
155
156			$self->{arglev}=$level;
157			$level++;
158
159			while ( ( $#args >= 0) && ( $level <= $#{$self->{commands}}) ) {
160			$arg=shift @args;
161			if ( exists ${$self->{commands}[$level]}{$arg} ) {
162	williamc	1.4	$self->{Query}->setparam("_cmd_$level", $arg);
163	williamc	1.2	$commandhashref=$self->getoptions($arg, $level);
164			$self->parsecmdoptions($commandhashref, \@args);
165			$self->{arglev}=$level;
166			@{$self->{"_arg_$self->{arglev}"}}=(); #initialise new arg array
167			$level++;
168			}
169			else {
170			# must be an argument to the last command
171			push @{$self->{"_arg_$self->{arglev}"}} , $arg;
172			}
173			}
174			# add any futher arguments to last argumentlist
175			push @{$self->{"_arg_$self->{arglev}"}} , @args;
176			return $self->{arglev};
177			}
178
179			sub commandlevel {
180			my $self=shift;
181			return $self->{arglev};
182			}
183
184	williamc	1.3	sub allowedcommands {
185			my $self=shift;
186			my $level=shift;
187
188			return keys %{$self->{commands}[$level]};
189			}
190
191	williamc	1.2	sub getargs {
192			my $self=shift;
193			my $level=shift;
194
195			return @{$self->{"_arg_$level"}};
196			}
197
198			sub getoptions {
199			my $self=shift;
200			my $name=shift;
201			my $level=shift;
202
203			return ${$self->{commands}[$level]}{$name};
204			}
205
206			sub setcommand {
207			my $self=shift;
208			my $name=shift;
209			my $level=shift;
210			my $optionref=shift;
211	williamc	1.3	my $commandref=shift;
212	williamc	1.2
213			${$self->{commands}[$level]}{$name}=$optionref;
214			}
215
216	williamc	1.3
217	williamc	1.2	sub setbase {
218			my $self=shift;
219			my $optionref=shift;
220
221			$self->setcommand("_base", 0 , $optionref);
222			}
223
224			sub command {
225			my $self=shift;
226			my $level=shift;
227
228	williamc	1.4	return $self->{Query}->getparam("_cmd_$level");
229	williamc	1.2	}