From b4114f9ef1e28fdfa33a7ee35adda5cd8bee7e4e Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 2 Dec 2022 19:02:48 -0500 Subject: [PATCH 1/2] add indication that an option takes a value to the help message 1. correct determination of width of left help column; make leading indent * A bug resulted in taking the width of a stringified array reference, rather than the data in the array. * The leading indent was a full tab, which is a lot of space. Reduce it to 4 spaces. 2. The help message didn't specify that an option took a value. Here's before and after for the option specification in t/11-usage.t Usage: 11-usage.t [-rv] [long options] [arguments] --bare --define (default: arch=i386, isize=4) --input (default: test.txt) --libs (default: one, two) -r recursive --test run in test mode -v, --verbose turn on verbose output (default: 2) Usage: 11-usage.t [-rv] [long options] [arguments] --bare --define key= (default: arch=i386, isize=4) --input (default: test.txt) --libs (default: one, two) -r recursive --test run in test mode -v [], --verbose [] turn on verbose output (default: 2) --- lib/Getopt/Lucid.pm | 17 ++++++++++++----- t/11-usage.t | 10 +++++----- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/lib/Getopt/Lucid.pm b/lib/Getopt/Lucid.pm index 1904f7d..1193572 100644 --- a/lib/Getopt/Lucid.pm +++ b/lib/Getopt/Lucid.pm @@ -385,22 +385,22 @@ sub usage { for my $opt ( sort { $a->{strip} cmp $b->{strip} } values %{$self->{spec}} ) { my $names = [ @{ $opt->{names} } ]; push @doc, [ - _build_usage_left_column( $names, \@short_opts ), + _build_usage_left_column( $names, \@short_opts, $opt->{type} ), _build_usage_right_column( $opt->{doc}, $opt->{default}, $opt->{type} ), ]; } - my $max_width = 3 + List::Util::max( map { length } @doc ); + my $max_width = 3 + List::Util::max( map { length($_->[0]) } @doc ); my $prog = File::Basename::basename($0); local $" = ''; my $usage = "Usage: $prog [-@short_opts] [long options] [arguments]\n" - . join( "", map { sprintf( "\t%-${max_width}s %s\n", @$_ ) } @doc ); + . join( "", map { sprintf( " %-${max_width}s %s\n", @$_ ) } @doc ); } sub _build_usage_left_column { - my ($names, $all_short_opts) = @_; + my ($names, $all_short_opts, $type) = @_; my @sorted_names = sort { length $a <=> length $b } map { my $s = $_; $s =~ s/^-*//; $s } @$names; @@ -409,13 +409,20 @@ sub _build_usage_left_column { push @$all_short_opts, @short_opts; + my $value = + $type eq 'keypair' ? ' key=' + : $type eq 'counter' ? ' []' + : $type ne 'switch' ? ' ' + : '' + ; + my $group = sub { my $list = shift; '-' . ( @$list == 1 ? $list->[0] : '[' . join( '|', @$list ) . ']' ); }; my $prepare = sub { my $list = shift; - return ( length $list->[0] > 1 ? '-' : '' ) . $group->($list) if @$list; + return ( length $list->[0] > 1 ? '-' : '' ) . $group->($list) . $value if @$list; return; }; diff --git a/t/11-usage.t b/t/11-usage.t index 2725229..2595aef 100644 --- a/t/11-usage.t +++ b/t/11-usage.t @@ -28,13 +28,13 @@ my $spec = [ my @expectations = ( qr/^Usage: \Q$prog\E \[-rv] \[long options] \[arguments]$/, - qr/^\s+--bare\s*$/, - qr/^\s+--define\s+\(default: arch=i386, isize=4\)$/, - qr/^\s+--input\s+\(default: test\.txt\)$/, - qr/^\s+--libs\s+\(default: one, two\)$/, + qr/^\s+--bare \s*$/, + qr/^\s+--define key=\s+\(default: arch=i386, isize=4\)$/, + qr/^\s+--input \s+\(default: test\.txt\)$/, + qr/^\s+--libs \s+\(default: one, two\)$/, qr/^\s+-r\s+recursive$/, qr/^\s+--test\s+run in test mode$/, - qr/^\s+-v, --verbose\s+turn on verbose output \(default: 2\)$/, + qr/^\s+-v \[\], --verbose \[\]\s+turn on verbose output \(default: 2\)$/, ); plan tests => 2 + @expectations; From 4be5c9226fb72e1d0276b4a65eb46b39937c8d80 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 2 Dec 2022 22:39:22 -0500 Subject: [PATCH 2/2] allow specification of value placeholder string in usage output --- lib/Getopt/Lucid.pm | 35 +++++++++++++++++++++++++++++------ t/11-usage.t | 4 ++-- 2 files changed, 31 insertions(+), 8 deletions(-) diff --git a/lib/Getopt/Lucid.pm b/lib/Getopt/Lucid.pm index 1193572..592e786 100644 --- a/lib/Getopt/Lucid.pm +++ b/lib/Getopt/Lucid.pm @@ -27,7 +27,7 @@ my $VALID_NAME = qr/$VALID_LONG|$VALID_SHORT|$VALID_BARE/; my $SHORT_BUNDLE = qr/-[$VALID_STARTCHAR]{2,}/; my $NEGATIVE = qr/(?:--)?no-/; -my @valid_keys = qw( name type default nocase valid needs canon doc ); +my @valid_keys = qw( name type default nocase valid needs canon doc placeholder ); my @valid_types = qw( switch counter parameter list keypair); sub Switch { @@ -96,6 +96,8 @@ sub needs { my $self = shift; $self->{needs}=[@_]; return $self }; sub doc { my $self = shift; $self->{doc}=shift; return $self }; +sub placeholder { my $self = shift; $self->{placeholder}=shift; return $self }; + sub _clone { my $self = shift; bless { %$self }, ref $self } package Getopt::Lucid; @@ -385,7 +387,7 @@ sub usage { for my $opt ( sort { $a->{strip} cmp $b->{strip} } values %{$self->{spec}} ) { my $names = [ @{ $opt->{names} } ]; push @doc, [ - _build_usage_left_column( $names, \@short_opts, $opt->{type} ), + _build_usage_left_column( $names, \@short_opts, $opt->{type}, $opt->{placeholder} ), _build_usage_right_column( $opt->{doc}, $opt->{default}, $opt->{type} ), ]; } @@ -400,7 +402,7 @@ sub usage { } sub _build_usage_left_column { - my ($names, $all_short_opts, $type) = @_; + my ($names, $all_short_opts, $type, $placeholder ) = @_; my @sorted_names = sort { length $a <=> length $b } map { my $s = $_; $s =~ s/^-*//; $s } @$names; @@ -409,10 +411,11 @@ sub _build_usage_left_column { push @$all_short_opts, @short_opts; + $placeholder = 'value' if ! defined $placeholder; my $value = - $type eq 'keypair' ? ' key=' - : $type eq 'counter' ? ' []' - : $type ne 'switch' ? ' ' + $type eq 'keypair' ? " key=<$placeholder>" + : $type eq 'counter' ? " [<$placeholder>]" + : $type ne 'switch' ? " <$placeholder>" : '' ; @@ -1114,6 +1117,26 @@ Sets the documentation string for an option. This string shows up in the "usage" method. +=== placeholder() + +Sets the string used for the value placeholder in the usage for an option. +If not specified, defaults to C. + +For example, + + @spec = ( + Param("output")->doc("write output to the specified file") + ->placeholder("file"), + ); + +results in + + --output write output to the specified file + +rather than the default of + + --output write output to the specified file + == Validation Validation happens in two stages. First, individual parameters may have diff --git a/t/11-usage.t b/t/11-usage.t index 2595aef..a6ee59c 100644 --- a/t/11-usage.t +++ b/t/11-usage.t @@ -19,7 +19,7 @@ my $prog = basename($0); my $spec = [ Counter("--verbose|v")->doc("turn on verbose output")->default(2), Switch("--test")->doc("run in test mode"), - Param("--input")->default("test.txt"), + Param("--input")->default("test.txt")->placeholder('file'), Switch("-r")->doc("recursive"), Param("bare"), List("libs")->default(qw/one two/), @@ -30,7 +30,7 @@ my @expectations = ( qr/^Usage: \Q$prog\E \[-rv] \[long options] \[arguments]$/, qr/^\s+--bare \s*$/, qr/^\s+--define key=\s+\(default: arch=i386, isize=4\)$/, - qr/^\s+--input \s+\(default: test\.txt\)$/, + qr/^\s+--input \s+\(default: test\.txt\)$/, qr/^\s+--libs \s+\(default: one, two\)$/, qr/^\s+-r\s+recursive$/, qr/^\s+--test\s+run in test mode$/,