File: idbfind.x

package info (click to toggle)
iraf-rvsao 2.8.3-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 16,456 kB
  • sloc: ansic: 963; lisp: 651; fortran: 397; makefile: 27
file content (147 lines) | stat: -rw-r--r-- 3,706 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

include	<imhdr.h>
include	<imio.h>
include	"../lib/idb.h"

# IDB_FINDRECORD -- Search the image database for a particular record given
# the key.  The record number (a positive nonzero integer) is returned if
# the record is found, else 0.  

int procedure idb_findrecord (im, key, rp)

pointer	im			# image descriptor
char	key[ARB]		# record key
pointer	rp			# char record pointer (output)

pointer	sp, pat, patbuf, ukey, lkey, ip, ua
int	recno, nchars, lch, uch, ch, junk, n, i
int	patmake(), patmatch(), stridxs(), gstrcpy()

begin
	call smark (sp)
	call salloc (pat, SZ_FNAME, TY_CHAR)
	call salloc (ukey, SZ_FNAME, TY_CHAR)
	call salloc (lkey, SZ_FNAME, TY_CHAR)
	call salloc (patbuf, SZ_LINE, TY_CHAR)

	# Prepare U/L FITS keywords, truncated to 8 chars.
	nchars = gstrcpy (key, Memc[lkey], IDB_SZFITSKEY)
	call strlwr (Memc[lkey])
	nchars = gstrcpy (key, Memc[ukey], IDB_SZFITSKEY)
	call strupr (Memc[ukey])

	# Search for the FIRST occurrence of a record with the given key.
	# If the key is abbreviated and multiple keys are matched, the first
	# record matched is used.

	ua = IM_USERAREA(im)
	rp = NULL
	recno = 1

	if (IM_UABLOCKED(im) < 0) {
	    # At image open time this flag is set by IMMAP to -1 to indicate
	    # that the user area record type is not known.  An IKI kernel may
	    # subsequently set the flag to yes/no, else we determine the
	    # record type by inspection the first time we are called.  If the
	    # user area is empty the record type is set to blocked; IDB always
	    # writes blocked records.

	    IM_UABLOCKED(im) = YES
	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
		for (n=0;  Memc[ip] != EOS;  n=n+1) {
		    if (Memc[ip] == '\n')
			break
		    ip = ip + 1
		}
		if (n != IDB_RECLEN) {
		    IM_UABLOCKED(im) = NO
		    break
		}
	    }
	}

	if (IM_UABLOCKED(im) == NO) {
	    # Variable length, newline terminated records, EOS terminated
	    # record group.

	    call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]")
		call pargstr (Memc[ukey])
	    junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE)

	    for (ip=ua;  Memc[ip] != EOS;  ip=ip+1) {
		if (patmatch (Memc[ip], Memc[patbuf]) > 0) {
		    rp = ip
		    break
		}
		#if (Memc[ip] != EOS)
		#    ip = ip + 1
		while (Memc[ip] != '\n' && Memc[ip] != EOS)
		    ip = ip + 1
		recno = recno + 1
	    }

	} else {
	    # Fixed length (80 character), newline terminated records, EOS
	    # terminated record group.

	    if (stridxs ("*?[]", Memc[ukey]) > 0) {
		# Pattern matching search.
		call sprintf (Memc[pat], SZ_FNAME, "^{%s}[ =]")
		    call pargstr (Memc[ukey])
		junk = patmake (Memc[pat], Memc[patbuf], SZ_LINE)

		for (ip=ua;  Memc[ip] != EOS;  ip=ip+IDB_RECLEN+1) {
		    if (patmatch (Memc[ip], Memc[patbuf]) > 0) {
			rp = ip
			break
		    }
		    recno = recno + 1
		}

	    } else {
		# Simple fast search, fixed length records.  Case insensitive
		# keyword match.

		lch = Memc[lkey]
		uch = Memc[ukey]

		for (ip=ua;  Memc[ip] != EOS;  ip=ip+IDB_RECLEN+1) {
		    ch = Memc[ip]
		    if (ch == EOS)
			break
		    else if (ch != lch && ch != uch)
			next
		    else {
			# Abbreviations are not permitted.
			ch = Memc[ip+nchars]
			if (ch != ' ' && ch != '=')
			    next
		    }

		    # First char matches; check rest of string.
		    do i = 1, nchars-1 {
			ch = Memc[ip+i]
			if (ch != Memc[lkey+i] && ch != Memc[ukey+i]) {
			    ch = 0
			    break
			}
		    }
		    if (ch != 0) {
			rp = ip		# match
			break
		    }

		    recno = recno + 1
		}
	    }
	}

	call sfree (sp)
	if (rp == NULL)
	    return (0)
	else
	    return (recno)
end

# Mar 27 2015	Link to header and common files in lib/