/usr/share/perl5/Getopt/Long/Descriptive/Usage.pm is in libgetopt-long-descriptive-perl 0.096-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | use strict;
use warnings;
package Getopt::Long::Descriptive::Usage;
{
$Getopt::Long::Descriptive::Usage::VERSION = '0.096';
}
# ABSTRACT: the usage description for GLD
use List::Util qw(max);
sub new {
my ($class, $arg) = @_;
my @to_copy = qw(options leader_text);
my %copy;
@copy{ @to_copy } = @$arg{ @to_copy };
bless \%copy => $class;
}
sub text {
my ($self) = @_;
return join qq{\n}, $self->leader_text, $self->option_text;
}
sub leader_text { $_[0]->{leader_text} }
sub option_text {
my ($self) = @_;
my @options = @{ $self->{options} || [] };
my $string = q{};
# a spec can grow up to 4 characters in usage output:
# '-' on short option, ' ' between short and long, '--' on long
my @specs = map { $_->{spec} } grep { $_->{desc} ne 'spacer' } @options;
my $length = (max(map { length } @specs) || 0) + 4;
my $spec_fmt = "\t%-${length}s";
while (@options) {
my $opt = shift @options;
my $spec = $opt->{spec};
my $desc = $opt->{desc};
if ($desc eq 'spacer') {
$string .= sprintf "$spec_fmt\n", $opt->{spec};
next;
}
$spec = Getopt::Long::Descriptive->_strip_assignment($spec);
$spec = join " ", reverse map { length > 1 ? "--$_" : "-$_" }
split /\|/, $spec;
my @desc = $self->_split_description($length, $desc);
$string .= sprintf "$spec_fmt %s\n", $spec, shift @desc;
for my $line (@desc) {
$string .= "\t";
$string .= q{ } x ( $length + 2 );
$string .= "$line\n";
}
}
return $string;
}
sub _split_description {
my ($self, $length, $desc) = @_;
# 8 for a tab, 2 for the space between option & desc;
my $max_length = 78 - ( $length + 8 + 2 );
return $desc if length $desc <= $max_length;
my @lines;
while (length $desc > $max_length) {
my $idx = rindex( substr( $desc, 0, $max_length ), q{ }, );
last unless $idx >= 0;
push @lines, substr($desc, 0, $idx);
substr($desc, 0, $idx + 1) = q{};
}
push @lines, $desc;
return @lines;
}
sub warn { warn shift->text }
sub die {
my $self = shift;
my $arg = shift || {};
die(
join q{}, grep { defined } $arg->{pre_text}, $self->text, $arg->{post_text}
);
}
use overload (
q{""} => "text",
# This is only needed because Usage used to be a blessed coderef that worked
# this way. Later we can toss a warning in here. -- rjbs, 2009-08-19
'&{}' => sub {
my ($self) = @_;
Carp::cluck("use of __PACKAGE__ objects as a code ref is deprecated");
return sub { return $_[0] ? $self->text : $self->warn; };
}
);
1;
__END__
=pod
=head1 NAME
Getopt::Long::Descriptive::Usage - the usage description for GLD
=head1 VERSION
version 0.096
=head1 SYNOPSIS
use Getopt::Long::Descriptive;
my ($opt, $usage) = describe_options( ... );
$usage->text; # complete usage message
$usage->die; # die with usage message
=head1 DESCRIPTION
This document only describes the methods of the Usage object. For information
on how to use L<Getopt::Long::Descriptive>, consult its documentation.
=head1 METHODS
=head2 new
my $usage = Getopt::Long::Descriptive::Usage->new(\%arg);
You B<really> don't need to call this. GLD will do it for you.
Valid arguments are:
options - an arrayref of options
leader_text - the text that leads the usage; this may go away!
=head2 text
This returns the full text of the usage message.
=head2 leader_text
This returns the text that comes at the beginning of the usage message.
=head2 option_text
This returns the text describing the available options.
=head2 warn
This warns with the usage message.
=head2 die
This throws the usage message as an exception.
$usage_obj->die(\%arg);
Some arguments can be provided
pre_text - text to be prepended to the usage message
post_text - text to be appended to the usage message
The C<pre_text> and C<post_text> arguments are concatenated with the usage
message with no line breaks, so supply this if you need them.
=head1 AUTHORS
=over 4
=item *
Hans Dieter Pearcey <hdp@cpan.org>
=item *
Ricardo Signes <rjbs@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2005 by Hans Dieter Pearcey.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|