Getopt::AsDocumented - declare options as pod documentation

Getopt-AsDocumented documentation Contained in the Getopt-AsDocumented distribution.

Index

Code Index:

NAME

Top

Getopt::AsDocumented - declare options as pod documentation

SYNOPSIS

Top

  =head1 Options
  ...
  =item -w, --what WHAT

  =cut

  sub main {
    my $opt = Getopt::AsDocumented->process(\@args) or return;

    my $what = $opt->what;
    ...
  }

About

Top

This module allows you to declare your program's command-line options as pod documentation. It provides syntax to declare types and defaults in a way which is also readable as documentation.

Note: This is built on Getopt::Base and some advanced features are still growing. Your help is welcome.

Methods

Top

process

Loads the pod from your current file and processes the command-line arguments.

  my $opt = Getopt::AsDocumented->process(\@args) or return;

Option Specification

Top

With/Without Opterands

If an option is followed by a word, it requires an opterand.

  =item --foo FOO

Otherwise, it is a simple flag (boolean) option

  =item --foo

Booleans

Each boolean option will automatically generate a '--no-' form which negates it. You may choose to mention this and/or link aliases to it.

  =item --foo

  Sets the fooness.

  =item -x, --ex-foo, --no-foo

Types

Non-boolean options may be typed as strings, numbers, or integers. The type is included in parenthesis after the option spec. If the type is not mentioned, it defaults to string.

integer

An integer.

  =item --foo FOO (integer)

number

A floating-point number.

  =item --foo FOO (number)

string

A string. This is the default, but may be included for clarity.

  =item --foo FOO (string)

Scalar/HASH/ARRAY

Any non-boolean option can take one of the following forms.

Scalar

An option followed by a simple word means that only one value is assigned to it (if the user repeats it, a prior value is overwritten.)

  =item --foo FOO

HASH

A HASH option is followed by something of the form \w+=.*. Each opterand is treated as a $key=$value pair.

  =item --foo BAR=BAZ

LIST

A LIST option is followed by another mention of itself within [] brackets with an ellipsis to indicate optional additional elements.

  =item --foo FOO [--foo ...]

If a list option requires an explicit type, this must be included after the bracketed text.

  =item --foo FOO [--foo ...] (integer)

Handlers

Top

config_file_handler

Loads the user's configuration file. All of the values from the configuration will be loaded into the options object before any options from the command-line are processed.

  $go->config_file_handler;

load_config_file

  $self->load_config_file($file);

make_object

Wraps the super method in order to load the config file.

  $obj = $self->make_object;

version_handler

Prints the version from your handler/caller()'s package.

  $go->version_handler;

Sets the quit flag.

help_handler

Prints a help message based on the USAGE and OPTIONS sections from your pod. Uses the first sentence from each =item section, or alternatively: =for help content found within the =item section.

  $go->help_handler;

Sets the quit flag.

Other Methods

Top

new

  my $go = Getopt::AsDocumented->new(%settings);
pod => $string
from_file => $filename
handler => $classname
  $self->_init(%setup);

AUTHOR

Top

Eric Wilhelm @ <ewilhelm at cpan dot org>

http://scratchcomputing.com/

BUGS

Top

If you found this module on CPAN, please report any bugs or feature requests through the web interface at http://rt.cpan.org. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

If you pulled this development version from my /svn/, please contact me directly.

COPYRIGHT

Top

Copyright (C) 2009 Eric L. Wilhelm, All Rights Reserved.

NO WARRANTY

Top

Absolutely, positively NO WARRANTY, neither express or implied, is offered with this software. You use this software at your own risk. In case of loss, no person or entity owes you anything whatsoever. You have been warned.

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Getopt-AsDocumented documentation Contained in the Getopt-AsDocumented distribution. 
package Getopt::AsDocumented;
$VERSION = v0.0.1;

use warnings;
use strict;
use Carp;

use base 'Getopt::Base';


sub process {
  my $self = shift;
  my $args = shift;
  (@_ % 2) and croak("odd number of elements in \%settings");
  my %also = @_;
  $self = $self->new(%also) unless(ref $self);

  return $self->SUPER::process($args);
} # process ############################################################


sub config_file_handler {
  my $self = shift;
  my ($file) = shift;
  $self->load_config_file($file);
} # config_file_handler ################################################


