view release on metacpan or  search on metacpan

CL.pm  view on Meta::CPAN

use Expect 1.15;
use Env qw(IRAF_START);

my $DEBUG = 0;

$Expect::Debug=$DEBUG;
$Expect::Exp_Internal=$DEBUG;
$Expect::Log_Stdout=$DEBUG;

$TIMEOUT = 10; # Time out for internal commands (seconds).

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

  my $self = bless {}, $class;

  $self->{'start_params'}    = \%params; #Need this to allow restart post-crash

  $self->{'iraf_start'}      = $params{'iraf_start'}||$self->_get_iraf_start();

  $self->{'debug'}           = $params{'debug'}           || 0;
  $self->{'work_dir'}        = $params{'work_dir'}        || cwd;
  $self->{'log'}             = $params{'log'}             || *STDERR;
  $self->{'display_startup'} = $params{'display_startup'} || 0;

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

  $self->{'packages'}        = []; # For loading/unloading packages.
  $self->{'command_history'} = [];
  $self->{'dead'}            = 1; # It is dead until the CL is running.

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

  $self->_get_available_commands_and_packages('main');

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

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

  return $self;
}

sub _get_iraf_start{
  my $self = shift @_;

  my $startdir;

  if (defined $IRAF_START){	# If a user has an odd place for their IRAF
    $startdir = $IRAF_START;	# base directory then they should use this
				# 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'}){