Util::Xanadu (version 1.2)

package Util::Xanadu;
##############################################################################
#
# DESCRIPTION: This Tool subclass adds functionality for running
# DESCRIPTION: xspec and ximage
#
# HISTORY
# HISTORY: $Log: Xanadu.pm,v $
# HISTORY: Revision 1.2  2006/08/01 20:35:34  apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2002-04-01
# HISTORY: Now allows an Xserver display to be specified when initializing
# HISTORY: 
# HISTORY: 1.1 -> 1.2 2004-02-11
# HISTORY: Modified environment setup to conform to the new Tool scheme.
# 
# VERSION: 1.2
#
##############################################################################

use Util::Tool;
@ISA=("Util::Tool");
use strict;

my $INVOCATION;
my $BIN;
my $LIB;
my %ENVIRONMENT=();

sub new {
    my $self=shift;
    my $program=shift;

    $self=$self->SUPER::new($BIN,$program);
    
    #####################################
    # set the paths 
    #####################################
    $self->bins($BIN);
    $self->libs($LIB);
    
    ##################################
    # set the temporary command file
    ##################################
    $INVOCATION++;
    $self->{COMMAND_FILE} = "${program}_${INVOCATION}_commands.tmp";

    if($program eq "xspec" ) {
        $self->command_line("-", $self->{COMMAND_FILE} );

    } elsif($program eq "ximage") {
        $self->command_line("@".$self->{COMMAND_FILE} );
    } 

    return $self;
   
}


######################
# ACCESSORS:
######################

########################################################################
# Returns a hash of environment variables which must
# be set before running this tool
########################################################################
sub environment {
    my $self=shift;

    return {%ENVIRONMENT};

} # end of environment method

####################################################################
# get or set the executable directories in the class data.
# This method also sets a number of environment variables
# required by XANADU.
##################################################################
sub bin { #(directory, [display])
    my $self=shift;
    if (@_) {
        #######################################################
        # set the bin directory and some environment variables
        #######################################################
        $BIN = shift;
        my $display=shift || ":0.0";

        my $xanadu=$BIN;
        $xanadu =~ s/\/[^\/]*$//;
        $ENVIRONMENT{XANBIN}=$xanadu;
        $ENVIRONMENT{XRDEFAULTS} ="$xanadu/xrdefaults";
        $ENVIRONMENT{POW_LIBRARY}="$xanadu/lib/pow";
        $ENVIRONMENT{PGPLOT_DIR} ="$xanadu/lib";

        $LIB="$xanadu/lib";

        $xanadu =~ s/\/[^\/]*$//;
        $ENVIRONMENT{XANADU}=$xanadu;



       #################################################################
       # Ximage expects an X server, even if it never actually
       # displays anything on it. If there isn't one it complains.
       # Here we simply set the display and assume that it is actually
       # running on the system.
       #################################################################
       $ENVIRONMENT{DISPLAY} = $display;

    }

    return $BIN

} # end of bin method



#########################################################################
# set the command script to be fed to the xanadu tool
#########################################################################
sub script { #(commands)
    my $self = shift;

    unlink $self->{COMMAND_FILE};
    open  SCRIPT, ">$self->{COMMAND_FILE}";
    print SCRIPT join("\n", @_) ."\n";
    close SCRIPT;

    return $self;

} # end of script method

############################################################################
############################################################################
# clean up temporary files
############################################################################
sub DESTROY {
    my $self=shift;

    unlink $self->{COMMAND_FILE};

    unlink "xautosav.xcm"; # xspec file

    # check for an overridden destructor...
    $self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}


1;