The genericAPI.tcl Script

It is anticipated, and it is the criterion for their inclusion here, that all or most of these functions will be used in all or many of the other API's comprising the LIGO Data Analysis System.

Name: Main

Description:
Define the installation directory for the LDAS modules.
This is the "main" procedure for the genericAPI.tcl module.
The local directory structure may be defined in any of the following ways:

The environment variables LDASDIR, LDASHELPDIR, LDASLOGDIR, etc. can be set to the absolute path names.
The variables LDAS, LDASHELP,LDASLOG, etc. can be set in the resource file to the absolute paths.
Either LDASDIR or LDAS can be set, in which case LDASHELP and LDASLOG will be inferred to be the "help" and "log" directories immediately below it.
If none of the variables is set then the current working directory will be taken as the top of the LDAS tree, and the help and log directories will be assumed to exist immediately below it.

Comments:
In any case where a directory location is inferred an announcement will be made to stderr describing the default action.

set ::RCS_ID_genericAPItcl { $Id: genericAPI.tcl,v 1.671 2009/09/28 18:44:57 emaros Exp $ }
set ::RCS_ID_genericAPItcl [ string trim $::RCS_ID_genericAPItcl "\$" ]
Prints a tcl proc callstack in stderr if resource is enabled
Must reboot API to take effect
if { [ info exist ::DEBUG_PROC ] && $::DEBUG_PROC } {
	catch { info proc *proc } err
	if	{ [ lsearch $err proc ] == -1 } {
    	rename proc tcl_proc
    	set ::native_proc tcl_proc
		puts stderr "tcl command 'proc' renamed to tcl_proc"
	}
	if	{ [ lsearch [ info command tcl_proc ] tcl_proc ] != -1 } {
		tcl_proc proc { args } {
			if 	{ [ lsearch [ info command puts ] puts ] != -1 } {
				set putcmd puts
			} 	elseif { [ lsearch [ info command tcl_puts ] tcl_puts ] != -1 } {
				set putcmd tcl_puts
			}	 else {
				set putcmd ::puts
			}
	
			;## no tcl_puts
			# $putcmd "args '$args'"
			set name [ lindex $args 0 ]
			set params [ lindex $args 1 ]
			set body [ lrange $args 2 end ]
			set body [ lindex $body 0 ]
			#$putcmd stderr "no renamed puts: name=$name, params='$params', body '$body' "
	
			set text "catch { info level -1 } caller\n$putcmd \"\[ clock seconds \]: $name called by \$caller\""
			set body "$text\n$body"
	
			#$putcmd "body '$body'"
	
			eval uplevel tcl_proc [ list $name [ list $params ] [ list $body ] ]
			# $putcmd "$name proc [ info proc $name ]"
		}
	}
} else {
	set ::native_proc proc
	# addLogEntry "tcl command 'proc' is unchanged" purple
}

§ § § package provide generic 1.0 set genericAPI TRUE package require -exact stack 1.0 package require -exact procfs 1.0 package require -exact smtp 1.0 package require -exact service 1.0 package require -exact log 1.0 package require -exact ilwd 1.0 package require -exact cmd 1.0 package require -exact sock 1.0 package require -exact stat 1.0 ;##package require -exact gui 1.0 package require -exact key 1.0 package require -exact queue 1.0 #package require FTP 1.3 package require -exact timers 1.0 package require http 2.0 package require base64 1.0 package require gpstime 1.0 package require RawGlobus 1.0 package require RawGlobusClient 1.0 § § § Create custom versions of some internal procs set ::native_trace trace if { [ lsearch [ info proc setAlert ] setAlert ] == -1 } { ##------------------------------------------------------------------- ## Use 8.3 syntax to ensure compatability ##------------------------------------------------------------------- $::native_trace variable ::TID_FINISHED rw ::setAlertDebugCB } else { ::setAlertDebugCB } § § § if { [ lsearch [ info proc *trace ] tcl_trace ] == -1 } { rename trace tcl_trace set ::native_trace tcl_trace } § § § unset ::native_trace
Name: trace

Description:
Redefine trace to allow for additional debugging
Parameters:

The genericAPI.tcl Script

Modification Date: 11/04/2009

Table of Procedures

Back to Top