From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/xtools/syshost.x | 232 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 232 insertions(+) create mode 100644 pkg/xtools/syshost.x (limited to 'pkg/xtools/syshost.x') diff --git a/pkg/xtools/syshost.x b/pkg/xtools/syshost.x new file mode 100644 index 00000000..8136e3ae --- /dev/null +++ b/pkg/xtools/syshost.x @@ -0,0 +1,232 @@ +include +include + + +# SYSHOST -- If a task which calls this routine is executed from the host +# command line (i.e. not through a CL) set any parameters not set on the +# command line (e.g. with keyword=value or @file arguments). The application +# provides three files to search in order. The first two are keyword=value +# files and the last is a parameter file. The parameter file may be encoded +# as a compiled procedure (see txtcompile). For this reason xt_txtopen is +# used which transparently handles disk text files and text encoding +# procedures. +# +# The process type is the return value. +# The show_pset argument is the name of a boolean parameter to query +# for showing the default parameter set. The value of this is returned +# for show_val. If the parameter is not used (a null string) or was +# not specified by the user the return value is false. + +int procedure syshost (keyfile1, keyfile2, parfile, show_pset, show_val) + +char keyfile1[ARB] #I Keyword file +char keyfile2[ARB] #I Keyword file +char parfile[ARB] #I Parameter file +char show_pset[ARB] #I Parameter for requestiong show +bool show_val #O Result of show request +int stat #R Return value + +char line[SZ_LINE], param[SZ_FNAME], value[SZ_LINE] +int i, ip, fd, tok + +bool clgetb(), streq() +int clstati(), access(), fscan(), ctotok(), strncmp(), xt_txtopen() +pointer clc_find() +errchk xt_getpars, xt_txtopen + +begin + # Check if the task is called from the host. + stat = clstati (CL_PRTYPE) + if (stat != PR_HOST) + return (stat) + + # Read user keyword=value files. + if (keyfile1[1] != EOS && access(keyfile1,0,0) == YES) + call xt_getpars (keyfile1) + if (keyfile2[1] != EOS && access(keyfile2,0,0) == YES) + call xt_getpars (keyfile2) + + # Read parameter file. + if (parfile[1] != EOS && + (access(parfile,0,0)==YES || strncmp (parfile, "proc:", 5)==0)) { + + # Open parameter file. + fd = NULL + fd = xt_txtopen (parfile) + + # Check for request to show default parameters. + if (show_pset[1] != EOS && clc_find(show_pset,param,SZ_FNAME)>0) + show_val = clgetb (show_pset) + else + show_val = false + + # Scan parameter file lines and parse them. + while (fscan (fd) != EOF) { + call gargstr (line, SZ_LINE) + + ip = 1 + if (ctotok (line, ip, param, SZ_FNAME) != TOK_IDENTIFIER) + next + if (streq (param, "mode")) + next + for (i=0; i<3 && ctotok(line,ip,value,SZ_LINE)!=TOK_EOS;) { + if (value[1] == ',') + i = i + 1 + } + tok = ctotok (line, ip, value, SZ_LINE) + switch (tok) { + case TOK_NUMBER, TOK_STRING, TOK_IDENTIFIER: + ; + default: + value[1] = EOS + } + + # Enter in clcache if not already defined. + if (clc_find (param, line, SZ_LINE) == NULL) + call clc_enter (param, value) + + # Show parameter if desired. + if (show_val) { + switch (tok) { + case TOK_STRING: + call printf ("%s = ""%s""\n") + call pargstr (param) + call pargstr (value) + default: + call printf ("%s = %s\n") + call pargstr (param) + call pargstr (value) + } + } + } + + # Close parameter file. + call xt_txtclose (fd) + } + + return (stat) +end + + +# The following are copies of sys_getpars and sys_paramset with the +# following changes. +# - Return an error rather than a warning for a bad syntax +# - Enter parameter in CL cache only if not previously set + + +include + +define SZ_VALSTR 1024 +define SZ_CMDBUF (SZ_COMMAND+1024) + +# XT_GETPARS -- Read a sequence of param=value parameter assignments from +# the named file and enter them into the CLIO cache for the task. + +procedure xt_getpars (fname) + +char fname # pset file + +bool skip +int lineno, fd +pointer sp, lbuf, err, ip +int open(), getlline() +errchk open, getlline + +begin + call smark (sp) + call salloc (lbuf, SZ_CMDBUF, TY_CHAR) + + fd = open (fname, READ_ONLY, TEXT_FILE) + + # Skip whitespace for param = value args in a par file. + skip = true + + lineno = 0 + while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) { + lineno = lineno + 1 + for (ip=lbuf; IS_WHITE (Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '#' || Memc[ip] == '\n') + next + iferr (call xt_paramset (Memc, ip, skip)) { + for (; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + Memc[ip] = EOS + call salloc (err, SZ_LINE, TY_CHAR) + call sprintf (Memc[err], SZ_LINE, + "Bad param assignment, line %d: `%s'\n") + call pargi (lineno) + call pargstr (Memc[lbuf]) + call close (fd) + call error (1, Memc[err]) + } + } + + call close (fd) + call sfree (sp) +end + + +# XT_PARAMSET -- Extract the param and value substrings from a param=value +# or switch argument and enter them into the CL parameter cache. (see also +# clio.clcache). + +procedure xt_paramset (args, ip, skip) + +char args[ARB] # argument list +int ip # pointer to first char of argument +bool skip # skip whitespace within "param=value" args + +pointer sp, param, value, op, clc_find() +int stridx() + +begin + call smark (sp) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_VALSTR, TY_CHAR) + + # Extract the param field. + op = param + while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) { + Memc[op] = args[ip] + op = op + 1 + ip = ip + 1 + } + Memc[op] = EOS + + # Advance to the switch character or assignment operator. + while (IS_WHITE (args[ip])) + ip = ip + 1 + + switch (args[ip]) { + case '+': + # Boolean switch "yes". + ip = ip + 1 + call strcpy ("yes", Memc[value], SZ_VALSTR) + + case '-': + # Boolean switch "no". + ip = ip + 1 + call strcpy ("no", Memc[value], SZ_VALSTR) + + case '=': + # Extract the value field. This is either a quoted string or a + # string delimited by any of the metacharacters listed below. + + ip = ip + 1 + if (skip) { + while (IS_WHITE (args[ip])) + ip = ip + 1 + } + call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR) + + default: + call error (1, "IRAF Main: command syntax error") + } + + # Enter the param=value pair into the CL parameter cache. + if (clc_find (Memc[param], Memc[param], SZ_FNAME) == NULL) + call clc_enter (Memc[param], Memc[value]) + + call sfree (sp) +end -- cgit