私は小さな perl モジュールを持っていて、Getopt::Long を使用しています。Pod::Usage を使用して見栄えの良いヘルプ表示を取得することも考えました。
少しいじった後、1つの小さな例外を除いて、かなりうまく機能するようになりました. 出力の幅を設定できません。
私の端末は 191 文字幅です。perldoc Module.pm を使用すると、ドキュメントがその幅に正しくフォーマットされます。pod2usage() を使用すると、デフォルト幅の 76 文字が使用されます。
width オプションをフォーマッタに渡す方法がわかりません。ドキュメントには、BEGIN ブロックを使用して別のフォーマッタ (Pod::Text::Termcap など) を設定する方法が示されています。Term::ReadKey を使用して幅を取得しました (検証済み) が、フォーマッタを取得できません。見てください。
ヒントはありますか？
テストしようとしている完全なモジュールと、それをロードするための小さなテスト スクリプトを次に示します。意味を理解するには、妥当な幅 (132 以上なので明らかです) のターミナルを開き、「./test.pl --man」の出力と「perldoc MUD::Config」の出力を比較します。 .
perldoc が追加する man ページ スタイルのヘッダーとフッターがなくても生活できますが、端末の幅を尊重 (および使用) したいと思います。
test.pl
#!/usr/bin/perl -w
use strict;
use warnings;
use MUD::Config;
#use MUD::Logging;
my $config = new MUD::Config @ARGV;
#my $logger = new MUD::Logging $config;
#$bootlog->info("Logging initialized");
#$bootlog->info("Program exiting");
およびMUD/Config.pm
#!/usr/bin/perl -w
package MUD::Config;
=pod
=head1 NAME
MUD::Config -- Configuration options for PocketMUD
=head1 SYNOPSIS
./PocketMUD [OPTIONS]
=head1 OPTIONS
=over 8
=item B<--dbname>
Specifiy the name of the database used by PocketMUD S<(default B<pocketmud>)>.
=item B<--dbhost>
Specify the IP address used to connect to the database S<(default B<localhost>)>.
=item B<--dbport>
Specify the port number used to connect to the database S<(default B<5432>)>.
=item B<--dbuser>
Specify the username used to connect to the database S<(default B<quixadhal>)>.
=item B<--dbpass>
Specify the password used to connect to the database S<(default B<password>)>.
=item B<--dsn>
The DSN is the full connection string used to connect to the database. It includes the
values listed above, as well as several other options specific to the database used.
S<(default B<DBI:Pg:dbname=$db_name;host=$db_host;port=$db_port;sslmode=prefer;options=--autocommit=on>)>
=item B<--logfile>
Specify the text file used for debugging/logging output S<(default B</home/quixadhal/PocketMUD/debug-server.log>)>.
=item B<--port>
Specify the port used for player connections S<(default B<4444>)>.
=item B<--help>
Display usage information for PocketmUD.
=item B<--man>
Display full documentation of configuration module details.
=back
=head1 DESCRIPTION
PocketMUD is a perl re-implementation of SocketMUD.
It is meant to be a barebones MUD server, written in perl,
which can be easily modified and extended.
=head1 METHODS
=cut
use strict;
use warnings;
use Getopt::Long qw( GetOptionsFromArray );
use Config::IniFiles;
use Data::Dumper;
BEGIN {
use Term::ReadKey;
my ($width, $height, $pixel_width, $pixel_height) = GetTerminalSize();
#print "WIDTH: $width\n";
$Pod::Usage::Formatter = 'Pod::Text::Termcap';
$Pod::Usage::width = $width;
}
use Pod::Usage;
use Pod::Find qw(pod_where);
Getopt::Long::Configure('prefix_pattern=(?:--|-)?'); # Make dashes optional for arguments
=pod
B<new( @ARGV )> (constructor)
Create a new configuration class. You should only need ONE instance of this
class, under normal circumstances.
Parameters passed in are usually the command line's B<@ARGV> array. Options that
can be specified are listed in the B<OPTIONS> section, above.
Returns: configuration data object.
=cut
sub new {
my $class = shift;
my @args = @_;
my ($db_name, $db_host, $db_port, $db_user, $db_pass, $DSN);
my ($logfile, $port);
my $HOME = $ENV{HOME} || ".";
# Order matters... First we check the global config file, then the local one...
foreach my $cfgfile ( "/etc/pocketmud.ini", "$HOME/.pocketmud.ini", "./pocketmud.ini" ) {
next if !-e $cfgfile;
my $cfg = Config::IniFiles->new( -file => "$cfgfile", -handle_trailing_comment => 1, -nocase => 1, -fallback => 'GENERAL', -default => 'GENERAL' );
$db_name = $cfg->val('database', 'name') if $cfg->exists('database', 'name');
$db_host = $cfg->val('database', 'host') if $cfg->exists('database', 'host');
$db_port = $cfg->val('database', 'port') if $cfg->exists('database', 'port');
$db_user = $cfg->val('database', 'user') if $cfg->exists('database', 'user');
$db_pass = $cfg->val('database', 'password') if $cfg->exists('database', 'password');
$DSN = $cfg->val('database', 'dsn') if $cfg->exists('database', 'dsn');
$logfile = $cfg->val('general', 'logfile') if $cfg->exists('general', 'logfile');
$port = $cfg->val('general', 'port') if $cfg->exists('general', 'port');
}
# Then we check arguments from the constructor
GetOptionsFromArray( \@args ,
'dbname:s' => \$db_name,
'dbhost:s' => \$db_host,
'dbport:i' => \$db_port,
'dbuser:s' => \$db_user,
'dbpass:s' => \$db_pass,
'dsn:s' => \$DSN,
'logfile:s' => \$logfile,
'port:i' => \$port,
'help|?' => sub { pod2usage( -input => pod_where( {-inc => 1}, __PACKAGE__), -exitval => 1 ); },
'man' => sub { pod2usage( -input => pod_where( {-inc => 1}, __PACKAGE__), -exitval => 2, -verbose => 2 ); },
);
# Finally, we fall back to hard-coded defaults
$db_name = 'pocketmud' if !defined $db_name and !defined $DSN;
$db_host = 'localhost' if !defined $db_host and !defined $DSN;
$db_port = 5432 if !defined $db_port and !defined $DSN;
$db_user = 'quixadhal' if !defined $db_user;
$db_pass = 'password' if !defined $db_pass;
$logfile = '/home/quixadhal/PocketMUD/debug-server.log' if !defined $logfile;
$port = 4444 if !defined $port;
$DSN = "DBI:Pg:dbname=$db_name;host=$db_host;port=$db_port;sslmode=prefer;options=--autocommit=on" if !defined $DSN and defined $db_name and defined $db_host and defined $db_port;
die "Either a valid DSN or a valid database name, host, and port MUST exist in configuration data" if !defined $DSN;
die "A valid database username MUST exist in configuration data" if !defined $db_user;
die "A valid database password MUST exist in configuration data" if !defined $db_pass;
die "A valid logfile MUST be defined in configuration data" if !defined $logfile;
die "A valid port MUST be defined in configuration data" if !defined $port;
my $self = {
DB_NAME => $db_name,
DB_HOST => $db_host,
DB_PORT => $db_port,
DB_USER => $db_user,
DB_PASS => $db_pass,
DSN => $DSN,
LOGFILE => $logfile,
PORT => $port,
};
bless $self, $class;
print Dumper($self);
return $self;
}
sub dsn {
my $self = shift;
if ( @_ ) {
$self->{DSN} = shift;
}
return $self->{DSN};
}
sub db_user {
my $self = shift;
if ( @_ ) {
$self->{DB_USER} = shift;
}
return $self->{DB_USER};
}
sub db_pass {
my $self = shift;
if ( @_ ) {
$self->{DB_PASS} = shift;
}
return $self->{DB_PASS};
}
sub logfile {
my $self = shift;
if ( @_ ) {
$self->{LOGFILE} = shift;
}
return $self->{LOGFILE};
}
sub port {
my $self = shift;
if ( @_ ) {
$self->{PORT} = shift;
}
return $self->{PORT};
}
1;