sub load_config_file {
  my $self = shift;
  my ($file) = @_;

  my $mod = sub {
    foreach my $m (qw(YAML::XS YAML::Syck YAML)) {
      eval("require $m") and return($m);
    }
    croak("cannot load any yaml module $@");
  }->();
  croak("what?") unless($mod);

  my $loader = $mod->can('LoadFile');

  my ($data) = $loader->($file);
  $self->set_values(%$data);
} # load_config_file ###################################################


sub make_object {
  my $self = shift;
  my $obj = $self->SUPER::make_object(@_);

  if(my $do = $obj->can('config_file')) {
    if(my $file = $do->($obj)) {
      local $self->{object} = $obj; # must have a context
      $self->load_config_file($file) if(-e $file);
    }
  }

  return($obj);
} # make_object ########################################################


sub version_handler {
  my $self = shift;

  my $caller = $self->{handler};
  $caller = ref($caller) || $caller;
  eval {require version}; # for stringy VERSION() support (I hope)
  my $v = $caller->VERSION || main->VERSION || '<undefined>';
  require File::Basename;
  print File::Basename::basename($0), " version $v\n";
  $self->quit;
} # version_handler ####################################################


sub help_handler {
  my $self = shift;
  print "Usage:\n", $self->{usage}, "\n\n";

  my @options = map({
    my $d = $self->{opt_data}{$_};
    my $type = $d->{type};
    [
    $self->{help_bits}{$_} .
    (($type ne 'boolean' and $type ne 'string') ?
      (' (' . substr($type, 0, 3) . ')') : '')
    ,
    $self->{help}{$_}
    ]
  } @{$self->{help_order}});
  my ($longest) = sort({$b <=> $a} map({length($_->[0])} @options));
  @options = map({sprintf('%-'.$longest."s  %s", @$_)} @options);
  print join("\n  ",
    "Options:", @options
    ), "\n";

  $self->quit;
} # help_handler #######################################################


sub new {
  my $class = shift;
  (@_ % 2) and croak("odd number of elements in \%settings");
  my %setup = @_;

  my %pass;
  foreach my $key (qw(arg_handler)) {
    $pass{$key} = delete($setup{$key}) if(exists($setup{$key}));
  }

  my $self = $class->SUPER::new(%pass);

  $self->_init(%setup);

  return($self);
} # new ################################################################



sub _init {
  my $self = shift;
  my %setup = @_;

  my $fh;
  if(my $pod = $setup{pod}) {
    open($fh, '<', \$pod) or croak("cannot open string $!");
  }
  else {
    my $file = $setup{from_file} || (caller(2))[1];
    # TODO allow searching @INC?
    open($fh, '<', $file) or croak("cannot open '$file' $!");
  }

  # TODO check this against the =for getopt_handler ... case
  $self->{handler} = $setup{handler} || (caller(2))[0];

  $self->{help_order} = [];

  my $parser = Getopt::AsDocumented::PodParser->new;
  $parser->{__go} = $self;
  $parser->{__the_fh} = $fh;
  $parser->parse_from_filehandle($fh);
} # _init ##############################################################

