view release on metacpan or  search on metacpan

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

#
# $Id$
#
# (c) 2003-2004 Morgan Stanley and Co.
# See ..../src/LICENSE for terms of distribution.
#

package AFS::Command::Base;

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"

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

    delete $self->{olderr};

    my $newerr = IO::File->new($self->{tmpfile}) || do {
	$self->_Carp("Unable to reopen $self->{tmpfile}: $ERRNO");
	return;
    };

    $self->{errors} = "";

    while ( <$newerr> ) {
	$self->{errors} .= $_;
    }

    $newerr->close() || do {
	$self->_Carp("Unable to close $self->{tmpfile}: $ERRNO");
	return;
    };

    unlink($self->{tmpfile}) || do {
	$self->_Carp("Unable to unlink $self->{tmpfile}: $ERRNO");
	return;
    };

    delete $self->{tmpfile};

    return 1;

}

sub _parse_arguments {

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

    my $arguments = $self->_arguments($self->{operation});

    unless ( defined $arguments ) {
	$self->_Carp("Unable to obtain arguments for $class->$self->{operation}");
	return;
    }

    $self->{errors} = "";

    $self->{cmds} = [];

    if ( $args{inputfile} ) {

	push( @{$self->{cmds}}, [ 'cat', $args{inputfile} ] );

    } else {

	my @argv = ( @{$self->{command}}, $self->{operation} );

	foreach my $key ( keys %args ) {
	    next unless $arguments->{aliases}->{$key};
	    $args{$arguments->{aliases}->{$key}} = delete $args{$key};
	}

	foreach my $key ( qw( noauth localauth encrypt ) ) {
	    next unless $self->{$key};
	    $args{$key}++ if exists $arguments->{required}->{$key};
	    $args{$key}++ if exists $arguments->{optional}->{$key};
	}

	unless ( $self->{quiet} ) {
	    $args{verbose}++ if exists $arguments->{optional}->{verbose};
	}

	foreach my $type ( qw( required optional ) ) {

	    foreach my $key ( keys %{$arguments->{$type}} ) {

		my $hasvalue = $arguments->{$type}->{$key};

		if ( $type eq 'required' ) {
		    unless ( exists $args{$key} ) {
			$self->_Carp("Required argument '$key' not provided");
			return;
		    }
		} else {
		    next unless exists $args{$key};
		}

		if ( $hasvalue ) {
		    if ( ref $args{$key} eq 'HASH' || ref $args{$key} eq 'ARRAY' ) {
			unless ( ref $hasvalue eq 'ARRAY' ) {
			    $self->_Carp("Invalid argument '$key': can't provide a list of values");
			    return;
			}
			push(@argv,"-$key");
			foreach my $value ( ref $args{$key} eq 'HASH' ? %{$args{$key}} : @{$args{$key}} ) {
			    push(@argv,$value);
			}
		    } else {
			push(@argv,"-$key",$args{$key});
		    }
		} else {
		    push(@argv,"-$key") if $args{$key};
		}

		delete $args{$key};

	    }

	}

	if ( %args ) {
	    $self->_Carp("Unsupported arguments: " . join(' ',sort keys %args));
	    return;
	}

	push( @{$self->{cmds}}, \@argv );

    }

    return 1;

}