aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/tcopy
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/tcopy')
-rw-r--r--pkg/utilities/nttools/tcopy/iswholetab.x24
-rw-r--r--pkg/utilities/nttools/tcopy/mkpkg13
-rw-r--r--pkg/utilities/nttools/tcopy/tcopy.x283
-rw-r--r--pkg/utilities/nttools/tcopy/tdelete.x126
-rw-r--r--pkg/utilities/nttools/tcopy/trename.x185
5 files changed, 631 insertions, 0 deletions
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 <error.h> <tbset.h>
+ tdelete.x <error.h>
+ ;
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 <error.h>
+include <fset.h> # used to check whether input or output is redirected
+include <tbset.h>
+
+# 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 <error.h>
+
+# 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 <error.h>
+
+# 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
generated by cgit (git 2.34.1) at 2025-09-20 08:37:29 -0400