[Moss-devel] CVS: moss/rmc/src/rmcgen/Getopt-Declare-1.08 Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 README,NONE,1.1 demo_cmdline,NONE,1.1 demo_csv,NONE,1.1 demo_interp,NONE,1.1 demo_shell,NONE,1.1 test.pl,NONE,1.1

[Alexander Feder <address@hidden>]

Update of /cvsroot/moss/moss/rmc/src/rmcgen/Getopt-Declare-1.08
In directory subversions:/tmp/cvs-serv2212/src/rmcgen/Getopt-Declare-1.08

Added Files:
        Changes MANIFEST Makefile.PL README demo_cmdline demo_csv 
        demo_interp demo_shell test.pl 
Log Message:
added rmc


--- NEW FILE ---
Revision history for Perl extension Getopt::Declare.

1.03    Thu Apr 30 19:51:27 1998

        - first semi-public release


1.04    Wed Jun 17 14:37:22 1998

        - Extended -AWK grammar to recognize <var>=''

        - Fixed code generator so that actions actually do
          execute in the caller's package, as documented.

        - Changed 1st arg type of finish and reject to 
          simple scalar. Made arg optional (omitted -> true)

        - Fixed handling of defer, reject and finish so that
          they work as expected


1.05    Thu Aug 27 16:35:26 1998

        - Added code to reset $_VAL_ each time a parameter matches

        - Added a test.pl


1.06    Mon Nov  2 06:21:38 1998

        - Made detection of strictness more robust (in line with
          change (bug?) in list construction behaviour in 5.005_02)

        - Added workarounds for weird behaviour of pod2man


1.07    Tue Mar 23 16:25:20 1999

        - Changed behaviour of [ditto] when ditto'ing multiline
          descriptions (now prints: "Same as <prevflag>" instead)

        - Fixed bug in handling of version flag (which made every
          argument beginning with -v... into a version flag)

        - Shifted all internal entries of the Getopt::Declare hash
          into an anonymous hash in the entry "_internal".

        - Patched the Makefile.PL to note dependencies (thanks Roland)

        - Altered parsing of [strict] so that it's ignored when 
          commented out.


1.08    Fri May 21 06:17:04 1999

        - Now only generates .CODE file if $::Declare_debug is true

        - Added Text::Balanced as PREREQ to Makefile.PL

        - Moved mutex test earlier in parameter parsing to
          correct an error that caused mutexing to be ignored
          (thanks Eric)

        - Fixed hanging when last line was non-NL-terminated
          (thanks David)

--- NEW FILE ---
Changes
MANIFEST
Makefile.PL
demo_csv
demo_interp
demo_shell
demo_cmdline
lib/Getopt/Declare.pm
lib/Getopt/Declare.pod
test.pl

--- NEW FILE ---

use ExtUtils::MakeMaker;
WriteMakefile(
                NAME    => 'Getopt::Declare',
                VERSION => '1.08',
             );

--- NEW FILE ---
==============================================================================
                  Release of version 1.08 of Getopt::Declare
==============================================================================

DESCRIPTION

Getopt::Declare is *yet another* command-line argument parser, one which
is specifically designed to be powerful but exceptionally easy to use.

To parse the command-line in address@hidden', one simply creates a
Getopt::Declare object, by passing `Getopt::Declare::new()' a
specification of the various parameters that may be encountered:

    $args = new Getopt::Declare($specification);

The specification is a single string such as this:

    $specification = q(

            -a              Process all data

            -b <N:n>        Set mean byte length threshold to <N>
                                    { bytelen = $N; }

            +c <FILE>       Create new file <FILE>

            --del           Delete old file
                                    { delold() }

            delete          [ditto]

            e <H:i>x<W:i>   Expand image to height <H> and width <W>
                                    { expand($H,$W); }

            -F <file>...    Process named file(s)
                                    { defer {for (@file) {process()}} }

            =getrand [<N>]  Get a random number
                            (or, optionally, <N> of them)
                                    { $N = 1 unless defined $N; }

            --              Traditionally indicates end of arguments
                                    { finish }
    );

in which the syntax of each parameter is declared, along with a
description and (optionally) one or more actions to be performed when
the parameter is encountered. The specification string may also include
other usage formatting information (such as group headings or
separators) as well as standard Perl comments (which are ignored).

Calling Getopt::Delare::new() parses the contents of the array
@ARGV, extracting any arguments which match the parameters defined in
the specification string, and storing the parsed values as hash elements
within the new Getopt::Declare object being created.

Other features of the Getopt::Declare package include:

        * The use of full Perl regular expressions to constrain
          matching of parameter components.

        * Automatic generation of error, usage and version information.

        * Optional conditional execution of embedded actions (i.e. only
          on successful parsing of the entire command-line)

        * Strict or non-strict parsing (unrecognized command-line
          elements may either trigger an error or may simply be left in
          @ARGV)

        * Declarative specification of various inter-parameter
          relationships (for example, two parameters may be declared
          mutually exclusive and this relationship will then be
          automatically enforced).

        * Intelligent clustering of adjacent flags (for example: the
          command-line sequence "-a -b -c" may be abbreviated to
          "-abc", unless there is also a `-abc' flag declared).

        * Selective or global case-insensitivity of parameters.

        * The ability to parse files (especially configuration files)
          instead of the command-line.

