view release on metacpan or  search on metacpan

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

sub _restore_stderr {

    my $self = shift;

    STDERR->fdopen( $self->{olderr}->fileno(), "w") || do {
	$self->_Carp("Unable to restore stderr: $ERRNO");
	return;
    };

    $self->{olderr}->close() || do {
	$self->_Carp("Unable to close saved stderr: $ERRNO");
	return;
    };

    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));