hi all,

after having no further progress with GD, as I'm not greatly experienced in
C, I felt like an easier challenge. Installing Parse::Yapp today I found
one...

For ages it's annoyed me that Getopt::Std just assumes that there's a
command line. The 'yapp' program uses getopts(), and this made me wonder
'how can I make this Mac-friendly'.

Basically I inserted a routine in Getopt::Std that pops-up a box into which
the user can type some options. Those options are processed into an array
(like the shell would do), and the option processing continues as normal
from there. It's totally invisible to the calling program (unless it
examines @ARGV before calling getopts() )

The module is attached, and below is the relevant bit of POD. Any comments
or suggestions would be appreciated. I did this for my own benefit but I
guess it'd be useful for anyone.

One thing I noticed is that if I edit a script in BBEdit, then run it, I
get the spinning beachball, and the machine almost freezes, because MacPerl
is waiting for me to type into a dialog box. I had half-expected the apps
menu icon to flash, alerting me to the fact that MacPerl needs my
attention. However after a lot of clicking you can bring MacPerl to the
front.

Also attached is a little droplet that shows how any files dropped on the
program are saved and put at the end of @ARGV after the command-line
options.

P

>>>>>POD>>>>>>
MAC-SPECIFIC IMPLEMENTATION

On MacOS under MacPerl there really isn't a command-line on which to enter
your options, so this module inserts a step into the getopts() and getopt()
routines which prompts the user for a set of command line options.

The user is presented with a dialog box in which they type whatever they
would have put on the command line after the program name. No variable
interpolation is done, nor any wildcards expanded. The only special
treatment is given to quoted strings. Whitespace outside quoted strings is
ignored.

An option may be surrounded by single-quotes (the ' character) only. As
usual, you may use the backslash to escape the single-quote character and
the backslash.

Here are some examples of the typed input, inside the double-quotes, and
the lists of arguments they yield:

        You type: "-r 5 -x 23"

                Parsed as: '-r', '5', '-x', '23'

        You type: "     -r       '5'    -x   23   "

                Parsed as: '-r', '5', '-x', '23'

        You type: "-f 'file name' -r -w 'print \'hello\''"

                Parsed as: '-f', 'file name', '-r', '-w', "print 'hello'"

        You type: "-q '\''    -e '\\  \\'   -l   '\n'"

                Parsed as: '-q', "'", '-e', '\  \', '-l', 'n'

Note in that last one how '\n' was literally an 'n', not a newline. The
backslash simply says 'take the next character literally'.

If your perl program is saved as a droplet, MacPerl allows you to drag&drop
files onto the icon - the filenames are put into @ARGV. This module saves
that list of filenames and puts it after the command line options, hence
the filenames will be left in @ARGV after getopt/getopts have been called,
which is what you'd expect.
<<<<<<END<<<<<<
package Getopt::Std;
require 5.000;
require Exporter;

=head1 NAME

getopt - Process single-character switches with switch clustering

getopts - Process single-character switches with switch clustering

=head1 SYNOPSIS

    use Getopt::Std;

    getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
    getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
                      # Sets opt_* as a side effect.
    getopts('oif:', \%opts);  # options as above. Values in %opts

=head1 DESCRIPTION

The getopt() functions processes single-character switches with switch
clustering.  Pass one argument which is a string containing all switches
that take an argument.  For each switch found, sets $opt_x (where x is the
switch name) to the value of the argument, or 1 if no argument.  Switches
which take an argument don't care whether there is a space between the
switch and the argument.

Note that, if your code is running under the recommended C<use strict
'vars'> pragma, you will need to declare these package variables
with "our":

    our($opt_foo, $opt_bar);

For those of you who don't like additional global variables being created,
getopt()
and getopts() will also accept a hash reference as an optional second
argument.
Hash keys will be x (where x is the switch name) with key values the value of
the argument or 1 if no argument is specified.

To allow programs to process arguments that look like switches, but aren't,
both functions will stop processing switches when they see the argument
C<-->.  The C<--> will be removed from @ARGV.

=cut

@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
$VERSION = '1.02';

# Process single-character switches with switch clustering.  Pass one argument
# which is a string containing all switches that take an argument.  For each
# switch found, sets $opt_x (where x is the switch name) to the value of the
# argument, or 1 if no argument.  Switches which take an argument don't care
# whether there is a space between the switch and the argument.

# Usage:
#       getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.

sub getopt ($;$) {
        _macMakeArgv() if $^O =~ /MacOS/;
    local($argumentative, $hash) = @_;
    local($_,$first,$rest);
    local @EXPORT;

    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        if (/^--$/) {   # early exit if --
            shift @ARGV;
            last;
        }
        if (index($argumentative,$first) >= 0) {
            if ($rest ne '') {
                shift(@ARGV);
            }
            else {
                shift(@ARGV);
                $rest = shift(@ARGV);
            }
            if (ref $hash) {
                $$hash{$first} = $rest;
            }
            else {
                ${"opt_$first"} = $rest;
                push( @EXPORT, "\$opt_$first" );
            }
        }
        else {
            if (ref $hash) {
                $$hash{$first} = 1;
            }
            else {
                ${"opt_$first"} = 1;
                push( @EXPORT, "\$opt_$first" );
            }
            if ($rest ne '') {
                $ARGV[0] = "-$rest";
            }
            else {
                shift(@ARGV);
            }
        }
    }
    unless (ref $hash) {
        local $Exporter::ExportLevel = 1;
        import Getopt::Std;
    }
}

