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/utilities/nttools/tcopy/iswholetab.x | 24 +++ pkg/utilities/nttools/tcopy/mkpkg | 13 ++ pkg/utilities/nttools/tcopy/tcopy.x | 283 +++++++++++++++++++++++++++++++ pkg/utilities/nttools/tcopy/tdelete.x | 126 ++++++++++++++ pkg/utilities/nttools/tcopy/trename.x | 185 ++++++++++++++++++++ 5 files changed, 631 insertions(+) create mode 100644 pkg/utilities/nttools/tcopy/iswholetab.x create mode 100644 pkg/utilities/nttools/tcopy/mkpkg create mode 100644 pkg/utilities/nttools/tcopy/tcopy.x create mode 100644 pkg/utilities/nttools/tcopy/tdelete.x create mode 100644 pkg/utilities/nttools/tcopy/trename.x (limited to 'pkg/utilities/nttools/tcopy') diff --git a/pkg/utilities/nttools/tcopy/iswholetab.x b/pkg/utilities/nttools/tcopy/iswholetab.x new file mode 100644 index 00000000..a2a981ed --- /dev/null +++ b/pkg/utilities/nttools/tcopy/iswholetab.x @@ -0,0 +1,24 @@ +# IS_WHOLETAB -- Return true if table name has no extension + +bool procedure is_wholetab (table) + +char table[ARB] # i: table name +#-- +bool wholetab +int nc, hdu +pointer sp, fname, extname + +int tbparse() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (extname, SZ_FNAME, TY_CHAR) + + nc = tbparse (table, Memc[fname], Memc[extname], SZ_FNAME, hdu) + + wholetab = Memc[extname] == EOS + + call sfree (sp) + return (wholetab) +end diff --git a/pkg/utilities/nttools/tcopy/mkpkg b/pkg/utilities/nttools/tcopy/mkpkg new file mode 100644 index 00000000..69ef0524 --- /dev/null +++ b/pkg/utilities/nttools/tcopy/mkpkg @@ -0,0 +1,13 @@ +# Update the tcopy application code in the ttools package library +# Author: HODGE, 2-FEB-1988 + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + iswholetab.x + tcopy.x + tdelete.x + ; diff --git a/pkg/utilities/nttools/tcopy/tcopy.x b/pkg/utilities/nttools/tcopy/tcopy.x new file mode 100644 index 00000000..20713f26 --- /dev/null +++ b/pkg/utilities/nttools/tcopy/tcopy.x @@ -0,0 +1,283 @@ +include +include # used to check whether input or output is redirected +include + +# tcopy -- Copy table(s) + +# The input tables are given by an filename template list. The output +# is either a matching list of tables or a directory. The number of +# input tables may be either one or match the number of output tables. +# This is based on the t_imcopy procedure. +# +# Phil Hodge, 21-Aug-1987 Task created. +# Phil Hodge, 7-Sep-1988 Change parameter names for tables. +# Phil Hodge, 28-Dec-1989 Use iferr with call to tbtcpy. +# Phil Hodge, 26-Mar-1992 Remove calls to tbtext. +# Phil Hodge, 1-Jul-1995 Modify for FITS tables. +# Phil Hodge, 19-Jul-1995 Replace fnt calls with tbn. +# B.Simon 9-May-1997 Add code similar to trename +# Phil Hodge, 8-Apr-1999 In one_copy, call tbfpri. +# Phil hodge, 16-Apr-1999 Remove ttype from calling sequence of tbparse; +# use tbttyp to get table type; ext_type is not called. +# Phil Hodge, 7-Jun-1999 If input or output is redirected, set to STDIN +# or STDOUT without getting the cl parameter. +# Phil Hodge, 29-Jun-1999 In one_copy, don't call tbtacc if oldfile is STDIN. +# Phil Hodge, 2-Jan-2001 Check $nargs to see whether input & output were +# specified, rather than relying exclusively on F_REDIR. +# Phil Hodge, 28-Feb-2002 Add a call to sfree at the end of tcopy. + +procedure tcopy() + +pointer tablist1 # input table list +pointer tablist2 # output table list +bool verbose # print file names? +#-- +pointer sp +pointer table1 # input table name +pointer fname1 # input file name (i.e. without brackets) +pointer cdfname # input CDF name or EXTNAME +pointer table2 # output table name +pointer dir1 # input directory name +pointer dir2 # output directory name + +pointer list1, list2, tp +int root_len # number of char in input directory name +int numout # number of names in output list +bool fitsout # is the output just one FITS file? + +char src[SZ_FNAME], extn[SZ_FNAME] + +int nargs # number of command-line arguments +bool in_redir, out_redir # is input or output redirected? + +pointer tbnopen(), tbtopn() +int tbnget(), tbnlen() +int fstati() +int fnldir(), isdirectory(), strncmp() +int junk, hdu, tbparse(), exists, tbttyp() +int clgeti() +bool clgetb(), streq() + +begin + call smark (sp) + call salloc (tablist1, SZ_LINE, TY_CHAR) + call salloc (tablist2, SZ_LINE, TY_CHAR) + call salloc (table1, SZ_LINE, TY_CHAR) + call salloc (fname1, SZ_LINE, TY_CHAR) + call salloc (cdfname, SZ_LINE, TY_CHAR) + call salloc (table2, SZ_LINE, TY_CHAR) + call salloc (dir1, SZ_LINE, TY_CHAR) + call salloc (dir2, SZ_LINE, TY_CHAR) + + # Get input and output table template lists. What we do with the + # command-line arguments depends on how many there are and what + # (input, output, or both) has been redirected. + + nargs = clgeti ("$nargs") + in_redir = fstati (STDIN, F_REDIR) == YES + out_redir = fstati (STDOUT, F_REDIR) == YES + + if (in_redir || out_redir) { + + if (nargs >= 2) { + + if (in_redir) { + call strcpy ("STDIN", Memc[tablist1], SZ_LINE) + call clpstr ("intable", "STDIN") # update par file + } else { + call clgstr ("intable", Memc[tablist1], SZ_LINE) + } + call clgstr ("outtable", Memc[tablist2], SZ_LINE) + + } else if (nargs == 1) { + + if (in_redir) { # output may also have been redirected + # The cl thinks the argument is intable, but it's actually + # outtable, so assign the value to tablist2. + call strcpy ("STDIN", Memc[tablist1], SZ_LINE) + call clgstr ("intable", Memc[tablist2], SZ_LINE) + # update par file + call clpstr ("intable", "STDIN") + call clpstr ("outtable", Memc[tablist2]) + } else { # only output was redirected + call clgstr ("intable", Memc[tablist1], SZ_LINE) + call strcpy ("STDOUT", Memc[tablist2], SZ_LINE) + } + + } else if (nargs == 0) { + + if (in_redir) + call strcpy ("STDIN", Memc[tablist1], SZ_LINE) + else + call clgstr ("intable", Memc[tablist1], SZ_LINE) + + if (out_redir) + call strcpy ("STDOUT", Memc[tablist2], SZ_LINE) + else + call clgstr ("outtable", Memc[tablist2], SZ_LINE) + } + + } else { + + call clgstr ("intable", Memc[tablist1], SZ_LINE) + call clgstr ("outtable", Memc[tablist2], SZ_LINE) + } + + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (Memc[tablist2], Memc[dir2], SZ_LINE) > 0 && + !streq (Memc[tablist2], "STDOUT")) { + + list1 = tbnopen (Memc[tablist1]) + + while (tbnget (list1, Memc[table1], SZ_LINE) != EOF) { + + # Memc[fname1] is the name without any brackets. We need to + # remove brackets because they confuse fnldir, which we use + # to get the length of any directory prefix. + + junk = tbparse (Memc[table1], Memc[fname1], Memc[cdfname], + SZ_LINE, hdu) + root_len = fnldir (Memc[fname1], Memc[dir1], SZ_LINE) + + # Copy the output directory name to table2, and concatenate + # the input file name (without directory prefix and without + # the bracket suffix). + + call strcpy (Memc[dir2], Memc[table2], SZ_LINE) + call strcat (Memc[fname1+root_len], Memc[table2], SZ_LINE) + + call one_copy (Memc[table1], Memc[table2], verbose) + } + + call tbnclose (list1) + + } else { + + # Dummy open of the old file in case it's a URL. + if (strncmp (Memc[tablist1], "http://", 7) == 0) { + tp = tbtopn (Memc[tablist1], READ_ONLY, NULL) + call tbtclo (tp) + } + + # Expand the input and output table lists. + list1 = tbnopen (Memc[tablist1]) + list2 = tbnopen (Memc[tablist2]) + + numout = tbnlen (list2) + fitsout = false # initial value + if (numout == 1) { + # See if the output is a FITS file. It's OK to have many + # input tables with just one output FITS file. + junk = tbnget (list2, Memc[table2], SZ_LINE) + call tbnrew (list2) + if (tbttyp (Memc[table2], exists) == TBL_TYPE_FITS) + fitsout = true + } + + if (tbnlen (list1) != numout) { + if (!fitsout) { + call tbnclose (list1) + call tbnclose (list2) + call error (1, + "Number of input and output tables are not the same.") + } + } + + # Copy each table. + while (tbnget (list1, Memc[table1], SZ_LINE) != EOF) { + if (!fitsout) + junk = tbnget (list2, Memc[table2], SZ_LINE) + + call one_copy (Memc[table1], Memc[table2], verbose) + } + + call tbnclose (list1) + call tbnclose (list2) + } + + call sfree (sp) +end + +# ONE_COPY -- Copy a single table + +procedure one_copy (oldfile, newfile, verbose) + +char oldfile[ARB] # i: current file name +char newfile[ARB] # i: new file name +bool verbose # i: print informational message +#-- +bool done +int phu_copied # set by tbfpri and ignored +pointer sp, oldname, newname, tp + +bool use_fcopy # true if we should copy the file with fcopy + +pointer tbtopn() +bool streq(), is_wholetab() +int tbtacc(), exists, tbttyp() # exists is ignored +errchk tbfpri, tbtcpy, tbtopn + +begin + call smark (sp) + call salloc (oldname, SZ_FNAME, TY_CHAR) + call salloc (newname, SZ_FNAME, TY_CHAR) + + # Check to make sure the copy is legal + + done = false + use_fcopy = false + if (streq (oldfile, newfile)) { + call eprintf ("Cannot copy table to itself: %s\n") + call pargstr (oldfile) + + if (streq (oldfile, "STDIN")) { + use_fcopy = true + + } else if (tbtacc (oldfile) == YES) { + use_fcopy = true + + } else { + call eprintf ("Can only copy tables with tcopy: `%s'\n") + call pargstr (oldfile) + } + + if (use_fcopy) { + call tbtext (oldfile, Memc[oldname], SZ_FNAME) + call tbtext (newfile, Memc[newname], SZ_FNAME) + + iferr (call fcopy (Memc[oldname], Memc[newname])) { + call erract (EA_WARN) + } else { + done = true + } + } + + } else { + # Table extensions are copied by the table + # library function tbtcpy + + iferr { + call tbfpri (oldfile, newfile, phu_copied) + call tbtcpy (oldfile, newfile) + } then { + call erract (EA_WARN) + } else { + done = true + } + } + + # Print verbose message + + if (done && verbose) { + call printf ("# %s -> %s\n") + call pargstr (oldfile) + call pargstr (newfile) + call flush (STDOUT) + } + + call sfree (sp) + return +end diff --git a/pkg/utilities/nttools/tcopy/tdelete.x b/pkg/utilities/nttools/tcopy/tdelete.x new file mode 100644 index 00000000..87258d06 --- /dev/null +++ b/pkg/utilities/nttools/tcopy/tdelete.x @@ -0,0 +1,126 @@ +include + +# tdelete -- Delete a list of tables. If table cannot be deleted, warn the +# user but do not abort. Verify before deleting each table if user wishes. +# This is based on the t_imdelete procedure. +# +# Phil Hodge, 24-Aug-1987 Task created. +# Phil Hodge, 7-Sep-1988 Change parameter name for table. +# Phil Hodge, 16-Mar-1992 Include check to prevent deleting text files. +# Phil Hodge, 26-Mar-1992 Remove call to tbtext. +# Phil Hodge, 19-Jul-1995 Replace fnt calls with tbn. +# B.Simon 5-May-1995 Call delete if deleting an entire table +procedure tdelete() + +pointer list +bool verify +pointer sp, tablename, tablist + +pointer tbnopen() +int tbnget() +bool clgetb() + +begin + call smark (sp) + call salloc (tablename, SZ_PATHNAME, TY_CHAR) + call salloc (tablist, SZ_LINE, TY_CHAR) + + call clgstr ("table", Memc[tablist], SZ_LINE) + list = tbnopen (Memc[tablist]) + verify = clgetb ("verify") + + while (tbnget (list, Memc[tablename], SZ_PATHNAME) != EOF) + call one_delete (Memc[tablename], verify) + + # Reset the go_ahead parameter, overriding learn mode, in case tdelete + # is subsequently called from the background. + + if (verify) + call clputb ("go_ahead", true) + + call tbnclose (list) + call sfree (sp) +end + +# ONE_DELETE -- Delete a single table + +procedure one_delete (file, verify) + +char file[ARB] # i: current file name +bool verify # i: ask user for confirmation +#-- +bool doit +pointer sp, fname + +bool clgetb(), is_wholetab() +int access(), tbtacc(), strncmp() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Check to make sure the deletion is OK + + if (strncmp ("http:", file, 5) == 0) { + call eprintf ("Cannot delete URL `%s'\n") + call pargstr (file) + call sfree (sp) + return + } + + if (verify) { + if (tbtacc (file) == NO) { + # If table does not exist, warn user + # (since verify mode is in effect). + doit = false + call eprintf ("Cannot delete nonexistent table `%s'\n") + call pargstr (file) + } + + # Set default action of verify prompt (override learning of + # most recent response). + + call clputb ("go_ahead", clgetb ("default_action")) + call printf ("delete table `%s'") + call pargstr (file) + + doit = clgetb ("go_ahead") + + } else { + if (access (file, 0, TEXT_FILE) == YES) { + # We don't want users to be able to delete text files + # with tdelete if verify = false. + + doit = false + call eprintf ("Cannot delete text file with tdelete: `%s'\n") + call pargstr (file) + + } else { + doit = true + } + } + + # Do the deletion + + if (doit) { + if (is_wholetab (file)) { + # Entire files are deleted with the fio delete + + call tbtext (file, Memc[fname], SZ_FNAME) + iferr (call delete (Memc[fname])) { + call erract (EA_WARN) + } + + } else { + # Table extensions are deleted by the table + # library function tbtdel + + iferr (call tbtdel (file)) { + call erract (EA_WARN) + } + } + } + + call sfree (sp) + return +end diff --git a/pkg/utilities/nttools/tcopy/trename.x b/pkg/utilities/nttools/tcopy/trename.x new file mode 100644 index 00000000..c4273b0b --- /dev/null +++ b/pkg/utilities/nttools/tcopy/trename.x @@ -0,0 +1,185 @@ +include + +# trename -- Rename table(s) + +# The input tables are given by an filename template list. The output +# is either a matching list of tables or a directory. The number of +# input tables may be either one or match the number of output tables. +# This is based on the t_imcopy procedure. +# +# Phil Hodge, 21-Aug-1987 Task created. +# Phil Hodge, 7-Sep-1988 Change parameter names for tables. +# Phil Hodge, 28-Dec-1989 Use iferr with call to tbtren. +# Phil Hodge, 16-Mar-1992 Include check to prevent renaming text files. +# Phil Hodge, 1-Jul-1995 Modify for FITS tables. +# Phil Hodge, 19-Jul-1995 Replace fnt calls with tbn. +# B.Simon 5-May-1997 Call rename if renaming entire table +# B.Simon 9-May-1997 Add table type check + +procedure trename() + +pointer tablist1 # input table list +pointer tablist2 # output table list +bool verbose # print operations? +#-- +pointer sp +pointer table1 # input table name +pointer fname1 # input file name (i.e. without brackets) +pointer cdfname # input CDF name or EXTNAME +pointer table2 # output table name +pointer dir1 # input directory name +pointer dir2 # output directory name + +pointer list1, list2 +int root_len # number of char in input directory name + +pointer tbnopen() +int tbnget(), tbnlen() +int fnldir(), isdirectory() +int junk, ttype, hdu, tbparse() +bool clgetb(), streq() + +begin + call smark (sp) + call salloc (tablist1, SZ_LINE, TY_CHAR) + call salloc (tablist2, SZ_LINE, TY_CHAR) + call salloc (table1, SZ_LINE, TY_CHAR) + call salloc (fname1, SZ_LINE, TY_CHAR) + call salloc (cdfname, SZ_LINE, TY_CHAR) + call salloc (table2, SZ_LINE, TY_CHAR) + call salloc (dir1, SZ_LINE, TY_CHAR) + call salloc (dir2, SZ_LINE, TY_CHAR) + + # Get input and output table template lists. + call clgstr ("intable", Memc[tablist1], SZ_LINE) + call clgstr ("outtable", Memc[tablist2], SZ_LINE) + + verbose = clgetb ("verbose") + + # Check if the output string is a directory. + + if (isdirectory (Memc[tablist2], Memc[dir2], SZ_LINE) > 0 && + !streq (Memc[tablist2], "STDOUT")) { + + list1 = tbnopen (Memc[tablist1]) + + while (tbnget (list1, Memc[table1], SZ_LINE) != EOF) { + + # Memc[fname1] is the name without any brackets. We need to + # remove brackets because they confuse fnldir, which we use + # to get the length of any directory prefix. + + junk = tbparse (Memc[table1], Memc[fname1], Memc[cdfname], + SZ_LINE, ttype, hdu) + root_len = fnldir (Memc[fname1], Memc[dir1], SZ_LINE) + + # Copy the output directory name to table2, and concatenate + # the input file name (without directory prefix and without + # the bracket suffix). + + call strcpy (Memc[dir2], Memc[table2], SZ_LINE) + call strcat (Memc[fname1+root_len], Memc[table2], SZ_LINE) + + call one_rename (Memc[table1], Memc[table2], verbose) + } + + call tbnclose (list1) + + } else { + + # Expand the input and output table lists. + list1 = tbnopen (Memc[tablist1]) + list2 = tbnopen (Memc[tablist2]) + + if (tbnlen (list1) != tbnlen (list2)) { + call tbnclose (list1) + call tbnclose (list2) + call error (1, "Number of input and output tables not the same") + } + + # Rename each table. + + while ((tbnget (list1, Memc[table1], SZ_LINE) != EOF) && + (tbnget (list2, Memc[table2], SZ_LINE) != EOF)) { + + call one_rename (Memc[table1], Memc[table2], verbose) + } + + call tbnclose (list1) + call tbnclose (list2) + } +end + +# ONE_RENAME -- Rename a single table + +procedure one_rename (oldfile, newfile, verbose) + +char oldfile[ARB] # i: current file name +char newfile[ARB] # i: new file name +bool verbose # i: print informational message +#-- +bool done +pointer sp, oldname, newname + +bool streq(), is_wholetab() +int access(), tbtacc(), ext_type() + +begin + call smark (sp) + call salloc (oldname, SZ_FNAME, TY_CHAR) + call salloc (newname, SZ_FNAME, TY_CHAR) + + # Check to make sure the copy is legal + + done = false + if (streq (oldfile, newfile)) { + call eprintf ("Cannot rename table to itself: %s\n") + call pargstr (oldfile) + + } else if (access (oldfile, 0, TEXT_FILE) == YES) { + call eprintf ("Cannot rename text file with trename: `%s'\n") + call pargstr (oldfile) + + } else if (is_wholetab (oldfile) && is_wholetab (newfile) && + ext_type (oldfile) == ext_type (newfile)) { + + # Entire files of the same type are renamed with the fio rename + + if (tbtacc (oldfile) == NO) { + call eprintf ("Can only rename tables with trename: `%s'\n") + call pargstr (oldfile) + + } else { + call tbtext (oldfile, Memc[oldname], SZ_FNAME) + call tbtext (newfile, Memc[newname], SZ_FNAME) + + iferr (call rename (Memc[oldname], Memc[newname])) { + call erract (EA_WARN) + } else { + done = true + } + } + + } else { + # Table extensions are renamed by the table + # library function tbtren + + iferr (call tbtren (oldfile, newfile)) { + call erract (EA_WARN) + } else { + done = true + } + } + + # Print verbose message + + if (done && verbose) { + call printf ("%s -> %s\n") + call pargstr (oldfile) + call pargstr (newfile) + call flush (STDOUT) + } + + call sfree (sp) + return +end -- cgit