diff options
Diffstat (limited to 'sys/imfort/imrnam.x')
| -rw-r--r-- | sys/imfort/imrnam.x | 144 |
1 files changed, 144 insertions, 0 deletions
diff --git a/sys/imfort/imrnam.x b/sys/imfort/imrnam.x new file mode 100644 index 00000000..333ff5da --- /dev/null +++ b/sys/imfort/imrnam.x @@ -0,0 +1,144 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "imfort.h" +include "oif.h" + +# IMRNAM -- Rename an image (both the header and pixel files). It is not an +# error if there is no pixel file. The rename operator can be used to move +# an image to a different directory. + +procedure imrnam (oimage, nimage, ier) + +% character*(*) oimage +% character*(*) nimage +int ier + +int status +pointer sp, im, ip +pointer root, extn, osfn +pointer old_hfn, new_hfn +pointer old_pfn, new_pfn +pointer o_osfn, n_osfn + +bool strne() +int stridxs() +define quit_ 91 + +begin + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (extn, SZ_FNAME, TY_CHAR) + call salloc (old_hfn, SZ_PATHNAME, TY_CHAR) + call salloc (new_hfn, SZ_PATHNAME, TY_CHAR) + call salloc (old_pfn, SZ_PATHNAME, TY_CHAR) + call salloc (new_pfn, SZ_PATHNAME, TY_CHAR) + call salloc (n_osfn, SZ_PATHNAME, TY_CHAR) + call salloc (o_osfn, SZ_PATHNAME, TY_CHAR) + call salloc (osfn, SZ_PATHNAME, TY_CHAR) + + ier = OK + + # Construct filename of new image header file. + call f77upk (nimage, Memc[new_hfn], SZ_PATHNAME) + call imf_parse (Memc[new_hfn], Memc[root], Memc[extn]) + if (Memc[extn] == EOS) + call strcpy (OIF_HDREXTN, Memc[extn], SZ_FNAME) + + call strcpy (Memc[root], Memc[new_hfn], SZ_FNAME) + call strcat (".", Memc[new_hfn], SZ_FNAME) + call strcat (Memc[extn], Memc[new_hfn], SZ_FNAME) + + # Open existing image, make sure that it exists. + call imopen (oimage, RW, im, ier) + if (ier != OK) { + ier = IE_IMRNAMNEXIM + goto quit_ + } + + # Perform clobber checking and delete any old image with the new + # name, if clobber is enabled. + + call f77upk (oimage, Memc[o_osfn], SZ_PATHNAME) + call f77upk (nimage, Memc[n_osfn], SZ_PATHNAME) + if (strne (Memc[o_osfn], Memc[n_osfn])) { + call strpak (Memc[new_hfn], Memc[osfn], SZ_PATHNAME) + call zfacss (Memc[osfn], 0, 0, status) + if (status == YES) { + call strpak ("clobber", Memc[osfn], SZ_FNAME) + call zgtenv (Memc[osfn], Memc[osfn], SZ_FNAME, status) + if (status != ERR) { + call imdele (nimage, ier) + if (ier != OK) { + ier = IE_IMRENAME + goto quit_ + } + } else { + ier = IE_CLOBBER + call f77upk (nimage, Memc[osfn], SZ_PATHNAME) + call im_seterrop (ier, Memc[osfn]) + call sfree (sp) + return + } + } + } + + # Our task here is nontrivial as the pixel file must be renamed as + # well as the header file, e.g., since renaming the header file may + # move it to a different directory, and the PIXFILE field in the + # image header may indicate that the pixel file is in the same dir + # as the header. Must open image, get pixfile name from the header, + # and generate the new pixfile name. + + call strcpy (IM_HDRFILE(im), Memc[old_hfn], SZ_PATHNAME) + + if (IM_PIXFILE(im) != EOS) { + # Get old pixel file name. + call imf_gpixfname (IM_PIXFILE(im), IM_HDRFILE(im), + Memc[old_pfn], SZ_PATHNAME) + ip = old_pfn + stridxs ("!", Memc[old_pfn]) + call strcpy (Memc[ip], Memc[old_pfn], SZ_PATHNAME) + + # Construct the new pixel file name. + call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_PATHNAME) + call imf_mkpixfname (im, Memc[new_pfn], SZ_PATHNAME, ier) + if (ier != OK) + goto quit_ + + ip = new_pfn + stridxs ("!", Memc[new_pfn]) + call strcpy (Memc[ip], Memc[new_pfn], SZ_PATHNAME) + + # Update the image header (save new pixel file name). + IM_UPDATE(im) = YES + + } else { + call strcpy (Memc[new_hfn], IM_HDRFILE(im), SZ_PATHNAME) + Memc[old_pfn] = EOS + } + + call imclos (im, ier) + if (ier != OK) + goto quit_ + + call strpak (Memc[old_hfn], Memc[old_hfn], SZ_PATHNAME) + call strpak (Memc[old_pfn], Memc[old_pfn], SZ_PATHNAME) + call strpak (Memc[new_hfn], Memc[new_hfn], SZ_PATHNAME) + call strpak (Memc[new_pfn], Memc[new_pfn], SZ_PATHNAME) + + # Rename the header and pixel files. It is not an error if + # there is no pixel file. + + call zfrnam (Memc[old_hfn], Memc[new_hfn], status) + if (status == ERR) + ier = IE_IMRENAME + else if (Memc[old_pfn] != EOS) { + call zfrnam (Memc[old_pfn], Memc[new_pfn], status) + if (status == ERR) + ier = IE_IMRENAME + } + +quit_ + call f77upk (oimage, Memc[old_hfn], SZ_PATHNAME) + call im_seterrop (ier, Memc[old_hfn]) + call sfree (sp) +end |