jmx4perl/lib/JMX/Jmx4Perl/J4psh/Command.pm
2017-10-31 14:38:28 +01:00

295 lines
7.2 KiB
Perl

#!/usr/bin/perl
package JMX::Jmx4Perl::J4psh::Command;
use strict;
use POSIX qw(strftime);
use Term::Clui;
use Getopt::Long;
=head1 NAME
JMX::Jmx4Perl::J4psh::Command - Base object for commands
=head1 DESCRIPTION
This is the base command from which all j4psh commands should be extended. It
provides registration hooks so that the command handler can determine the
position of this command in the menu structure. Additionally it provides common
methods useful for each command to perform its action.
A L<JMX::Jmx4Perl::J4psh::Command> is a collection of shell commands, grouped in a
certain context. It can be reused in different contexts and hence can occur at
different places in the menu structure.
=cut
=head1 METHODS
=over
=item $command_handler = new JMX::Jmx4Perl::Command($context)
Constructor, which should not called be directly on this module but on a
submodule. In fact, it will be called (indirectly) only by the
L<JMX::Jmx4Perl::J4psh::CommandHandler> during the command registration process.
The single argument required is the central context object.
=cut
sub new {
my $class = shift;
my $context = shift;
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
bless $self,(ref($class) || $class);
$self->{context} = $context;
return $self;
}
=item $global_commands = $cmd->global_commands
This method is called by the command handler during registration in order to
obtain the global commands which are always present in the menu. The default
implementation returns C<undef> which means that no global commands should be
registered. Overwrite this to provide a command hashref as known to
L<Term::ShellUI> for setting the global commands.
=cut
sub global_commands {
return undef;
}
=item $top_commands = $cmd->top_commands
This method is called by the command handler during registration in order to
obtain the top commands which are present in the top level menu. The default
implementation returns C<undef> which means that no top commands are to be
registered. Overwrite this to provide a command hashref as known to
L<Term::ShellUI> for setting the top commands.
=cut
sub top_commands {
return undef;
}
=item $context = $cmd->context
Get the context object used during construction. This is a convenience method
for sublassed commands.
=cut
sub context {
return shift->{context};
}
=item $complete_handler = $cmd->complete
Convenience method to get the L<JMX::Jmx4perl::J4psh::CompletionHandler> for getting
various command line completions.
=cut
sub complete {
return shift->{context}->complete;
}
=item $agent = $cmd->agent
Convenience method to get the L<JMX::Jmx4Perl> agent in order to
contact the server agent bundle (via L<JMX::Jmx4Perl>)
=cut
sub agent {
return shift->{context}->agent;
}
=item @colors = $cmd->color(@color_ids)
Return a list of ANSI color strings for the given symbolic color names which
are looked up from the current color theme. If no coloring is enabled, empty
strings are returned. This method dispatched directly to the underylying
C<context> object.
=cut
sub color {
return shift->{context}->color(@_);
}
=item $cmd->push_on_stack("context",$cmds)
Rerturn a sub (closure) which can be used as a command to update the context
stack managed by the command handler. Update in this sense means push the given
context ("C<context>") on the stack, remembering the provided shell commands
C<$cmds> for later use when traversing the stack upwards via C<..>
=cut
sub push_on_stack {
my $self = shift;
my @args = @_;
return sub {
$self->{context}->{commands}->push_on_stack(@args);
};
}
=item $cmd->pop_off_stack
Go up one level in the stack
=cut
sub pop_off_stack {
my $self = shift;
$self->{context}->{commands}->pop_off_stack();
}
=item $cmd->reset_stack
Reset the stack completely effectively jumping on top of it
=cut
sub reset_stack {
my $self = shift;
$self->{context}->{commands}->reset_stack();
}
=item ($opts,@args) = $cmd->extract_command_options($spec,@args);
Extract any options from a command specified via C<$spec>. This method uses
L<Getopt::Long> for extrating the options. It returns a hashref with the
extracted options and an array of remaining arguments
=cut
sub extract_command_options {
my ($self,$spec,@args) = @_;
my $opts = {};
{
local @ARGV = @args;
GetOptions($opts,@{$spec});
@args = @ARGV;
}
return ($opts,@args);
}
=item $label = $cmd->format_date($time)
Formats a date like for C<ls -l>:
Dec 2 18:21
Jun 23 2009
This format is especially useful when used in listing.
=cut
sub format_date {
my $self = shift;
my $time = shift;
if (time - $time > 60*60*24*365) {
return strftime "%b %d %Y",localtime($time);
} else {
return strftime "%b %d %H:%M",localtime($time);
}
}
=item $cmd->print_paged($txt,$nr_lines)
Use a pager for printing C<$txt> which has C<$nr_lines> lines. Only if
C<$nr_lines> exceeds a certain limit (default: 24), then the pager is used,
otherwise C<$txt> is printed directly.
=cut
sub print_paged {
my $self = shift;
my $text = shift;
my $nr = shift;
if (!$nr) {
$nr = scalar(split /\n/s,$text);
}
my $max_rows = $self->context->term_height;
if (defined($nr) && $nr < $max_rows) {
print $text;
} else {
view("",$text);
}
}
=item $trimmed = $cmd->trim_string($string,$max)
Trim a string C<$string> to a certain length C<$max>, i.e. if C<$string> is
larger than C<$max>, then it is truncated to to C<$max-3> and C<...> is
appended. If it is less or equal, than C<$string> is returned unchanged.
=cut
sub trim_string {
my $self = shift;
my $string = shift;
my $max = shift;
return length($string) > $max ? substr($string,0,$max-3) . "..." : $string;
}
=item $converted = $cmd->convert_wildcard_pattern_to_regexp($orig)
Convert the wildcards C<*> and C<.> to their regexp equivalent and return a
regular expression.
=cut
sub convert_wildcard_pattern_to_regexp {
my $self = shift;
my $wildcard = shift;
$wildcard =~ s/\?/./g;
$wildcard =~ s/\*/.*/g;
return qr/^$wildcard$/i;
}
=back
=cut
=head1 LICENSE
This file is part of jmx4perl.
Jmx4perl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
jmx4perl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
A commercial license is available as well. Please contact roland@cpan.org for
further details.
=head1 PROFESSIONAL SERVICES
Just in case you need professional support for this module (or Nagios or JMX in
general), you might want to have a look at
http://www.consol.com/opensource/nagios/. Contact roland.huss@consol.de for
further information (or use the contact form at http://www.consol.com/contact/)
=head1 AUTHOR
roland@cpan.org
=cut
1;