view release on metacpan or  search on metacpan

CL.pm  view on Meta::CPAN

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'}){
    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;

CL.pm  view on Meta::CPAN

Various input parameters can be specified: iraf_start, debug, work_dir, display_startup, log, packages (ARRAY), set (HASH), for example:

  my $iraf = Astro::IRAF::CL->new(debug => 1,
                                  log => *FH,
                                  set => {foo => 1,
                                          bar => 2},
                                  packages => ['mscred','cfh12k']);


=over 4

=item

B<debug> controls how much output is sent to the stderr, this is generally just the command that was actually executed within the IRAF session, its default is zero, i.e. no extra output.

=item

B<work_dir> is where any commands should be executed, its default is the current directory.

=item

B<display_startup> controls whether or not to show all the information (e.g. motd) from the IRAF startup, not much use in a script so off (zero) by default.

=item

B<log> is the filehandle to which logging information should be sent, the default is STDERR.

=item

B<set> is a list of variables to setup when the IRAF session is started.

=item

B<packages> is list of IRAF packages to load on startup.

=back

As with a normal IRAF CL session when a CL object is created it has to be done from the place where the uparm directory and login.cl file are located. If you have not created these files it is done using mkiraf(1). This place can be specified via the...

=over 4

=item 1.

$HOME

=item 2.

$HOME/iraf

=item 3.

/home/$username/iraf

=item 4.

/home/$username

=back

the script uses the first directory where it finds the file F<login.cl> and the directory F<uparm>. $HOME is the environment variable of that name. The variable $username is found by the script using getlogin(3C), getpwuid(3C), the environment variab...

=head2 Loading/Unloading IRAF packages

=over 4

=item *

load_package($package) - load an IRAF package, will check to make sure the package exists and will die if it does not.

=item *

package_is_loaded($package) - Returns 1 if package is loaded, else 0, useful for ensuring a package is not loaded twice (this isn't fatal).

=item *

package_exists($package) - Checks if an IRAF package is available for loading, (via the IRAF command "deftask") returns 1, if true, else 0.

=item *

unload_package($package) - Unload a package (the same as typing "bye" in CL). Note that you must unload in the correct order (last in - first out) or the script will die as it would not be able to keep a correct track of the current package and its a...

=item *

unload_all_packages - Unload all packages that have been loaded in the current session, this is called automatically when the script ends or the object goes out of scope in anyway.

=item *

get_current_package - Returns the name of the current package, if none is loaded you get an undefined string.

=item *

list_available_packages - List all the currently available packages.

=item *

list_available_commands - List all the currently available commands.

=item *

package_is_available($package) - Slightly different from package_exists(), as it is less rigorous. It purely checks whether the package should exist, not whether it is actually defined.

=item *

command_is_available($command) - Similar to package_is_available() but for commands.

=back

=head2 Setting/Reading IRAF variables

These are similar in style to shell environment variables and last for the full length of the IRAF CL session. I have effectively overloaded a couple of the functions and added the exists() command.

=over 4

=item *

set(key1 => $value1, key2 => $value2, key3 => $value3) - set any number of variables to their associated values.

=item *

show($key) - returns the value of the variable.