I have a small perl module, and am using Getopt::Long, and I figured I might as well use Pod::Usage to get a nice looking help display.
After some fiddling, I got it to work reasonably well, with one minor exception. I can't set the width of the output.
My terminal is 191 characters wide. Using perldoc Module.pm, it correctly formats the documentation to that width. Using pod2usage(), it uses the default width of 76 characters.
I can't figure out how to get the width option passed in to the formatter. The documentation shows how to set a different formatter (such as Pod::Text::Termcap) using a BEGIN block, and I used Term::ReadKey to pull the width (verified), but I just can't get the formatter to see it.
Any hints?
Here's the full module I'm trying to test, along with a small test script to load it. To see what I mean, open a terminal that has a reasonable width (132 or more, so it's obvious), and compare the output of "./test.pl --man" with the output of "perldoc MUD::Config".
I can live without the man page style headers and footers that perldoc adds, but I would like it to respect (and use) the terminal width.
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");
and 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;