I have been writing scripts for my employer for almost two years now,
and, as I suspect is true of many of us, accumulating a documentation
problem in the process. Specifically, I have found that it is much
easier to add command-line options through class inheritance and reuse
than it is to document them. I have attached an early version of the
source for a module that tries to address the problem by inheriting the
documentation in parallel with the option parsing code. For want of
anything better, it's called "Pod::CLOD", for "Command Line Option
Documenter". The internal POD (although incomplete) contains more
details; the "HISTORY" section in particular says a bit more about how
this whole mess came about.
For those curious enough to delve into it, I would be grateful for
solutions to anything in the "BUGS" section (for those bugs that need
more than just finishing up), or answers to the following questions in
particular:
1. Has anybody seen or done anything similar? (I gave CPAN a
glance, but there were no obvious candidates -- which probably just
means that everybody is writing Web or GUI apps these days.)
2. Any suggestions for how to solve the delegation problem? Maybe
Pod::CLOD should be allowed to do option processing for delegated
objects directly? Or maybe it just needs hints about how precedence
should work locally for a given module?
Implementation is proving a bit trickier than I had expected -- the
devil, as usual, is in the details -- but I'm pretty strongly motivated
to make it work, since I don't really have a palatable alternative. And
if it eventually becomes capable of meeting my needs, then I would be
delighted to publish it via CPAN.
Many TIA,
-- Bob Rogers
http://rgrjr.dyndns.org/
# Command Line Option Documenter.
#
# Copyright (C) 2004 by Bob Rogers <[EMAIL PROTECTED]>, all rights
# reserved. The Pod::CLOD module is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# [created. -- rgr, 4-Sep-04.]
#
# $Id:$
package Pod::CLOD;
=head1 NAME
Pod::CLOD -- The "Command Line Option Documenter" for Perl's "Plain
Old Documentation."
=head1 SYNOPSIS
In module <Foo.pm>:
package Foo;
=head1 Option documentation
=item B<--this>
Specifies the C<--this> option.
=item B<--that>
Specifies the C<--that> option. [Foo edition.]
=cut
sub command_line_options {
my $self = shift;
# command_line_options must return a list of alternating
# keywords and values, which must be acceptable to Getopt::Long.
# But note that Pod::CLOD treats the option parsers (the subs
# in this case) as black boxes.
('this=i' => sub { $self->this($_[1]); },
'that=s' => sub { $self->that($_[1]); });
}
. . .
In module <Bar.pm>:
package Foo;
=head1 Option documentation
=item B<--that>
Specifies a different version of the C<--that> option. [Bar edition.]
=cut
sub command_line_options {
my $self = shift;
('that=s' => sub { $self->i_resent_that($_[1]); });
}
. . .
In program C<main.pl>:
use Foo;
use Bar;
use Pod::CLOD;
my $foo = new Foo();
my $bar = new Bar();
my @loci;
my $clod = new Pod::CLOD
# $bar must come first here, so that its '--that' option overrides.
(option_definers => [$bar, $foo],
additional_options => { 'theother' => [EMAIL PROTECTED] });
$clod->parse_options();
. . .
=head1 NAME
main.pl -- just a random example.
=head1 OPTIONS
main.pl takes just the --this, --that, and --theother options:
=over 4
=enumerate_options
=back
=head1 Option documentation
Note that this text (until the next =head? section or =cut) does not
appear in the final POD. Options handled by the main program could
also be put after =enumerate_options above, but this (a) includes them
in alphabetical order, (b) excludes them if the option is not
actually used, and (c) ensures that the main program's documentation
for these options overrides any module documentation.
=item B<--theother>
Specifies the C<--theother> option.
. . .
=cut
=head1 REQUIRES
Getopt::Long
Pod::Usage
=head1 DESCRIPTION
C<Pod::CLOD> provides an object-oriented interface to C<Getopt::Long>
and C<Pod::Usage>, handling command-line option parsing and providing
the C<--help>, C<--usage>, and C<--man> options natively. Options
from objects (or classes) that support the C<command_line_options>
method can also be included. Furthermore, option documentation within
such modules can be interpolated into a script's POD before processing
by C<Pod::Usage>. C<Pod::CLOD> traces the C<@ISA> graph to find the
right documentation (usually) for a given module, allowing scripts to
share the documentation for their common options that are implemented
by the same class.
=head2 History
Once upon a time, I started writing a set of interrelated scripts that
used C<Getopt::Long> to parse command-line options, and C<Pod::Usage>
to report problems with those options. Each script would do its own
option parsing, then initialize one or more objects using the options
it was given, and finally compute a result somehow. Since some
objects were used frequently, there was a great deal of duplicated
option parsing code, so I soon started delegating option parsing to
the C<command_line_options> method of each class that actually used
the option values. This scaled admirably well, as class
C<command_line_options> methods could compose option handling lists
from superclasses as well as from delegated objects. (I restricted
the return value representation to alternating keyword/value pairs to
facilitate just this sort of processing.)
Unfortunately, each script still had to contain the complete
documentation for each option it accepted, directly or through its
constituent classes. When I made a 40-line change to the code of one
popular module to add a feature that rendered 400 lines of POD
out-of-date at a stroke (roughly ten lines of documentation change in
each of 43 scripts), I knew I had to find a way to document options
that was as modular as the code itself.
In hindsight, of course, the answer was obvious: Inherit the POD
along with the options. Each module can document the options it
provides, making it easier to change the option documentation when the
option code is changed. Subclass modules that modify how an option is
used can also modify the documentation (whether or not they modify how
the option is parsed). And if an option is modified by deleting it,
its documentation is suppressed altogether.
Unfortunately, there are still some snags in the implementation . . .
=head1 BUGS
[These are all fairly serious problems, and explain why this module is
not ready for prime time yet. -- rgr, 7-Sep-04.]
C<foo=s> will not override C<foo=i>; they are seen as distinct
options. Along the same vein, "short form" options and aliases are
not handled at all.
There is no way to document options defined by delegation.
Mistakes can be made even for options defined through the class
hierarchy. If in the example above, Bar suppressed C<--that> instead
of redefining it, but some later option definer provided its own
C<--that>, C<Pod::CLOD> would incorrectly use Bar's documentation for
it.
Suppression of "Option documentation" sections in main scripts is not
yet implemented.
Handling of boolean options, i.e. C<--foo> and C<--nofoo>, works for
the style in which I document them, but this is pretty ad-hoc and
kludgey.
More nitty-gritty documentation is needed.
=head1 VERSION
No version until I can get the bugs listed above under control.
=head1 AUTHOR
Bob Rogers C<E<lt>[EMAIL PROTECTED]<gt>>, with portions
liberated from C<Pod::Usage> by Brad Appleton
C<E<lt>[EMAIL PROTECTED]<gt>>.
=cut
use strict;
use Getopt::Long;
use Pod::Usage qw();
# use Data::Dumper;
# define instance accessors.
sub BEGIN {
no strict 'refs';
for my $method (qw(option_definers additional_options
man_p help_p usage_p)) {
my $field = '_' . $method;
*$method = sub {
my $self = shift;
@_ ? ($self->{$field} = shift, $self) : $self->{$field};
}
}
}
sub new {
my $class = shift;
$class = ref($class)
if ref($class);
my $self = bless {} => $class;
while (@_) {
my $method = shift;
my $argument = shift;
$self->$method($argument)
if $self->can($method);
}
# perform defaulting.
$self->additional_options({})
unless $self->additional_options;
$self->man_p(1)
unless defined($self->man_p);
$self->usage_p(1)
unless defined($self->usage_p);
$self->help_p(1)
unless defined($self->help_p);
$self;
}
### Option generation and parsing.
sub command_line_options {
my $self = shift;
my $cl_options = $self->{_command_line_options};
return $cl_options
if $cl_options;
$cl_options = { %{$self->additional_options} };
$self->{_command_line_options} = $cl_options;
$cl_options->{options} = sub { $self->document_options; };
my $option_definers = $self->option_definers;
if ($option_definers && @$option_definers) {
for my $definer (@$option_definers) {
my @options = $definer->command_line_options;
while (my ($key, $value) = splice(@options, 0, 2)) {
$cl_options->{$key} = $value
unless $cl_options->{$key};
}
}
}
$cl_options->{man} = sub {
$self->pod2usage(-exitstatus => 0, -verbose => 2);
}
if $self->man_p && ! $cl_options->{man};
$cl_options->{help} = sub { $self->pod2usage(1); }
if $self->help_p && ! $cl_options->{help};
$cl_options->{usage} = sub { $self->pod2usage(2); }
if $self->usage_p && ! $cl_options->{usage};
$cl_options;
}
sub parse_options {
my $self = shift;
GetOptions(%{$self->command_line_options()})
or $self->pod2usage(2);
# $self->document_options;
}
### Class precedence table.
# This is used to decide which class should be responsible for supplying the
# documenting for a given option. An option defined by something earlier in the
# list is assumed to override something later in the list, so the same thing
# should happen for option documentation. (At least that is true for methods by
# the normal rules of inheritance; some classes may have command_line_options
# methods that bend this rule for options. Such classes should also have option
# documentation based on that for the correct class's version of the option.)
# [bug: this doesn't handle delegated objects. -- rgr, 5-Sep-04.]
sub _add_to_class_table {
my ($self, $table, $class_visited_p, $class) = @_;
if (! $class_visited_p->{$class}) {
push(@$table, $class);
$class_visited_p->{$class} = 1;
# now do inheritance for this class.
my $class_isa;
{
no strict 'refs';
my $glob = *{$class."::"}->{ISA};
if ($glob && defined(*$glob{ARRAY})) {
warn("[got '$glob' for $class, ",
defined(*$glob{ARRAY}), ".]\n")
if 0;
$class_isa = *$glob{ARRAY};
}
}
if ($class_isa) {
for my $isa (@$class_isa) {
# warn "[$class isa $isa]\n";
$self->_add_to_class_table($table, $class_visited_p, $isa);
}
}
}
}
sub class_precedence_table {
my $self = shift;
$self->{_class_precedence_table} = shift, return($self)
if @_;
my $table = $self->{_class_precedence_table};
return $table
if $table;
$self->{_class_precedence_table} = $table = ['main'];
my $class_visited_p = {};
my $option_definers = $self->option_definers;
for my $definer (@$option_definers, $self) {
$self->_add_to_class_table($table, $class_visited_p,
ref($definer) || $definer);
}
$table;
}
### Getting option documentation.
sub find_option_documentation {
my ($self, $option_name) = @_;
for my $class (@{$self->class_precedence_table}) {
my $doc = $self->{_class_to_index}->{$class}->{$option_name};
return $doc
if $doc;
}
'';
}
sub _index_this_file {
my ($self, $class, $pod) = @_;
local *IN;
open(IN, $pod)
or die;
my $index = $self->{_class_to_index}->{$class} = {};
my $option_name;
while (defined(my $line = <IN>)) {
if ($line =~ /^=item B<--?([^\s<>=]+)/) {
# starting a new option description. if this is just a negated
# version of some other option, then we must lump it with its
# positive sense, since only the positive sense will appear in the
# GetOptions list. [bug: we should really check that the option is
# boolean, and doesn't actually appear in the list as 'no-foo'. --
# rgr, 5-Sep-04.]
$option_name = $1;
$option_name =~ s/^no-?//;
$index->{$option_name} .= $line;
}
elsif ($line =~ /^=/) {
# ending an option description (if one was open).
$option_name = '';
}
elsif ($option_name) {
# next line in the current option description.
$index->{$option_name} .= $line;
}
}
close(IN);
$index;
}
sub _index_this_class {
my ($self, $class) = @_;
return
if $self->{_class_to_index}->{$class};
my $pod_file;
if ($class eq 'main') {
# [bug: should search $PATH if not found.]
$pod_file = $0;
}
else {
my $file = "$class.pm";
$file =~ s@::@/@g;
# die join("\n", %INC, '');
my $source = $INC{$file};
if ($source) {
my $pod = $source;
$pod =~ s/\.pm$/\.pod/;
$pod_file = (-r $pod ? $pod : $source);
}
}
if (! $pod_file || ! -r $pod_file) {
warn "[$self: class $class => '$pod_file', which doesn't exist.]\n";
}
else {
$self->_index_this_file($class, $pod_file);
}
}
sub index_module_options {
# this attempts to parse pod out of *everything*, but the result is cached,
# so it's cheap to call a second time.
my $self = shift;
# die Dumper($self->class_precedence_table);
for my $class (@{$self->class_precedence_table}) {
$self->_index_this_class($class);
}
}
sub document_options {
my ($self, $fh) = @_;
$fh ||= *STDOUT;
my $options = $self->command_line_options;
$self->index_module_options;
for my $opt (sort(keys(%$options))) {
my $key = $opt;
$key =~ s/=[si]$|[!+]$//;
my $doc = $self->find_option_documentation($key);
if ($doc) {
print $fh $doc;
}
else {
# this tells the user that the option at least exists, which may be
# helpful. (it should also tell the programmer that s/he didn't
# finish the job).
print $fh "=item B<--$key>\n\n[undocumented option]\n\n";
}
}
}
sub pod2usage {
# This duplicates much of Pod::Usage::pod2usage, since we have to do most of
# the option parsing/defaulting in order to get at the -input file.
my $self = shift;
local $_ = shift;
my %opts;
## Collect arguments
if (@_ > 0) {
## Too many arguments - assume that this is a hash and
## the user forgot to pass a reference to it.
%opts = ($_, @_);
}
elsif (ref $_) {
## User passed a ref to a hash
%opts = %{$_} if (ref($_) eq 'HASH');
}
elsif (/^[-+]?\d+$/) {
## User passed in the exit value to use
$opts{"-exitval"} = $_;
}
elsif ($_) {
## User passed in a message to print before issuing usage.
$opts{"-message"} = $_;
}
## Default the input file
$opts{"-input"} = $0 unless (defined $opts{"-input"});
## Look up input file in path if it doesnt exist.
unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
my ($dirname, $basename) = ('', $opts{"-input"});
my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
: (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":");
my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
for $dirname (@paths) {
$_ = File::Spec->catfile($dirname, $basename) if length;
last if (-e $_) && ($opts{"-input"} = $_);
}
}
# Transform script POD in order to insert option documentation.
my $original_input = $opts{'-input'};
my $transformed_input = "CLOD$$.pod";
$transformed_input = ($ENV{TMPDIR} || $ENV{TMP}).'/'.$transformed_input
if $ENV{TMPDIR} || $ENV{TMP};
die "symlink attack?"
if -x $transformed_input;
open(IN, $original_input) || die;
$self->{_transformed_input_file} = $transformed_input;
open(OUT, ">$transformed_input") || die;
my $in_pod_p = 0;
while (defined(my $line = <IN>)) {
if ($line =~ /^=cut/) {
$in_pod_p = 0;
}
elsif ($line =~ /^=/) {
$in_pod_p = 1;
}
if ($line =~ /^=enumerate_options/) {
$self->document_options(*OUT);
}
elsif ($in_pod_p) {
print OUT $line;
}
}
close(IN);
close(OUT);
# perform actual POD formatting.
$opts{'-input'} = $transformed_input;
Pod::Usage::pod2usage(\%opts);
unlink($transformed_input);
undef($self->{_transformed_input_file});
}
sub DESTROY {
# this allows us to clean up after our pod2usage without having to regain
# control from Pod::Usage::pod2usage, which normally exits when done.
my $self = shift;
unlink($self->{_transformed_input_file})
if $self->{_transformed_input_file};
}
1;
__END__
=head1 Option documentation
These are the options that C<Pod::CLOD> understands natively; they are
included in the option list unless specifically suppressed.
=over 4
=item B<--help>
Prints the L<"SYNOPSIS"> and L<"OPTIONS"> sections of this documentation.
=item B<--man>
Prints the full documentation in the Unix `manpage' style.
=item B<--options>
Prints documentation for all options in perl POD format. This is
mostly useful for debugging the C<Pod::CLOD> module
=item B<--usage>
Prints just the L<"SYNOPSIS"> section of this documentation.
=cut
_______________________________________________
Boston-pm mailing list
[EMAIL PROTECTED]
http://mail.pm.org/mailman/listinfo/boston-pm
