view release on metacpan or  search on metacpan

lib/AFS/Command/Base.pm  view on Meta::CPAN

require 5.6.0;

use strict;
use English;
use Carp;
use File::Basename qw(basename);
use Date::Format;

use IO::File;
use IO::Pipe;

our $AUTOLOAD	= "";
our $VERSION = '1.99';

our %Carp =
  (
   carp		=> \&Carp::carp,
   croak	=> \&Carp::croak,
  );

sub setCarp {

    my $class = shift;
    my (%args) = @_;

    foreach my $key ( keys %args ) {
	unless ( $Carp{$key} ) {
	    croak("Unsupported argument: '$key'");
	}
	unless ( ref $args{$key} eq 'CODE' ) {
	    croak("Not a code reference: '$args{$key}'");
	}
	$Carp{$key} = $args{$key};
    }

    return AFS::Object->_setCarp(@_);

}

sub new {

    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %args = @_;

    my $self = {};

    foreach my $key ( qw( localtime noauth localauth encrypt quiet timestamps ) ) {
	$self->{$key}++ if $args{$key};
    }

    # AFS::Command::VOS -> vos
    if ( $args{command} ) {
        my @commands = (split /\s+/,$args{command});
        push (@{$self->{command}},@commands);
    } else {
        @{$self->{command}} = lc((split(/::/,$class))[2]);
    }

    bless $self, $class;

    return $self;

}

sub errors {
    my $self = shift;
    return $self->{errors};
}

sub supportsOperation {
    my $self = shift;
    my $operation = shift;
    return $self->_operations($operation);
}

sub supportsArgument {
    my $self = shift;
    my $operation = shift;
    my $argument = shift;
    return unless $self->_operations($operation);
    return unless $self->_arguments($operation);
    return exists $self->{_arguments}->{$operation}->{$argument};
}

sub _Carp {
    my $self = shift;
    $Carp{carp}->(@_);
}

sub _Croak {
    my $self = shift;
    $Carp{croak}->(@_);
}

sub _operations {

    my $self = shift;
    my $operation = shift;

    my $class = ref $self;

    unless ( $self->{_operations} ) {

	my %operations = ();

	#
	# This hack is necessary to support the offline/online "hidden"
	# vos commands.  These won't show up in the normal help output,
	# so we have to check for them individually.  Since offline and
	# online are implemented as a pair, we can just check one of
	# them, and assume the other is there, too.
	#

	foreach my $type ( qw(default hidden) ) {

	    if ( $type eq 'hidden' ) {
		next unless $self->isa("AFS::Command::VOS");
	    }