view release on metacpan or  search on metacpan

CL.pm  view on Meta::CPAN

				# environment variable to say so.
  }
  else{

    # Make educated guesses as to where the IRAF login.cl might be hiding.

    # If you have any other alternatives you could add them in here
    # This is only really for general places rather than unique odd places
    # though, use IRAF_START or the uparm parameter for those.

    my $found = 0;

    use Env qw(USER HOME);

    my $username = getlogin() || getpwuid($<) || $USER || `whoami`;

    foreach ($HOME,"$HOME/iraf","/home/$username/iraf","/home/$username") {

      if (-e "$_/login.cl" && -d "$_/uparm/"){
	$startdir = $_;
	$found = 1;
	last;
      }
    }

    croak "Do not know where to start IRAF from" if !$found;
  }

  return $startdir;
}

sub _lock_startdir{
  my $self = shift @_;

  sysopen(STARTDIR,"$self->{'iraf_start'}/Astro-IRAF-CL.LOCK",O_WRONLY|O_CREAT|O_EXCL) or croak "\nERROR: Could not get a lock on $self->{'iraf_start'}: $!\n\nThis IRAF start directory is already in use by another Astro::IRAF::CL object,\nyou must sp...

  $self->{'STARTDIR_FH'} = *STARTDIR;

}

sub _unlock_startdir{
  my $self = shift @_;

  close ($self->{'STARTDIR_FH'}) or croak "could not close lock FH";
  unlink "$self->{'iraf_start'}/Astro-IRAF-CL.LOCK";

}

sub _startup{
  my $self = shift @_;

  $self->_lock_startdir;

  chdir $self->{'iraf_start'} ||croak "Could not cd to $self->{'iraf_start'}";

  my $t = Expect->spawn('cl') || croak "Cannot spawn CL: $!";

  $t->expect(30,'-re',$self->{'cl_prompt'});
  croak "Did not get CL prompt after starting up" if $t->error;

  $self->{'dead'} = 0; # It is now alive.

  my $output = $t->before();
  my @output = split /\n/,$output;
  if ($self->{'display_startup'}){
    for (@output){print STDOUT $_ . "\n"}
  }

  chdir $self->{'work_dir'} || croak "Could not cd to $self->{'work_dir'}";

  $t->print("cd $self->{'work_dir'}\r");
  $t->expect($TIMEOUT,"cd $self->{'work_dir'}\r\n");
  $t->expect($TIMEOUT,'-re',$self->{'cl_prompt'});
  croak "Did not get CL prompt back after trying to cd to $self->{'cl_prompt'}"
    if $t->error;

  return $t;
}

sub restart{
  my $self = shift @_;

# Kill the session if it isn't already dead.

  $self->end() if !$self->{'dead'};

# Reset various parameters so everything works nicely.

  $self->{'dead'} = 0;
  $self->{'cl_prompt'} = qr/^cl>\s+/;

  $self->{'session'} = $self->_startup;

  $self->_get_available_commands_and_packages('main');

# Get the list of previously loaded packages then reset the list.

  my @prev_loaded_packages = @{$self->{'packages'}};
  $self->{'packages'} = [];

# Load packages that were originally specified at start time.

  if (exists $self->{'start_params'}{'packages'}){
    foreach my $package (@{$self->{'start_params'}{'packages'}}){
      $self->load_package($package);
    }
  }

# Set definitions that were originally specified.

  if (exists $self->{'start_params'}{'set'}){
    $self->set(%{$self->{'start_params'}{'set'}});
  }

# Load any other packages that were subsequently loaded.

  foreach my $package (@prev_loaded_packages){
    $self->load_package($package) if !$self->package_is_loaded($package);
  }

}