STScI Logo

t_tchtype



include <tbset.h>

define	C2R_TYPE_ROW	1	# row ordered output table
define	C2R_TYPE_COL	2	# column ordered output table
define	C2R_TYPE_MI	3	# machine independent format
define	C2R_TYPE_TEXT	4	# text file output table

define	TBL_TYPE_MI	10		# temporary!

# tchtype -- Convert table type.
# This task copies tables, optionally converting from one type to another,
# for example from column ordered to row ordered.
#
# Phil Hodge, 30-Aug-1994  Task created.
# Phil Hodge,  4-Oct-1995  Modify to use tbnopen, etc, instead of fnt.
# Phil Hodge, 19-Apr-1999  Remove ttype from calling sequence of tbparse.

procedure tchtype()

pointer inlist		# scratch for list of input table names
pointer outlist		# scratch for list of output table names
pointer otype		# scratch for output table type (row, column, etc)
bool	duplicate	# copy table even if it's already the output type?
bool	verbose		# print table names?
#--
pointer itp		# input table descriptor
pointer otp		# output table descriptor
pointer sp
pointer intable		# scratch for output table name
pointer outtable	# scratch for output table name
pointer ilist, olist	# filename template lists for input, output
int	type		# type of output table (C2R_TYPE_ROW, etc)
int	intype, outtype # types of input & output (TBL_TYPE_S_ROW, etc)
int	junk
bool	inplace		# modify input in-place if output name is null
pointer tbnopen()
int	tbnlen(), tbnget()
pointer tbtopn()
int	tbpsta()
int	c2r_array(), c2r_next_o()
int	clgwrd()
bool	clgetb()

begin
	call smark (sp)
	call salloc (inlist, SZ_LINE, TY_CHAR)
	call salloc (outlist, SZ_LINE, TY_CHAR)
	call salloc (otype, SZ_LINE, TY_CHAR)
	call salloc (intable, SZ_LINE, TY_CHAR)
	call salloc (outtable, SZ_LINE, TY_CHAR)

	call clgstr ("intable", Memc[inlist], SZ_LINE)
	call clgstr ("outtable", Memc[outlist], SZ_LINE)
	type = clgwrd ("type", Memc[otype], SZ_LINE,
			"|row|column|mi|text")
	duplicate = clgetb ("duplicate")
	verbose = clgetb ("verbose")

	# Temporary!
	if (type == C2R_TYPE_MI)
	    call error (1, "machine independent format is not yet available")

	switch (type) {
	case C2R_TYPE_ROW:
	    outtype = TBL_TYPE_S_ROW
	case C2R_TYPE_COL:
	    outtype = TBL_TYPE_S_COL
	case C2R_TYPE_MI:
	    outtype = TBL_TYPE_MI
	case C2R_TYPE_TEXT:
	    outtype = TBL_TYPE_TEXT
	}

	ilist = tbnopen (Memc[inlist])
	olist = tbnopen (Memc[outlist])

	inplace = (tbnlen (olist) == 0)

	# Do for each table in the input list.
	while (tbnget (ilist, Memc[intable], SZ_LINE) != EOF) {

	    if (inplace)
		# Use scratch file in tmp$.
		call mktemp ("tmp$c2r", Memc[outtable], SZ_LINE)
	    else
		junk = c2r_next_o (olist,
			Memc[intable], Memc[outtable], SZ_LINE)

	    iferr {
		itp = tbtopn (Memc[intable], READ_ONLY, NULL)
	    } then {
		call eprintf (
			"Warning:  `%s' could not be opened as a table.\n")
		    call pargstr (Memc[intable])
		next
	    }
	    intype = tbpsta (itp, TBL_WHTYPE)
	    if (c2r_array (itp) == YES) {
		if (outtype != TBL_TYPE_MI && outtype != TBL_TYPE_S_ROW) {
		    call eprintf (
		"Table `%s' contains array entries; can't convert.\n")
			call pargstr (Memc[intable])
		    call tbtclo (itp)
		    next
		}
	    }
	    if (intype == outtype && !duplicate) {
		call eprintf ("Skipping table `%s'; type is already `%s'\n")
		    call pargstr (Memc[intable])
		    call pargstr (Memc[otype])
		call tbtclo (itp)
		next
	    }
	    otp = tbtopn (Memc[outtable], NEW_COPY, itp)
	    if (outtype != TBL_TYPE_FITS)
		call tbpset (otp, TBL_WHTYPE, outtype)
	    call tbtcre (otp)

	    # Get full file names.
	    call tbtnam (itp, Memc[intable], SZ_LINE)
	    call tbtnam (otp, Memc[outtable], SZ_LINE)

	    if (verbose) {
		if (inplace) {
		    call printf ("%s (inplace)\n")
			call pargstr (Memc[intable])
		} else {
		    call printf ("%s --> %s\n")
			call pargstr (Memc[intable])
			call pargstr (Memc[outtable])
		}
		call flush (STDOUT)
	    }

	    # Copy input table to output table.
	    call c2r_copy (itp, otp)

	    # Close tables.
	    call tbtclo (otp)
	    call tbtclo (itp)

	    if (inplace) {
		call delete (Memc[intable])
		call rename (Memc[outtable], Memc[intable])
	    }
	}

	call tbnclose (olist)
	call tbnclose (ilist)
	call sfree (sp)
