File Coverage

blib/lib/Shell/EnvImporter.pm

Criterion	Covered	Total	%
statement	148	170	87.0
branch	32	46	69.5
condition	4	6	66.6
subroutine	29	30	96.6
pod	4	6	66.6
total	217	258	84.1

package Shell::EnvImporter;

use strict;
use warnings;
no warnings 'uninitialized';

our @ISA = qw();

our $VERSION = '1.06';

use Shell::EnvImporter::Shell;

use Class::MethodMaker 2.0 [
    new     => [qw(-init new)],
    scalar  => [qw(
      debuglevel

      command
      file
      shell

      auto_run
      auto_import
      import_modified
      import_added
      import_removed
      import_filter

      shellobj
      result
    )],

  ];



use constant DEFAULT_SHELL    => 'sh';


use constant DEFAULTS => (
  auto_run         => 1,
  auto_import      => 1,
  import_modified  => 1,
  import_added     => 1,
  import_removed   => 0,

  shell            => DEFAULT_SHELL,
);


##########
sub init {
##########
  my $self     = shift;
  my %args     = @_;
  my %defaults = (DEFAULTS);

  # Set supplied fields with defaults
  my @fields = (keys %args, keys %defaults);
  my %fields; @fields{@fields} = (1) x @fields;
  @fields = keys %fields;

  foreach my $field (@fields) {
    if ($self->can($field)) {
      my $curval = $self->$field();
      my $arg    = exists($args{$field}) ? $args{$field} : $defaults{$field};
      if (ref($curval) =~ /ARRAY/) {
        $self->$field(@$arg);
      } elsif (ref($curval) =~ /HASH/) {
        $self->$field(%$arg);
      } else {
        $self->$field($arg);
      }
    }
  }

  # Create a shell object
  $self->dprint(1, "Creating shell object\n");
  my $shellobj = $self->_get_shell() or return;

  # If file is supplied, command is to source the file.
  if (defined($self->file)) {
    $self->dprint(1, "Setting command to source '", $self->file, "'\n");
    $self->command($shellobj->sourcecommand($self->file));
  }

  # Run the command if requested.
  $self->run() if ($self->auto_run);

}



#########
sub run {
#########
  my $self    = shift;
  my $command = shift || $self->command;

  $self->dprint(1, "Executing command\n");

  unless (defined($command)) {
    $@ = "Can't run without a command";
    return undef;
  };

  my $rv = $self->shellobj->run(
             command => $command,
           );

  $self->result($rv);

  if ($self->auto_import) {
    if ($self->import_filter) {
      $self->env_import_filtered();
    } else {
      $self->env_import;
    }
  }

  return $rv;


}


################
sub env_import {
################
  my $self   = shift;
  my @vars;

  $self->dprint(1, "Performing policy import\n");

  unless (defined($self->result)) {
    $@ = "Can't import before a successful run";
    return undef;
  }

  if (ref($_[0])) {
    @vars = @{$_[0]};
  } elsif (@_) {
    @vars = @_;
  } else {
    @vars = $self->result->changed_keys;
  }

  my %import; @import{@vars} = (1) x @vars;

  foreach my $var ($self->result->changed_keys) {
    next unless ($import{$var});
    my $type   = $self->result->changed_index($var)->type;
    my $newval = $self->result->changed_index($var)->value;
    my $fn = "import_${type}";
    next unless ($self->$fn());

    $self->dprint(2, "Importing $type var $var=$newval\n");

    $self->_import_var($var, $newval, $type);

  }

  return $self->result;

}


#########################
sub env_import_filtered {
#########################
  my $self   = shift;
  my $filter = shift || $self->import_filter;

  $self->dprint(1, "Performing filtered import\n");

  unless (ref($filter)) {
    $@ = "Can't do filtered import without a filter";
    return undef;
  }
  unless (defined($self->result)) {
    $@ = "Can't import before a successful run";
    return undef;
  }

  foreach my $var ($self->result->changed_keys) {
    my $type   = $self->result->changed_index($var)->type;
    my $newval = $self->result->changed_index($var)->value;
    next unless ($filter->($var, $newval, $type));

    $self->dprint(2, "Importing $type var $var=$newval\n");

    $self->_import_var($var, $newval, $type);

  }

  return $self->result;

}




#################
sub restore_env {
#################
  my $self = shift;

  $self->dprint(1, "Restoring environment\n");

  unless (defined($self->result)) {
    $@ = "Can't restore before a successful run";
    return undef;
  }

  # Delete all environment variables
  map(delete($ENV{$_}), keys %ENV);

  # Restore them from the result backup
  @ENV{$self->result->start_env_keys} = $self->result->start_env_values;

  return 1;

}



############
sub dprint {
############
  my $self  = shift;
  my $level = shift;

  my($package, $filename, $line) = caller;

  print STDERR "-" x $level, " $package:$line : ", @_
    if ($self->debuglevel >= $level);

}




##############################################################################
########################### Private subroutines  #############################
##############################################################################



################
sub _get_shell {
################
  my $self      = shift;
  my $shellname = $self->shell;

  my $shellclass = join("::", ref($self), 'Shell', $shellname);

  $self->dprint(2, "Shell class: $shellclass\n");

  eval "use $shellclass;";
  return undef if ($@);

  my $shellobj;
  unless ($shellobj = $shellclass->new(debuglevel => $self->debuglevel)) {
    $@ = "Couldn't create shell object";
    return undef;
  }

  $self->shellobj($shellobj);

  return $shellobj;

}




#################
sub _import_var {
#################
  my $self   = shift;
  my $var    = shift;
  my $newval = shift;
  my $type   = shift;

  if ($type eq 'removed') {
    delete($ENV{$var});
  } else {
    $ENV{$var} = $newval;
  }
  $self->result->imported_push($var);
}






1;

__END__