{
package Getopt::AsDocumented::PodParser;
use base 'Pod::Parser';

sub command {
  my ($self, $command, $p) = @_;

  $p =~ s/\n+$//;

  #warn "-- ", $p, "\n";
  if($command =~ m/^head/) {
    if($self->{__options}) {
      # done
      $self->__store_last;
      return seek($self->{__the_fh}, 0, 2);
    }
    elsif($p =~ m/^options$/i) {
      $self->{__options} = {};
    }
    elsif($p =~ m/^usage$/i) {
      #warn "usage: $p";
      $self->{__usage} = $p;
    }
    return;
  }
  # hmm, we also need to ditch any directives which aren't in the Usage
  # or Options sections

  $self->{__options} or return;  # not there yet

  if($command eq 'item') {
    $self->__store_last;

    my %setup;

    my @opts;
    while($p =~ s/^([^ ,]+)(,?)(?: |$)//) {
      push(@opts, $1); last unless($2);
    }

    # number|integer|string type
    if($p =~ s/ \(([^ ]+)\)$//) { $setup{type} = $1; }

    $setup{help_bit} = join(', ', @opts) . ($p ? ' '.$p : '');

    # list/hash form detection
    if($p =~ s/ \[--[^ ]+ \.\.\.\]$//) {
      $setup{form} = 'ARRAY';
    }
    elsif($p =~ m/^\w+=/) {
      $setup{form} = 'HASH';
    }

    # warn "    stuff($p)\n" if($p);
    $setup{example} = $p if($p);
    if($p) {
      $setup{type} ||= 'string';
    }
    else {
      $setup{type} = 'boolean';
    }

    # parse-out the various short and alias forms
    # the last one is the canonical form
    my @short;
    my @long;
    foreach my $opt (@opts) {
      if($opt =~ s/^--//) {
        $opt =~ s/-/_/g;
        push(@long, $opt);
      }
      else {
        $opt =~ s/^-// or croak("'$opt' must have a leading dash");
        (length($opt) == 1) or Carp::croak("'$opt' malformed");
        push(@short, $opt);
      }
    }

    my $canon = pop(@long);

    if($canon =~ m/^no_(.*)/) {
      my $what = $1;
      $setup{opposes} = $what;
      # implicit 'opposes' -- vs 
      # warn "$canon (@long)- opposes $what\n";
      #$self->{__go}->add_aliases($canon, \@short, @long);
      #return;
    }
    # warn "canon: $canon\n";
    # warn "long: @long\n";
    # warn "short: @short\n";
    $setup{aliases} = \@long;
    $setup{short}   = \@short;

    $setup{canon} = $canon;
    $self->{__current} = \%setup;
    return;
  }
  elsif($command eq 'back') {
    $self->__store_last;
    return;
  }
  $self->{__current} or return;

  if($command eq 'for') {
    my ($t, @and) = split(/\n=for /, $p);
    my %ok = map({$_ => 1} qw(positional help isa call opposes));
    my ($thing, $val) = split(/ /, $t, 2);
    if($ok{$thing}) {
      $self->{__current}{$thing} = defined($val) ? $val : 1;
    }
    else {warn "unhandled: $t\n"}
    $self->command(for => $_) for(@and);
  }
}
sub verbatim {
  my ($parser, $t) = @_;
  if(delete($parser->{__usage})) {
    $t =~ s/\n+$//;
    $parser->{__go}->{usage} = $t;
  }
}

sub end_pod {
  shift->__store_last;
}
sub textblock {
  my ($self, $p) = @_;

  my $s = $self->{__current} or return;
  if($p =~ m/^DEFAULT(?::|\s*=)\s*(.*)/) {
    my $def = $1;

    # normalize it
    if($def =~ s/^(["'])//) {
      $def =~ s/$1$//;
    }
    # warn "$s->{canon} $s->{type}\n";
    if($s->{type} eq 'boolean') {
      $def =~ s/^no$/0/i;
      $def = 1 if($def);
    }

    $s->{default} = $def;
  }
  elsif(not $s->{help}) {
    # make help from the first sentence
    $p =~ s/\n+$//;
    $p = lcfirst($p);
    $p =~ s/\.( *|$).*//s;
    #warn "text: $p\n";
    $s->{help} = $p;
  }
}

sub __store_last {
  my $parser = shift;

  my $setup = delete($parser->{__current}) or return;
  my $name = delete($setup->{canon}) or die "nothing here";
  my $pos = delete($setup->{positional});

  my $self = $parser->{__go};

  my %auto_actions = map({$_ => 1}
    qw(help version config_file));
  if(my $call = $setup->{call}) {
    my $handler = $call =~ s/^(.*)::// ? $1 : $self->{handler};
    # TODO caller should be able to pass handler as an object?
    $setup->{call} = $handler->can($call) or
        Carp::croak("'$handler' cannot '$call()'");
  }
  elsif($auto_actions{$name}) {
    $setup->{call} = $self->can($name . '_handler') or
      Carp::croak("no handler defined for $name");
  }

  push(@{$self->{help_order}}, $name);
  # TODO ^-- does not work with =for opposes $something

  $self->{help_bits}{$name} = delete($setup->{help_bit});
  $self->{help}{$name} = delete($setup->{help});
  $self->add_option($name, %$setup);
  $self->add_positionals($name) if($pos);
}

}
########################################################################







# vi:ts=2:sw=2:et:sta
1;