end

# c2r_array -- check whether table contains array entries
# If the input table contains one or more columns which are array
# rather than scalar columns, this function returns YES; otherwise,
# it returns NO.

int procedure c2r_array (itp)

pointer itp		# i: input table descriptor
#--
pointer cp		# column descriptor
int	intype		# type of input table
int	col		# loop index for column number
pointer tbcnum()
int	tbpsta(), tbcigi()

begin
	# Earlier versions didn't allow array entries.
	if (tbpsta (itp, TBL_VERSION) < 2)
	    return (NO)

	# Check input table type.
	intype = tbpsta (itp, TBL_WHTYPE)
	if (intype != TBL_TYPE_MI && intype != TBL_TYPE_S_ROW)
	    return (NO)

	# Check each column to see if it's an array.
	do col = 1, tbpsta (itp, TBL_NCOLS) {
	    cp = tbcnum (itp, col)
	    if (tbcigi (cp, TBL_COL_LENDATA) > 1)
		return (YES)
	}

	return (NO)
end

# c2r_copy -- copy contents of table

procedure c2r_copy (itp, otp)

pointer itp		# i: input table descriptor
pointer otp		# i: output table descriptor
#--
pointer sp
pointer nullflag	# scratch for array of null flags
int	nrows, ncols	# number of rows and columns in input table
int	row		# loop index for row number
int	colnum		# loop index for column number
int	tbpsta()
errchk	tbrcpy, c2r_cp_col

begin
	call tbhcal (itp, otp)			# copy all header parameters

	nrows = tbpsta (itp, TBL_NROWS)
	ncols = tbpsta (itp, TBL_NCOLS)
	if (nrows <= 0)
	    return

	# If neither table is column ordered, or if there are more
	# columns than rows, copy row by row.
	if ((tbpsta (itp, TBL_WHTYPE) != TBL_TYPE_S_COL &&
	     tbpsta (otp, TBL_WHTYPE) != TBL_TYPE_S_COL) ||
		ncols > nrows) {

	    do row = 1, nrows
		call tbrcpy (itp, otp, row, row)
	    return
	}

	# Copy column by column.
	call smark (sp)
	call salloc (nullflag, nrows, TY_BOOL)

	# Copy each column.
	do colnum = 1, ncols
	    call c2r_cp_col (itp, otp, nrows, colnum, Memb[nullflag])

	call sfree (sp)
end

# c2r_cp_col -- copy a column
# This routine copies the contents of one column.

procedure c2r_cp_col (itp, otp, nrows, colnum, nullflag)

pointer itp, otp		# i: descriptors for input and output tables
int	nrows			# i: number of rows in input table
int	colnum			# i: column number in input table
bool	nullflag[ARB]		# o: scratch for array of null flags
#--
pointer sp
pointer buf			# scratch for column data
pointer icp			# pointer to column descriptor in input table
pointer ocp			# pointer to column descriptor in input table
char	colname[SZ_COLNAME]	# column name
int	dtype			# data type of column
pointer tbcnum()
int	tbcigi()
errchk	tbcgtb, tbcgtr, tbcgtd, tbcgti, tbcgts, tbcgtt,
	tbcptb, tbcptr, tbcptd, tbcpti, tbcpts, tbcptt

