view release on metacpan or  search on metacpan

lib/App/ClusterSSH/Host.pm  view on Meta::CPAN

package App::ClusterSSH::Host;

use strict;
use warnings;

use version;
our $VERSION = version->new('0.03');

use Carp;
use Net::hostent;

use base qw/ App::ClusterSSH::Base /;

our %ssh_hostname_for;
our %ssh_configs_read;

sub new {
    my ( $class, %args ) = @_;

    if ( !$args{hostname} ) {
        croak(
            App::ClusterSSH::Exception->throw(
                error => $class->loc('hostname is undefined')
            )
        );
    }

    # remove any keys undef values - must be a better way...
    foreach my $remove (qw/ port username geometry /) {
        if ( !$args{$remove} && grep {/^$remove$/} keys(%args) ) {
            delete( $args{$remove} );
        }
    }

    my $self
        = $class->SUPER::new( ssh_config => "$ENV{HOME}/.ssh/config", %args );

    # load in ssh hostname for later use
    if ( !%ssh_hostname_for || !$ssh_configs_read{ $self->{ssh_config} } ) {
        $self->read_ssh_file( $self->{ssh_config} );

        $self->debug( 5, 'Have the following ssh hostnames' );
        $self->debug( 5, '  "', $_, '"' )
            foreach ( sort keys %ssh_hostname_for );
    }

    return $self;
}

sub read_ssh_file($$) {
    my ($self)     = shift;
    my ($filename) = glob(shift);
    $self->debug( 3, 'Reading SSH file: ', $filename );

    $ssh_configs_read{$filename} = 1;

    if ( open( my $ssh_config_fh, '<', $filename ) ) {
        while ( my $line = <$ssh_config_fh> ) {
            chomp $line;

            if ( $line =~ /^\s*include\s+(.+)/i ) {
                $self->read_ssh_file($1);
                next;
            }

            next unless ( $line =~ m/^\s*host\s+(.*)/i );

            # account for multiple declarations of hosts
            $ssh_hostname_for{$_} = 1 foreach ( split( /\s+/, $1 ) );
        }
        close($ssh_config_fh);
    }
    else {
        $self->debug( 3, 'Unable to read ', $filename, ': ', $!, $/ );
    }
}

sub get_hostname {
    my ($self) = @_;
    return $self->{hostname};
}

sub get_username {
    my ($self) = @_;
    return $self->{username} || q{};
}

sub get_type {
    my ($self) = @_;
    if ( $self->check_ssh_hostname ) {
        return 'ssh_alias';
    }
    return $self->{type} || q{};
}

sub get_geometry {