HP3000-L Archives

October 2000, Week 1

HP3000-L@RAVEN.UTC.EDU

Options: Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Message: [<< First] [< Prev] [Next >] [Last >>]
Topic: [<< First] [< Prev] [Next >] [Last >>]
Author: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Subject:
From:
Ken Hirsch <[log in to unmask]>
Reply To:
Ken Hirsch <[log in to unmask]>
Date:
Mon, 2 Oct 2000 13:07:09 -0400
Content-Type:
text/plain
Parts/Attachments:
text/plain (208 lines)
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.

ATOM RSS1 RSS2