package Getopt::Auto;
use 5.006;
use strict;
use warnings;
use Carp;
our $VERSION = '1.00';
our $do_it;
our @spec;
sub import {
my $class = shift;
# Process into usable format.
@spec = @_;
}
our %options;
our $type;
CHECK {
@spec = superauto()
unless @spec;
for (@spec) {
croak "Option specification $_ should be an array reference"
unless ref $_ eq "ARRAY";
my @stuff = @$_;
my $flag = shift @stuff;
if (defined $type) {
croak
"Option inconsistency: expected $type options, found '$flag'"
unless _type($flag) eq $type;
} else {
$type = _type($flag);
croak
"Option style unknown: found '$flag', neither long, short nor bare"
if $type eq "unknown";
}
$options{$flag}{help} = shift @stuff;
if (defined $stuff[0] and ref $stuff[0] eq "CODE") {
$options{$flag}{code} = shift @stuff;
} else {
$options{$flag}{longhelp} = shift @stuff if defined $stuff[0];
$options{$flag}{code} = shift @stuff
if defined $stuff[0] and ref $stuff[0] eq "CODE";
}
if (!exists $options{$flag}{code}) {
my $sub = $flag;
$sub =~ s/^-+//;
$sub =~ s/-/_/g;
no strict 'refs';
$options{$flag}{code} = *{"main::$sub"}{CODE};
}
}
}
sub _type {
my $option = shift;
$option =~ /^--/ and return "long";
$option =~ /^-/ and return "short";
$option =~ /^\w/ and return "bare";
return "unknown";
}
use FindBin;
sub superauto {
my $pod = new Getopt::Auto::PodExtract;
my $self = -r $0 ? $0 : -r $FindBin::Bin . "/" . $0 ? -r $FindBin::Bin
. "/" . $0 :
croak "Couldn't automatically parse your POD - $0 not readable!";
$pod->parse_from_file($self, '/dev/null');
my @spec;
while (my ($k, $v) = each %{ $pod->{funcs} }) {
$k =~ s/_/-/g;
push @spec,
[ "--$k", $v->{shorthelp}, $v->{longhelp}, $v->{code} ];
}
return @spec;
}
sub version {
print "This is $0, version $main::VERSION\n\n";
}
sub helpme {
version();
my $sig = "";
if ($type eq "long") { $sig = "--" }
elsif ($type eq "short") { $sig = "-" }
# Are we being asked for *specific* help?
if (my @help = grep{ exists $options{$_} } @ARGV) {
my $what = $help[0];
if (exists $options{ $help[0] }{longhelp}) {
print "$0 $what - $options{$what}{help}\n\n";
print $options{$what}{longhelp} . "\n";
} else {
print "No help available for $what\n";
}
} else {
my $and_there_s_more = 0;
print <<EOF;
$0 ${sig}help - This text
$0 ${sig}version - Prints the version number
EOF
for (keys %options) {
print "$0 $_ - $options{$_}{help}";
$and_there_s_more++, (print "[*]")
if defined $options{$_}{longhelp}
and $options{$_}{longhelp} =~ /\S/;
print "\n";
}
if ($and_there_s_more) {
print <<EOF
More help is available on the topics marked with [*]
Try $0 ${sig}help ${sig}foo
EOF
}
}
exit 0;
}
END {
if (grep { /^-{0,2}h(elp|)$/ } @ARGV) { helpme() }
if (grep { /^--version|-V$/ } @ARGV) { version(); exit 0; }
while (my $foo = shift @ARGV) {
if (exists $options{$foo}) {
$options{$foo}{code}->(@ARGV);
exit;
} else {
if (_type($foo) ne $type and _type($foo) ne "bare") {
if (_type($foo) eq "short") {
$foo =~ s/-//;
$main::options{$_}++
for split //,$foo;
} else {
$main::options{$foo}++;
}
} else {
# Don't know this.
print STDERR "Unrecognised option $foo\n";
helpme();
}
}
}
if (exists &main::default) { main::default() }
}
package Getopt::Auto::PodExtract;
use base 'Pod::Parser';
sub command {
my $self = shift;
my ($command, $text, $line_num) = @_;
if ($command eq 'item' || $command =~ /^head(?:2|3|4)/) {
no strict 'refs';
if (/C<([^>]+)> - (.*)/ or /(\w+) - (.*)/ and exists &{"main::$1"})
{
$self->{funcs}{$1} = {
shorthelp => $2,
code => *{"main::$1"}{CODE}
};
$self->{copying} = 1;
$self->{latest} = $1;
}
}
}
sub verbatim {
my ($self, $paragraph, $line_num) = @_;
$self->{funcs}{ $self->{latest} }{longhelp} .= $paragraph
if $self->{copying};
}
sub textblock {
my ($self, $paragraph, $line_num) = @_;
$self->{funcs}{ $self->{latest} }{longhelp} .=
$self->interpolate($paragraph, $line_num)
if $self->{copying};
}
# Preloaded methods go here.
1;
__END__
# Below is stub documentation for your module. You better edit it!
=head1 NAME
Getopt::Auto - Framework for command-line applications
=head1 SYNOPSIS
Not very magical:
use Getopt::Auto
(
[ "--wibble", "Wibble to standard output" ],
[ "--wobble", "Wobble to standard output", \&Something::Wobble ]
[ "--wubble", "Wubble to standard output",
"We're not entirely sure what a wubble is, but this option does it.",
\&Something::Wubble ]
);
our $VERSION = "1.0";
Now C<yourprogram --wibble foo> will call C<wibble("foo")>.
Pretty magical:
use Getopt::Auto; # We'll work it out from the POD.
=head1 DESCRIPTION
Unix command line applications, rather than simple filters, are pretty
unpleasant to write; as well as actually writing the functionality,
there's the boring parsing of the command line arguments and so on. Even
with C<Getopt::Long> or equivalent, you still have to dispatch the
appropriate commands to the right subroutines, write a C<--help> and
C<--version> handler, and so on. This module abstracts out that code,
leaving you free just to concentrate on the functional part.
In the "non-magical" mode, you provide a list of lists. Each element
contains the name of the command and a short help message; this may be
followed by a longer help message, to be given when something like
C<--help foo> is passed, and/or a code reference for the function to be
called. If there isn't a code reference given, we assume it will be
C<&main::foo>. If your command name contains hyphens, they will be
flattened to semicolons: C<--foo-bar> will call C<foo_bar>.
C<Getopt::Auto> is happy for you to use "long" (C<--gnu-style>),
"short" (C<-oldstyle>) or even "bare" command names,
(C<myprogram edit foo.txt>, CVS-style) on the condition that you are
consistent. Additionally, if you use bare or long style commands, then
any short options passed before a command name will be sent into
C<%main::options>. For instance, given
use Getopt::Auto (
"edit" => "open a file for editing",
"export" => "write out the data as an ASCII file"
);
C<yourprog -vt edit -x foo.txt> will perform the following:
$main::options{v} = 1
$main::options{t} = 1
edit("-x", "foo.txt");
=head2 HELP AND VERSION
C<Getopt::Auto> automatically provides C<help> and C<version> commands,
following your chosen style (long, short or bare).
C<help> lists the commands available and the short help messages. If a
C<help I<command>> is given for a command name with a long message, the
longer message will be printed instead.
C<version> displays your program name, plus C<$main::VERSION>. This
means you must set C<our $VERSION = "whatever"> in your application!
=head2 MAGICAL MODE
Now, the premise of C<Getopt::Auto> is that it frees you from the
boring stuff, right? And it could be argued that writing a specification
to hand to C<Getopt::Auto> is itself boring stuff. Well, never fear.
If you don't want to write such a specification, you don't have to.
All you need to do is write your commands, and then write some POD in
front of them, like so:
use Getopt::Auto;
our $VERSION = "1.0";
=head2 wibble - wibble to standard output
This command emits a simple wibble to standard output. It takes no
other options.
=cut
sub wibble { print "Aaargh!\n" }
C<Getopt::Auto> will go through and find the subroutines which have a
corresponding bit of POD documentation, and turn them into long options;
you can now say C<yourprogam --wibble>, and C<wibble()> will be called.
C<--help> and C<--version> work as normal, and the documentation
following the C<head2> will be taken as the long help text.
=head1 AUTHOR
Simon Cozens, C<simon@cpan.org>
=head1 SEE ALSO
L<Config::Auto>, L<Getopt::Long>
=cut