begin
	if (nrows <= 0)
	    return

	# We have the number of a column in the input table.  Get its name
	# and data type.  Using its name, find it in the output table.
	icp = tbcnum (itp, colnum)
	call tbcigt (icp, TBL_COL_NAME, colname, SZ_COLNAME)

	call tbcfnd (otp, colname, ocp, 1)
	if (ocp == NULL)
	    call error (1, "column not found")		# shouldn't happen

	# Get the data type from the output table.
	dtype = tbcigi (ocp, TBL_COL_DATATYPE)

	call smark (sp)
	if (dtype > 0)
	    call salloc (buf, nrows, dtype)
	else
	    # Character column; 1 + (-dtype) is length including EOS.
	    call salloc (buf, nrows*(1-dtype), TY_CHAR)

	# Copy the column.
	switch (dtype) {
	case TY_BOOL:
	    call tbcgtb (itp, icp, Memb[buf], nullflag, 1, nrows)
	    call tbcptb (otp, ocp, Memb[buf], 1, nrows)
	case TY_REAL:
	    call tbcgtr (itp, icp, Memr[buf], nullflag, 1, nrows)
	    call tbcptr (otp, ocp, Memr[buf], 1, nrows)
	case TY_INT:
	    call tbcgti (itp, icp, Memi[buf], nullflag, 1, nrows)
	    call tbcpti (otp, ocp, Memi[buf], 1, nrows)
	case TY_SHORT:
	    call tbcgts (itp, icp, Mems[buf], nullflag, 1, nrows)
	    call tbcpts (otp, ocp, Mems[buf], 1, nrows)
	case TY_DOUBLE:
	    call tbcgtd (itp, icp, Memd[buf], nullflag, 1, nrows)
	    call tbcptd (otp, ocp, Memd[buf], 1, nrows)
	default:
	    if (dtype < 0) {
		call tbcgtt (itp, icp, Memc[buf], nullflag, -dtype, 1, nrows)
		call tbcptt (otp, ocp, Memc[buf], -dtype, 1, nrows)
	    } else {
		call error (1, "memory corrupted?  bad data type in table")
	    }
	}
	call sfree (sp)
end

# c2r_next_o -- get the name of the next output file

int procedure c2r_next_o (olist, input, output, maxch)

pointer olist		# i: pointer to second imt or fnt list
char	input[ARB]	# i: name of input file
char	output[maxch]	# o: name of output file
int	maxch		# i: max size of string
#--
pointer sp
pointer oname		# name of output file or directory
pointer infile		# name of input file without directory or brackets
pointer scratch
int	root_len	# length of directory for input name
int	nchar		# value returned by tbnget
int	junk, hdu, tbparse()
int	tbnget()
int	fnldir(), isdirectory()
errchk	tbnget, tbparse, fnldir, isdirectory

begin
	call smark (sp)
	call salloc (oname, SZ_LINE, TY_CHAR)

	nchar = tbnget (olist, Memc[oname], SZ_LINE)
	if (nchar == EOF) {
	    output[1] = EOS
	    call sfree (sp)
	    return (EOF)
	}

	# If the output name is a directory, copy it to output, and
	# then append the input table name without its directory and
	# without any bracket suffix.
	if (isdirectory (Memc[oname], output, maxch) > 0) {

	    call salloc (infile, SZ_LINE, TY_CHAR)
	    call salloc (scratch, SZ_LINE, TY_CHAR)

	    # Copy the portion of the table name without brackets to
	    # Memc[infile]; we need to get rid of the brackets because
	    # they confuse fnldir and because the brackets may contain
	    # an extension number which could be inappropriate for the
	    # output file.
	    junk = tbparse (input, Memc[infile], Memc[scratch], SZ_LINE, hdu)

	    # Get the length of the directory prefix.
	    root_len = fnldir (Memc[infile], Memc[scratch], SZ_LINE)

	    # Append the name of the input file (without directory prefix
	    # and without any bracket suffix) to the output directory.
	    call strcat (Memc[infile+root_len], output, maxch)

	    # Rewind olist so we can get the name again.
	    call tbnrew (olist)

	} else {

	    call strcpy (Memc[oname], output, maxch)
	}

	call sfree (sp)

	return (nchar)
end

Source Code · Search Form · STSDAS