view release on metacpan or  search on metacpan

lib/Rex/Config.pm  view on Meta::CPAN

    }
  }
}

sub unset {
  my ( $class, $var ) = @_;
  $set_param->{$var} = undef;
  delete $set_param->{$var};
}

sub get {
  my ( $class, $var ) = @_;
  $var or return;
  if ( exists $set_param->{$var} ) {
    return $set_param->{$var};
  }
}

sub get_all {
  my ($class) = @_;
  return $set_param;
}

=head2 register_config_handler($topic, $code)

With this function it is possible to register own sections in the users config file (C<$HOME/.rex/config.yml>).

Example:

 Rex::Config->register_config_handler("foo", sub {
  my ($param) = @_;
  print "bar is: " . $param->{bar} . "\n";
 });

And now the user can set this in his configuration file:

 base:
   user: theuser
   password: thepassw0rd
 foo:
   bar: baz

=cut

sub register_config_handler {
  my ( $class, $topic, $code ) = @_;

  if ( !ref($HOME_CONFIG) ) { $HOME_CONFIG = {}; }
  $HOME_CONFIG->{$topic} = $code;

  if ( ref($HOME_CONFIG_YAML) && exists $HOME_CONFIG_YAML->{$topic} ) {
    &$code( $HOME_CONFIG_YAML->{$topic} );
  }
}

sub read_config_file {
  my ($config_file) = @_;
  $config_file ||= _home_dir() . "/.rex/config.yml";

  if ( -f $config_file ) {
    my $yaml = eval { local ( @ARGV, $/ ) = ($config_file); <>; };
    eval { $HOME_CONFIG_YAML = Load($yaml); };

    if ($@) {
      print STDERR "Error loading $config_file\n";
      print STDERR "$@\n";
      exit 2;
    }

    for my $key ( keys %{$HOME_CONFIG} ) {
      if ( exists $HOME_CONFIG_YAML->{$key} ) {
        my $code = $HOME_CONFIG->{$key};
        &$code( $HOME_CONFIG_YAML->{$key} );
      }
    }
  }
}

sub read_ssh_config_file {
  my ($config_file) = @_;
  $config_file ||= _home_dir() . '/.ssh/config';

  if ( -f $config_file ) {
    my @lines = eval { local (@ARGV) = ($config_file); <>; };
    %SSH_CONFIG_FOR = _parse_ssh_config(@lines);
  }
}

sub _parse_ssh_config {
  my (@lines) = @_;

  my %ret = ();

  my ( @host, $in_host );
  for my $line (@lines) {
    chomp $line;
    next if ( $line =~ m/^\s*#/ );
    next if ( $line =~ m/^\s*$/ );

    if ( $line =~ m/^Host(?:\s*=\s*|\s+)(.*)$/i ) {
      my $host_tmp = $1;
      @host    = split( /\s+/, $host_tmp );
      $in_host = 1;
      for my $h (@host) {
        $ret{$h} = {};
      }
      next;
    }
    elsif ($in_host) {

      #my ($key, $val) = ($line =~ m/^\s*([^\s]+)\s+=?\s*(.*)$/);
      $line =~ s/^\s*//g;
      my ( $key, $val_tmp ) = split( /[\s=]/, $line, 2 );
      $val_tmp =~ s/^[\s=]+//g;
      my $val = $val_tmp;

      $val =~ s/^\s+//;
      $val =~ s/\s+$//;
      for my $h (@host) {
        $ret{$h}->{ lc($key) } = $val;
      }
    }
  }

  return %ret;
}

sub import {
  read_ssh_config_file();
  read_config_file();
}

_register_config_handlers();

sub _register_config_handlers {
  __PACKAGE__->register_config_handler(
    base => sub {
      my ($param) = @_;

      for my $key ( keys %{$param} ) {

        if ( $key eq "keyauth" ) {
          $key_auth = $param->{keyauth};
          next;