Note: requires the Text::Balanced module


==============================================================================

CHANGES IN VERSION 1.08


        - Now only generates .CODE file if $::Declare_debug is true

        - Added Text::Balanced as PREREQ to Makefile.PL

        - Moved mutex test earlier in parameter parsing to
          correct an error that caused mutexing to be ignored
          (thanks Eric)

        - Fixed hanging when last line was non-NL-terminated
          (thanks David)


==============================================================================

AVAILABILITY

Getopt::Declare has been uploaded to the CPAN
and is also available from:

        http://www.cs.monash.edu.au/~damian/CPAN/Getopt-Declare.tar.gz

==============================================================================

--- NEW FILE ---
#! /usr/local/bin/perl -w

use Getopt::Declare;

$VERSION = "1.00b";

my $config;

$config = new Getopt::Declare( <<'EOCONFIG', [-CONFIG]);
        [strict]
        min = <n>       Minimum value [required]
        max = <n>       Maximum value
EOCONFIG

print "min: ", $config->{min}{'<n>'}, "\n" if $config->{min};
print "max: ", $config->{max}{'<n>'}, "\n" if $config->{max};

$args = new Getopt::Declare <<'EOARGS';
General options:

        -e <f:i>..<t:i> Set expansion factor to specified range
                        [requires: <file>]
                                { print "k = [$f..$t]\n"; }

        -e [<k:n>...]   Set expansion factor to <k> (or 2 by default)
                        [required]
                                { @k = (2) unless @k;
                                  print "k = [", join(',', @k), "]\n"; }


        -b <blen:i>     Use byte length of <blen> 
                        [excludes: -a +c]
                                { print "byte len: $blen\n"; }

        <file>...       Process files [required] [implies: -a]
                                { print "files: address@hidden"; }

        -a [<N:n>]      Process all data [except item <N>]
                                { print "proc all\n"; print "except $N\n" if 
$N; }

        -fab            The fabulous option (is always required :-)
                        [required]
                                { defer { print "fabulous!\n" } }

File creation options:

        +c <file>       Create file [mutex: +c -a]
                                { print "create: $file\n"; }

        +d <file>       Duplicate file [implies: -a and -b 8]
                        This is a second line
                                { print "dup (+d) $file\n"; }
        --dup <file>    [ditto] (long form)
#                               { print "dup (--dup) $file\n"; }

        -how <N:i>      Set height to <N>       [repeatable]

Garbling options:

        -g [<seed:i>]   Garble output with optional seed [requires: +c]
                                { print "garbling with $seed\n"; }

        -i              Case insensitive garbling [required]
                                { print "insensitive\n"; }
        -s              Case sensitive garbling 
        -w              WaReZ m0De 6aRBL1N6 

        [mutex: -i -s -w]
EOARGS

print "Unused:\n" if @ARGV;
foreach ( @ARGV )
{
        print "\t[$_]\n";
}

#$args->debug();
#$args->usage();
__END__

--- NEW FILE ---
#!/usr/local/bin/perl -w


use Getopt::Declare;

my $args = new Getopt::Declare <<EOARGS;
        -f <filename:if>        Parse file <filename>
EOARGS

@students = ();
@absent = ();

$data = q{
        absmith,1234567,20
        "aesmith, the other one",7635656,DNS
        cat,dog,22.2
        7637843,dejones,66.7
        rmwilliams,288721,88
        help me,I'm trapped,in the marks system
        vtthan,872829,94
};

my $csv = <<'EOCSV';
        <name:qs> , <id:+i> , <score:0+n>       STD FORMAT [repeatable]
                { push @::students, {name=>$name, id=>$id, score=>$score} }

        <id:+i> , <name:qs> , <score:0+n>       VARIANT FORMAT [repeatable]
                { push @::students, {name=>$name, id=>$id, score=>$score} }

        <name:qs> , <id:+i> , DNS               DID NOT SIT [repeatable]
                { push @::absent, {name=>$name, id=>$id, score=>0} }

        <other:/.+/>                            SOMETHING ELSE [repeatable]
                { print "Unknown entry format: [$other]\n"; }
