Subject: | |
From: | |
Reply To: | |
Date: | Mon, 2 Oct 2000 13:07:09 -0400 |
Content-Type: | text/plain |
Parts/Attachments: |
|
|
John Pollard <[log in to unmask]> wrote:
> I guess I left out one important specification. The file being sought in
> the fileset may not exist at run time. So doing such things as a LISTFILE
> will not work. I must just take a given file name and a given fileset and
> determine if the file is (would be?) a member of the fileset.
Here, see if this works for you. Let me know if you find any bugs:
$CONTROL POST85,DYNAMIC
identification division.
program-id. globmatch.
*
* Ken Hirsch October 2000
* mailto:[log in to unmask]
*
* CALL "GLOBMATCH" USING PATTERN, FILENAME
* GIVING MATCH-VALUE
*
* Will return 1 in MATCH-VALUE if FILENAME matches PATTERN
* Will return 0 in MATCH-VALUE if they don't match
* Pattern may contain @ ? # interpreted as in MPE file names
* other characters interpreted literally
*
* Lower-case is mapped to upper-case unless pattern or
* filename start with "." or "/"
*
data division.
working-storage section.
01 pattern pic x(28).
01 redefines pattern.
05 pattern-char pic x occurs 28 times.
01 states-table binary.
05 state-count pic s9(9).
05 occurs 64 times.
10 in-state pic s9(9).
01 states-table-out binary.
05 out-state-count pic s9(9).
05 occurs 64 times.
10 out-state pic s9(9).
01 c pic x.
01 misc-vars binary.
05 pattern-length pic s9(9).
05 filename-length pic s9(9).
05 in-state-x pic s9(9).
05 src pic s9(9).
05 st pic s9(9).
05 i pic s9(9).
05 result pic s9(9).
05 flg1 pic s9(9).
88 final-found value 1.
88 not-final-found value 0.
05 flg2 pic s9(9).
88 dup-found value 1.
88 not-dup-found value 0.
05 flg3 pic s9(9).
88 posix-mode value 1.
88 not-posix-mode value 0.
linkage section.
01 pattern-in pic x(28).
01 filename-target pic x(28).
procedure division using pattern-in, filename-target.
main.
set not-posix-mode to true
if (filename-target (1:1) = "/" or ".")
or (pattern-in (1:1) = "/" or ".")
set posix-mode to true
end-if
move pattern-in to pattern
perform varying pattern-length from 28 by -1
until pattern-length = 0 or
pattern-char (pattern-length) not = spaces
continue
end-perform
if not posix-mode
perform varying src from 1 by 1
until src > pattern-length
move pattern-char (src) to c
if c is alphabetic-lower
move function upper-case(c) to pattern-char (src)
end-if
end-perform
end-if
perform varying filename-length from 28 by -1
until filename-length = 0
or filename-target (filename-length:1) not = spaces
continue
end-perform
move 1 to src
move 1 to state-count
move 1 to in-state (1)
perform until src > filename-length
or state-count = 0
move filename-target (src:1) to c
if (not posix-mode) and c is alphabetic-lower
move function upper-case(c) to c
end-if
move 0 to out-state-count
perform do-states varying st from 1 by 1
until st > state-count
move states-table-out to states-table
if state-count > 0
add 1 to src
end-if
end-perform
move 0 to result
if src > filename-length
perform check-for-final
if final-found
move 1 to result
end-if
end-if
move result to return-code
goback.
do-states.
move in-state (st) to in-state-x
if in-state-x <= pattern-length
evaluate pattern-char (in-state-x)
when "@"
perform copy-state
add 1 to in-state-x
perform copy-state
perform push-state
when "?"
add 1 to in-state-x
perform copy-state
when "#"
if c is numeric
add 1 to in-state-x
perform copy-state
end-if
when other
if c = pattern-char (in-state-x)
add 1 to in-state-x
perform copy-state
end-if
end-evaluate
end-if.
push-state.
* I don't think overflow can happen here
if state-count >= 64
display "Pattern table overflow"
move 0 to return-code
goback
end-if
move in-state-x to i
perform until i > pattern-length
or pattern-char (i) not = "@"
add 1 to i
end-perform
if i <= pattern-length
add 1 to state-count
move i to in-state (state-count)
end-if.
copy-state.
* OVERFLOW (I believe the dup check below will prevent this)
if out-state-count >= 64
display "Pattern table overflow"
move 0 to return-code
goback
end-if.
set not-dup-found to true
perform varying i from 1 by 1
until dup-found or i > out-state-count
if in-state-x = out-state (i)
set dup-found to true
end-if
end-perform
if not dup-found
add 1 to out-state-count
move in-state-x to out-state (out-state-count)
end-if.
check-for-final.
set not-final-found to true
perform varying st from 1 by 1
until st > state-count or final-found
if in-state (st) = pattern-length + 1
set final-found to true
else if in-state (st) = pattern-length
and pattern-char (pattern-length) = "@"
set final-found to true
end-if end-if
end-perform.
|
|
|