1 /* kxtrct.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* $Procedure KXTRCT ( Extract a substring starting with a keyword ) */
kxtrct_(char * keywd,char * terms,integer * nterms,char * string,logical * found,char * substr,ftnlen keywd_len,ftnlen terms_len,ftnlen string_len,ftnlen substr_len)9 /* Subroutine */ int kxtrct_(char *keywd, char *terms, integer *nterms, char *
10 string, logical *found, char *substr, ftnlen keywd_len, ftnlen
11 terms_len, ftnlen string_len, ftnlen substr_len)
12 {
13 /* System generated locals */
14 integer i__1;
15
16 /* Builtin functions */
17 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
18
19 /* Local variables */
20 integer b, e;
21 extern integer nblen_(char *, ftnlen);
22 integer start, berase, eerase;
23 extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
24 integer delims;
25 extern /* Subroutine */ int fndnwd_(char *, integer *, integer *, integer
26 *, ftnlen);
27 integer begstr;
28 extern /* Subroutine */ int shiftl_(char *, integer *, char *, char *,
29 ftnlen, ftnlen, ftnlen);
30 extern integer wdindx_(char *, char *, ftnlen, ftnlen);
31 integer endstr, positn;
32
33 /* $ Abstract */
34
35 /* Locate a keyword in a string and extract the substring from */
36 /* the beginning of the first word following the keyword to the */
37 /* beginning of the first subsequent recognized terminator of a list. */
38
39 /* $ Disclaimer */
40
41 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
42 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
43 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
44 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
45 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
46 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
47 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
48 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
49 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
50 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
51
52 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
53 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
54 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
55 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
56 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
57 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
58
59 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
60 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
61 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
62 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
63
64 /* $ Required_Reading */
65
66 /* None. */
67
68 /* $ Keywords */
69
70 /* SEARCH, PARSING, PARSING */
71
72 /* $ Declarations */
73 /* $ Brief_I/O */
74
75 /* VARIABLE I/O DESCRIPTION */
76 /* -------- --- -------------------------------------------------- */
77 /* KEYWD I Word that marks the beginning of text of interest. */
78 /* TERMS I Set of words, any of which marks the end of text. */
79 /* NTERMS I Number of TERMS. */
80 /* STRING I/O String containing a sequence of words. */
81 /* FOUND O TRUE if the keyword is found in the string. */
82 /* SUBSTR O String from end of KEYWD to beginning of first */
83 /* TERMS item found. */
84
85 /* $ Detailed_Input */
86
87 /* KEYWD is a word used to mark the start of text of interest. */
88
89 /* TERMS is a set of words, any one of which may signal the */
90 /* end of text of interest. */
91
92 /* NTERMS is the number of TERMS. */
93
94 /* STRING is a character string made up of words, that may */
95 /* contain the keyword in KEYWD. */
96
97 /* $ Detailed_Output */
98
99 /* STRING is the input string stripped of all words from */
100 /* the beginning of the keyword KEYWD to the end of */
101 /* the last word preceding one of the words in TERMS */
102 /* (or the end of the string if none of the TERMS follows */
103 /* KEYWD in the string). */
104
105 /* FOUND is .TRUE. if KEYWD is present in the input STRING. */
106
107 /* SUBSTR is the substring that begins with the first word */
108 /* following KEYWD up to the beginning of any of the */
109 /* words in TERM or the end of the string. */
110
111 /* $ Parameters */
112
113 /* None. */
114
115 /* $ Particulars */
116
117 /* Definitions: */
118
119 /* A WORD is a set of consecutive non-blank characters */
120 /* delimited by blanks or either end of the string */
121 /* that contains them. */
122
123 /* Given a string and a keyword this routine locates the first */
124 /* occurrence of the keyword in the string and returns the */
125 /* substring between the end of the keyword and the first occurrence */
126 /* of any of the words in a list of terminating words. If none */
127 /* of the terminating words follows the keyword in the string, */
128 /* the routine returns all of the string following the keyword. */
129
130 /* If the next word following the keyword is a terminating word, */
131 /* the substring returned will be a blank. */
132
133 /* If the keyword can not be located in the string, the variable */
134 /* FOUND will be returned as .FALSE. and the input string will be */
135 /* unchanged. The substring will be returned as a blank. */
136
137 /* In all other cases, the part of the input string from the */
138 /* beginning of the keyword to the start of the first terminating */
139 /* word will be removed. If no terminating word follows the keyword */
140 /* the portion of the string from the keyword to the last non-blank */
141 /* character of the string will be removed. */
142
143 /* $ Examples */
144
145 /* Example 1. */
146 /* ---------- */
147 /* Input: STRING 'FROM 1 October 1984 12:00:00 TO 1 January 1987' */
148 /* KEYWD 'TO' */
149 /* TERMS 'FROM' */
150 /* 'TO' */
151 /* 'BEGINNING' */
152 /* 'ENDING' */
153
154 /* Output: STRING 'FROM 1 October 1984 12:00:00 ' */
155 /* FOUND .TRUE. */
156 /* SUBSTR '1 January 1987' */
157
158
159
160 /* Example 2. */
161 /* ---------- */
162 /* Input: STRING 'FROM 1 October 1984 12:00:00 TO 1 January 1987' */
163 /* KEYWD 'FROM' */
164 /* TERMS 'FROM' */
165 /* 'TO' */
166 /* 'BEGINNING' */
167 /* 'ENDING' */
168
169 /* Output: STRING ' TO 1 January 1987' */
170 /* FOUND .TRUE. */
171 /* SUBSTR '1 October 1984 12:00:00' */
172
173
174
175 /* Example 3. */
176 /* ---------- */
177 /* Input: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */
178 /* KEYWD 'ADDRESS:' */
179 /* TERMS 'ADDRESS:' */
180 /* 'PHONE:' */
181 /* 'NAME:' */
182
183 /* Output: STRING ' PHONE: 354-4321 ' */
184 /* FOUND .TRUE. */
185 /* SUBSTR '4800 OAK GROVE DRIVE' */
186
187
188 /* Example 4. */
189 /* ---------- */
190 /* Input: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */
191 /* KEYWD 'NAME:' */
192 /* TERMS 'ADDRESS:' */
193 /* 'PHONE:' */
194 /* 'NAME:' */
195
196 /* Output: STRING 'ADDRESS: 4800 OAK GROVE DRIVE PHONE: 354-4321 ' */
197 /* FOUND .FALSE. */
198 /* SUBSTR ' ' */
199
200 /* $ Restrictions */
201
202 /* It is the user's responsibility to make sure there is adequate */
203 /* room in SUBSTR to contain the substring. */
204
205 /* SUBSTR cannot overwrite STRING. */
206
207 /* $ Exceptions */
208
209 /* Error free. */
210
211 /* $ Files */
212
213 /* None. */
214
215 /* $ Author_and_Institution */
216
217 /* H.A. Neilan (JPL) */
218 /* W.L. Taber (JPL) */
219
220 /* $ Literature_References */
221
222 /* None. */
223
224 /* $ Version */
225
226 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
227
228 /* Comment section for permuted index source lines was added */
229 /* following the header. */
230
231 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
232
233 /* -& */
234 /* $ Index_Entries */
235
236 /* extract a substring starting with a keyword */
237
238 /* -& */
239 /* $ Revisions */
240
241 /* - Beta Version 1.1.0, 28-FEB-1989 (WLT) */
242
243 /* Reference to REMSUB replaced by SHIFTL. */
244
245 /* - Beta Version 1.0.1, 10-FEB-1989 (HAN) */
246
247 /* Contents of the Exceptions section was changed */
248 /* to "error free" to reflect the decision that the */
249 /* module will never participate in error handling. */
250
251 /* -& */
252
253 /* SPICELIB functions */
254
255
256 /* Local variables */
257
258
259 /* Locate the keyword within the string. */
260
261 positn = wdindx_(string, keywd, string_len, keywd_len);
262
263 /* If the keyword wasn't found, set the outputs and head for home. */
264
265 if (positn == 0) {
266 *found = FALSE_;
267 s_copy(substr, " ", substr_len, (ftnlen)1);
268 return 0;
269 } else {
270 *found = TRUE_;
271 }
272
273 /* Set the begin erase marker to the start of the current word */
274 /* Set the end erase marker to the end of the current word */
275
276 berase = positn;
277 eerase = positn + nblen_(keywd, keywd_len) - 1;
278 start = eerase + 1;
279
280 /* Find the begin and end of the next word. */
281
282 fndnwd_(string, &start, &b, &e, string_len);
283
284 /* If there is a next word ( E came back non-zero ) see if its a */
285 /* terminator. */
286
287 if (e != 0) {
288 delims = isrchc_(string + (b - 1), nterms, terms, e - (b - 1),
289 terms_len);
290 }
291
292 /* If we found a terminator, or were already at the end of the */
293 /* string, we are done. Remove the keyword and put a blank in */
294 /* SUBSTR */
295
296 if (e == 0 || delims != 0) {
297 i__1 = eerase - berase + 1;
298 shiftl_(string + (berase - 1), &i__1, " ", string + (berase - 1),
299 string_len - (berase - 1), (ftnlen)1, string_len - (berase -
300 1));
301 s_copy(substr, " ", substr_len, (ftnlen)1);
302 return 0;
303 }
304
305 /* Ok. If we made it this far, we have at least one legitimate word */
306 /* following the keyword, set the pointer for the start of the */
307 /* substring (to return) to the beginning of this word. */
308
309 begstr = b;
310
311 /* Now we just examine each word until we run out of string or we */
312 /* run into a terminator. */
313
314 while(e != 0 && delims == 0) {
315 endstr = e;
316 eerase = e;
317 start = e + 1;
318 fndnwd_(string, &start, &b, &e, string_len);
319 if (e != 0) {
320 delims = isrchc_(string + (b - 1), nterms, terms, e - (b - 1),
321 terms_len);
322 }
323 }
324
325 /* That's it, load the substring variable and remove the keyword */
326 /* and words up to the terminator or end of the string --- whichever */
327 /* came first. */
328
329 s_copy(substr, string + (begstr - 1), substr_len, endstr - (begstr - 1));
330 i__1 = eerase - berase + 1;
331 shiftl_(string + (berase - 1), &i__1, " ", string + (berase - 1),
332 string_len - (berase - 1), (ftnlen)1, string_len - (berase - 1));
333 return 0;
334 } /* kxtrct_ */
335
336