cvsuser 03/11/01 09:28:31
Modified: . CREDITS MANIFEST
Added: examples/assembly getopt_demo.imc
runtime/parrot/include Getopt_Long.imc
Log:
Getopt_Long.imc and demo program showing how to use this *Module*.
Courtesy of Bernhard Schmalhofer
Revision Changes Path
1.12 +1 -1 parrot/CREDITS
Index: CREDITS
===================================================================
RCS file: /cvs/public/parrot/CREDITS,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- CREDITS 31 Oct 2003 11:08:04 -0000 1.11
+++ CREDITS 1 Nov 2003 17:28:16 -0000 1.12
@@ -36,7 +36,7 @@
D: Numerous improvements and proposals.
N: Bernhard Schmalhofer
-D: Bugfixes
+D: Bugfixes, Getopt_Long.imc
N: Brent Dax
D: Configure, Parrot_sprintf, embedding, early regex engine.
1.495 +2 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.494
retrieving revision 1.495
diff -u -w -r1.494 -r1.495
--- MANIFEST 30 Oct 2003 16:38:05 -0000 1.494
+++ MANIFEST 1 Nov 2003 17:28:16 -0000 1.495
@@ -250,6 +250,7 @@
examples/assembly/coroutine.pasm [main]doc
examples/assembly/euclid.pasm [main]doc
examples/assembly/fact.pasm [main]doc
+examples/assembly/getopt_demo.imc [main]doc
examples/assembly/hanoi.pasm [main]doc
examples/assembly/hello-dwim.imc [main]doc
examples/assembly/io1.pasm [main]doc
@@ -2111,6 +2112,7 @@
runtime/parrot/dynext/README [main]doc
runtime/parrot/include/DWIM.imc [main]doc
runtime/parrot/include/README [main]doc
+runtime/parrot/include/Getopt_Long.imc [main]doc
src/byteorder.c []
src/call_list.txt [devel]doc
src/chartype.c []
1.1 parrot/examples/assembly/getopt_demo.imc
Index: getopt_demo.imc
===================================================================
#
# getopt_demo.imc
#
# Copyright (C) 2003 The Perl Foundation. All rights reserved.
# This program is free software. It is subject to the same
# license as The Parrot Interpreter.
#
# $Id: getopt_demo.imc,v 1.1 2003/11/01 17:28:24 leo Exp $
#
# Example of how to handle command line arguments with 'Getopt_Long.imc'.
# 'Getopt_Long.imc' is a library file that needs to be present in your
# library search path. Right now the parrot library search path consists of
# '.' and './runtime/parrot/include'.
#
# Usage:
# ./parrot examples/assembly/getopt_demo.imc --help
# ./parrot examples/assembly/getopt_demo.imc --version
# ./parrot examples/assembly/getopt_demo.imc --string=asdf --bool \
# --integer=42 some thing
.pcc_sub _main prototyped
.param PerlArray argv
# Assemble specification for get_options.
# This should work somewhat like Getopt::Long.
.sym PerlArray opt_spec
opt_spec = new PerlArray
# --version, boolean
push opt_spec, "version"
# --help, boolean
push opt_spec, "help"
# --bool, boolean
push opt_spec, "bool"
# --string, string
push opt_spec, "string=s"
# --integer, integer
push opt_spec, "integer=i"
# name of the interpreter and of the program
.sym string program_name
shift program_name, argv
# Make a copy of argv, because this can easier be handled in get_options
.sym PerlArray argv_clone
argv_clone = clone argv
.sym Sub get_options
get_options = newsub _get_options
.pcc_begin prototyped
.arg argv_clone
.arg opt_spec
.pcc_call get_options
ret2:
.sym PerlUndef opt
.result opt
.pcc_end
HANDLE_OPTIONS:
.sym int is_defined
# Was '--version' passed ?
is_defined = defined opt["version"]
unless is_defined goto NO_VERSION_FLAG
print "getopt_demo.imc Halloween release\n"
end
NO_VERSION_FLAG:
# Was '--help' passed ?
is_defined = defined opt["help"]
unless is_defined goto NO_HELP_FLAG
.sym Sub usage
usage = newsub _usage
.pcc_begin prototyped
.pcc_call usage
ret1:
.pcc_end
end
NO_HELP_FLAG:
# Say Hi
print "Hi, I am "
print program_name
print "\n\n"
# handle the bool option
CHECK_BOOL_OPTION:
is_defined = defined opt["bool"]
unless is_defined goto NO_BOOL_OPTION
print "You have passed the option '--bool'.\n"
goto END_BOOL_OPTION
NO_BOOL_OPTION:
print "You haven't passed the option '--bool'. This is fine with me.\n"
END_BOOL_OPTION:
# handle the string option
CHECK_STRING_OPTION:
is_defined = defined opt["string"]
unless is_defined goto NO_STRING_OPTION
.sym string string_option
string_option = opt["string"]
print "You have passed the option '--string'. The value is '"
print string_option
print "'.\n"
goto END_STRING_OPTION
NO_STRING_OPTION:
print "You haven't passed the option '--string'. This is fine with me.\n"
END_STRING_OPTION:
# handle the integer option
CHECK_INTEGER_OPTION:
is_defined = defined opt["integer"]
unless is_defined goto NO_INTEGER_OPTION
.sym string integer_option
integer_option = opt["integer"]
print "You have passed the option '--integer'. The value is '"
print integer_option
print "'.\n"
goto END_INTEGER_OPTION
NO_INTEGER_OPTION:
print "You haven't passed the option '--integer'. This is fine with me.\n"
END_INTEGER_OPTION:
# For some reason I cna't shift from argv_clone
.sym string other_arg
.sym int cnt_other_args
cnt_other_args = 0
.sym int num_other_args
num_other_args = argv_clone
goto CHECK_OTHER_ARG_LOOP
REDO_OTHER_ARG_LOOP:
other_arg = argv_clone[cnt_other_args]
print "You have passed the additional argument: '"
print other_arg
print "'.\n"
inc cnt_other_args
CHECK_OTHER_ARG_LOOP:
if cnt_other_args < num_other_args goto REDO_OTHER_ARG_LOOP
print "All args have been parsed.\n"
# Do a lot of useful stuff here
FINISH_PROGRAM:
end
.end
#
# Subroutines
#
=head1 usage( )
Print the help message.
TODO: Pass a flag for EXIT_FAILURE and EXIT_SUCCESS
=cut
.pcc_sub _usage prototyped
print "Usage: %s [OPTION]... [STRING]...\n"
print "\n"
print "Currently only long options are available.\n"
print "\n"
print "Operation modes:\n"
print " --help display this help and exit\n"
print " --version output version information and exit\n"
print "\n"
print "For demo of option parsing:\n"
print " --string=STRING a string option\n"
print " --integer=INTEGER an integer option\n"
print " --bool a boolean option\n"
.pcc_begin_return
.pcc_end_return
.end
# A dummy implementation of Getopt::Long
.include "Getopt_Long.imc"
1.1 parrot/runtime/parrot/include/Getopt_Long.imc
Index: Getopt_Long.imc
===================================================================
# Getopt_Long.imc
#
# Copyright (C) 2003 The Perl Foundation. All rights reserved.
# This program is free software. It is subject to the same
# license as The Parrot Interpreter.
#
# CVS Info: $Id: Getopt_Long.imc,v 1.1 2003/11/01 17:28:31 leo Exp $
# Overview:
# Parsing command line options.
# History:
# Ported from GNU m4 1.4
# Notes:
# References:
# http://www.gnu.org/software/m4/m4.html
=head2 void get_options( PerlArray argv, PerlArray spec )
This should work like the Perl5 module Getopt::Long.
TODO: make it work for all cases, short options, long options and bundling
TODO: regogise type of return value: string, integer, binary, array, hash
TODO: error reporting, more options
Returns a PerlHash
=cut
.pcc_sub _get_options prototyped
.param PerlArray argv
.param PerlArray spec
INIT_PARSE_SPEC: # Loop over the array spec and build up two
simple hashes
.sym PerlHash type # the type of the option: binary, string,
integer
type = new PerlHash
.sym int cnt_spec # a counter for looping over the array 'spec'
cnt_spec = 0
.sym int len_spec # for end condition of loop over 'spec'
len_spec = spec
.sym int spec_index # searching for patterns in 'spec'
.sym string opt_name # name of specified option
.sym string opt_type
goto CHECK_PARSE_SPEC
NEXT_PARSE_SPEC: # Look at next element in 'spec'
opt_name = spec[cnt_spec]
index spec_index, opt_name, '=' # when '=' is not in 'opt_name' then it's binary
if spec_index != -1 goto NOT_A_BINARY_OPTION
opt_type = 'b'
goto OPTION_TYPE_IS_NOW_KNOWN
NOT_A_BINARY_OPTION:
inc spec_index # we know where '=', thus the type is one
further
substr opt_type, opt_name, spec_index, 1
dec spec_index # Go back to the '='
substr opt_name, spec_index, 2, '' # The stuff before '=' is the option name
OPTION_TYPE_IS_NOW_KNOWN:
set type[opt_name], opt_type
inc cnt_spec
CHECK_PARSE_SPEC: # check wether loop over 'spec' is complete
if cnt_spec < len_spec goto NEXT_PARSE_SPEC
=head1 commented out
goto NO_DEBUG
$S31 = type['version']
print "version: "
print $S31
print "\n"
$S31 = type['help']
print "help: "
print $S31
print "\n"
$S31 = type['freeze-state']
print "freeze-state: "
print $S31
print "\n"
$S31 = type['reload-state']
print "reload-state: "
print $S31
print "\n"
=cut
INIT_PARSE_ARGV:
# Now that we know about the allowed options,
# we actually parse the argument vector
# TODO: do this correctly
# shift from argv until a non-option is encountered
.sym PerlHash opt # the return PMC
opt = new PerlHash
.sym string arg # element of argument array
.sym string value # element of argument array
.sym int num_remaining_args # for checking wether loop is complete
.sym int arg_index # holds result if 'index' op
.sym int is_known_option # flag wether the option is known
goto CHECK_PARSE_ARGV
NEXT_PARSE_ARGV:
# fitst we take a peek at the first remaining element
arg = argv[0]
# Is arg a option string like '--help'
index arg_index, arg, '--'
if arg_index > -1 goto HANDLE_OPTION
# We are done, and don't want to loose the nonoption argument
goto FINISH_PARSE_ARGV
HANDLE_OPTION:
# we take the current option off argv
shift arg, argv
# get rid of the leading '--'
substr arg, arg_index, 2, ''
# recover the value if any
index arg_index, arg, '='
if arg_index > -1 goto VALUE_PASSED
opt[arg] = 1
goto VALUE_OF_OPTION_IS_NOW_KNOWN
VALUE_PASSED:
inc arg_index # Go one past the '='
.sym int len_value
length len_value, arg
len_value = len_value - arg_index
substr value, arg, arg_index, len_value
# drop the '=file.m4' from '--freeze-state=file.m4'
dec arg_index
inc len_value
substr arg, arg_index, len_value, ''
opt[arg] = value
VALUE_OF_OPTION_IS_NOW_KNOWN:
# Is this a known option?
# TODO: make this work for nonbinary options
defined is_known_option, type[arg]
unless is_known_option goto UNKNOWN_OPTION
# Tell the caller that the option 'arg' has been passed
goto CHECK_PARSE_ARGV
UNKNOWN_OPTION:
# TODO: handle unknown options
print 'unknown option: !'
print arg
print "!\n"
CHECK_PARSE_ARGV:
num_remaining_args = argv
if num_remaining_args > 0 goto NEXT_PARSE_ARGV
FINISH_PARSE_ARGV:
# Nothing to do here
.pcc_begin_return
.return opt
.pcc_end_return
.end
