strposmulti.pro
2.89 KB
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
FUNCTION STRPOSMULTI, s, subs, cpt
;+
; NAME: STRPOSMULTI
; PURPOSE:
; extract substring successive positions within a string, using strpos
; CATEGORY: I-4-a
; CALLING SEQUENCE:
; index=STRPOSMULTI(s, subs [, cpt] )
; INPUTS:
; s -- string : initial string
; subs -- string : substring, if '', return 0 and cpt eq 1
; OPTIONAL INPUT PARAMETERS:
; none
; KEYED INPUTS:
; none
; OUTPUTS:
; index -- long array : positions (if none -1)
; OPTIONAL OUTPUT PARAMETERS:
; cpt -- long : number of psoitions
; EXAMPLE:
; ALGORITHM:
; straightforward loop using strpos
; DEPENDENCIES:
; none
; COMMON BLOCKS:
; SESSION_BLOCK, SESSION_MODE, ERROR_CURRENT, STATUS_BOOL
; SIDE EFFECTS:
; none
; RESTRICTIONS:
; UNTESTED
; CALLED PROCEDURES AND FUNCTIONS:
; none
; MODIFICATION HISTORY:
; 2-Nov-1995 written with template_gen FV IAS
;-
;------------------------------------------------------------
; common blocks
;------------------------------------------------------------
; environment parameters
COMMON SESSION_BLOCK, SESSION_MODE, ERROR_CURRENT, STATUS_BOOL
;------------------------------------------------------------
; on error conditions
;------------------------------------------------------------
ON_ERROR, ERROR_CURRENT
;------------------------------------------------------------
; initialization
;------------------------------------------------------------
ROUTINE_NAME = 'STRPOSMULTI'
VERSION = '1.0'
CATEGORY = 'I-4-a'
STATUS = ['SUCCESS', 'S', ROUTINE_NAME+ ' V.' + VERSION, CATEGORY]
VAR_NAMES= ['s', 'subs', 'cpt', 'output']
s_s = CONV_STRING(s)
s_subs = CONV_STRING(subs)
s_cpt = CONV_STRING(cpt)
CALL_VAL = [s_s, s_subs, s_cpt, '']
output= -1
;------------------------------------------------------------
; parameters check
;------------------------------------------------------------
IF N_PARAMS() LT 2 THEN BEGIN
PRINT, 'CALLING SEQUENCE: ', $
'output=STRPOSMULTI(s, subs [, cpt] )'
STATUS(0) = ['PARAMETER MISSING', 'E']
GOTO, CLOSING
ENDIF
IF subs eq '' THEN BEGIN & output=[0l] & cpt=0 & GOTO, CLOSING & END
;------------------------------------------------------------
; function body
;------------------------------------------------------------
pos = strpos(s, subs)
WHILE pos ne -1 DO BEGIN
output = [output, pos]
pos = strpos(s, subs, pos+1)
ENDWHILE
index = where(output ne -1, cpt)
IF cpt GT 0 THEN output=output(index) ELSE output = -1
;------------------------------------------------------------
; closing
;------------------------------------------------------------
CLOSING:
s_s = CONV_STRING(s)
s_subs = CONV_STRING(subs)
s_cpt = CONV_STRING(cpt)
s_output = CONV_STRING(output)
ACTL_VAL = [s_s, s_subs, s_cpt, s_output]
IF (STRMID(STATUS(1),0,1) NE 'S') THEN STATUS_BOOL=1
RECORD_LOGFILE, STATUS, CALL_VAL, VAR_NAMES, ACTL_VAL
RETURN, output
END