# Usage:
#   getopts('a:bc');    # -a takes arg. -b & -c not. Sets opt_* as a
#                       #  side effect.

sub getopts ($;$) {
        _macMakeArgv() if $^O =~ /MacOS/;
    local($argumentative, $hash) = @_;
    local(@args,$_,$first,$rest);
    local($errs) = 0;
    local @EXPORT;

    @args = split( / */, $argumentative );
    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        if (/^--$/) {   # early exit if --
            shift @ARGV;
            last;
        }
        $pos = index($argumentative,$first);
        if ($pos >= 0) {
            if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
                shift(@ARGV);
                if ($rest eq '') {
                    ++$errs unless @ARGV;
                    $rest = shift(@ARGV);
                }
                if (ref $hash) {
                    $$hash{$first} = $rest;
                }
                else {
                    ${"opt_$first"} = $rest;
                    push( @EXPORT, "\$opt_$first" );
                }
            }
            else {
                if (ref $hash) {
                    $$hash{$first} = 1;
                }
                else {
                    ${"opt_$first"} = 1;
                    push( @EXPORT, "\$opt_$first" );
                }
                if ($rest eq '') {
                    shift(@ARGV);
                }
                else {
                    $ARGV[0] = "-$rest";
                }
            }
        }
        else {
            warn "Unknown option: $first\n";
            ++$errs;
            if ($rest ne '') {
                $ARGV[0] = "-$rest";
            }
            else {
                shift(@ARGV);
            }
        }
    }
    unless (ref $hash) {
        local $Exporter::ExportLevel = 1;
        import Getopt::Std;
    }
    $errs == 0;
}

sub _macMakeArgv {
        my $input = MacPerl::Ask('Enter command line options, \'-quoted if
needed');
        $input =~ s/\s+$//;
        my @saveARGV = @ARGV;   # if we're a droplet, this saves the
filenames dropped on us
        @ARGV = ();

        # we need to tokenize, can't just use split()
        while (length($input)) {
                $input =~ s/^\s+//;
#               print "Input is <$input>\n";
                if ($input =~ s/^([^']\S*)\s*//) {
                        # bare token
                        push @ARGV, $1;
                } elsif ($input =~ s/^'//) {
                        my $esc = 0;
                        my $str = '';

                        while (length($input)) {
                                my $c;
                                $input =~ s/^(.)/ $c = $1; ''; /e;      #
eat the first character
                                # escaped characters
                                if ($esc) {
                                        $str .= $c;
                                        $esc = 0;
                                        next;
                                }
                                # the escape character
                                if ($c eq '\\') {
                                        $esc = 1;
                                        next;
                                }
                                # the quote character
                                if ($c eq "'") {
                                        last;
                                }
                                # all other characters
                                $str .= $c;
                        }
                        push @ARGV, $str;
                } else {
                        warn "Can't happen: $input";
                }
        }
        push @ARGV, @saveARGV;  # ...and add those filenames back in
#       use Data::Dumper; $Data::Dumper::Indent = 0; print Dumper \@ARGV;
}

=head1 MAC-SPECIFIC IMPLEMENTATION

On MacOS under MacPerl there really isn't a command-line on which to enter your
options, so this module inserts a step into the getopts() and getopt() routines
which prompts the user for a set of command line options.

The user is presented with a dialog box in which they type whatever they
would have
put on the command line after the program name. No variable interpolation
is done,
nor any wildcards expanded. The only special treatment is given to quoted
strings.
Whitespace outside quoted strings is ignored.

An option may be surrounded by single-quotes (the ' character) only. As
usual, you
may use the backslash to escape the single-quote character and the backslash.

Here are some examples of the typed input, inside the double-quotes, and the
lists of arguments they yield:

=over 4

=item You type: "-r 5 -x 23"

Parsed as: '-r', '5', '-x', '23'

=item You type: "     -r       '5'    -x   23   "

Parsed as: '-r', '5', '-x', '23'

=item You type: "-f 'file name' -r -w 'print \'hello\''"

Parsed as: '-f', 'file name', '-r', '-w', "print 'hello'"

=item You type: "-q '\''    -e '\\  \\'   -l   '\n'"

Parsed as: '-q', "'", '-e', '\  \', '-l', 'n'

=back

Note in that last one how '\n' was literally an 'n', not a newline. The
backslash
simply says 'take the next character literally'.

If your perl program is saved as a droplet, MacPerl allows you to drag&drop
files onto
the icon - the filenames are put into @ARGV. This module saves that list of
filenames
and puts it after the command line options, hence the filenames will be left in
@ARGV after getopt/getopts have been called, which is what you'd expect.

=cut

1;
--
[EMAIL PROTECTED]                         "all the world's indeed a stage"
http://www.pkent.me.uk/              For PGP see the keyservers or website
http://www.selsyn.co.uk/
Fax: Britain 0870 137 9220 - America (208) 692-8600

Reply via email to