EOCSV

if ($args->{"-f"})
{
        my $args = new Getopt::Declare ($csv,[$args->{"-f"}]);
}
else
{
        my $args = new Getopt::Declare ($csv,$data);
}

foreach ( @students )
{
        print "$_->{id} ($_->{name}):   $_->{score}\n";
}

foreach ( @absent )
{
        print "$_->{id} ($_->{name}):   ABSENT\n";
}

--- NEW FILE ---
#!/usr/local/bin/perl -w

use Getopt::Declare;
use vars qw{ $name $result $n };

my $interpolator = new Getopt::Declare (<<'EOCMDS',[-BUILD]);
        [cluster:none]
        [repeatable]
        [pvtype: NOTDELIM /(?:%T.)+/ ]
        [pvtype: WS   /\s+/ ]

        \{{ <cmd:NOTDELIM> }}[<ws:WS>]  
                        { $self->{result} .= eval "no strict; $cmd"||'';
                          $self->{result} .= $ws if $ws; }

        <str>[<ws:WS>]  
                        { $self->{result} .= $str;
                          $self->{result} .= $ws if $ws; }
EOCMDS

sub interpolate($)
{
        $interpolator->{result} = '';
        $interpolator->parse($_[0]);
        return $interpolator->{result};
}


$result = 22;
$name = "Sam";
$n = 50;
sub average
{
        my ($sum, $count) = (0,0);
        foreach ( @_ ) { $sum += $_; $count++; }
        return $count ? $sum/$count : 0;
}

print interpolate('The person {{$name}} scored {{$result}}'), "\n";
print interpolate('The pass mark was {{$result * 2}}'), "\n";
print interpolate('The average of the first {{2*$n}} numbers is {{average 
1..2*$n}}'), "\n";

--- NEW FILE ---
#!/usr/local/bin/perl -w


use Getopt::Declare;

my $shell_cmds = <<'EOCMDS';
Commands: [repeatable]

        echo [-n] <words:/.*/>  ECHO WITHOUT NEWLINE 
                        { print $words; print "\n" unless $_PUNCT_{'-n'}; }

        [pvtype: chwho /u?g?a?/]
        [pvtype: chwhat /r?w?x?/]

        chmod [-R] <who:chwho>=<what:chwhat> <files>... 
                                CHANGE FILE PERMISSIONS 
                        { foreach (@files) { print "chmod $who=$what $_\n"; }
                        }

        help                    SHOW THIS SUMMARY 
                        { $self->usage() }

        exit                    EXIT SHELL 
                        { exit }

        <error:/.*/>     
                        { print "Unknown command: $error\n";
                          print "(Try the 'help' command?)\n"; }
EOCMDS

my $shell = new Getopt::Declare ($shell_cmds,[-BUILD]);

my $count = 1;
sub prompt { print "$count> "; $count++; return <STDIN> }

$shell->parse(\&prompt);

--- NEW FILE ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..10\n"; }
END {print "not ok 1\n" unless $loaded;}
use Getopt::Declare;
$::loaded = 1;
print "ok 1\n";
my $count=2;

use strict;

sub ok
{
        print "not " if defined($_[0]) && !$_[0];
        print "ok $count\n";
        $count++;
}

sub debug { print @_ if 0 }

######################### End of black magic.

@ARGV = ("bee",'BB BB',
         "-aA", "s e e",
         "remainder",
         '+d', '1', '2', '3', '-1',
         '-yz',
         '+d', '1', '2', '3', '-1', 'a'
        );

my $args = new Getopt::Declare (q
{
        -a <aval>       option 1
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        bee <bval:qs>   option 2
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        <c>             option 3
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        +d <dval:n>...  option 4 [repeatable]
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        -1              option 5
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        <d>             option 6
                                { ::debug "rejected $_PARAM_\t($_VAL_)\n" }
                                { reject }
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        -y              option 7
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

        -z              option 8
                                { ::debug "matched $_PARAM_\t($_VAL_)\n" }

});

ok $args;
ok $args->{-a} eq "A";
ok $args->{bee} eq "BB BB";
ok $args->{"<c>"} eq "s e e";
ok join(',',@{$args->{'+d'}}) eq '1,2,3,1,2,3';
ok !($args->{'<d>'});
ok $args->{'-1'};
ok @ARGV==3;
ok $ARGV[0] eq 'remainder';