295 lines
7.2 KiB
Perl
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;
|
|
|