MATCH function in REXX

[Autolink] Menu

(see also NNTP client and SMTP client/daemon for use with WARP IAK)

 
/* Matching function in REXX                                          */
/*                                                                    */
/* captured from a public message in a FIDO message area              */
/*                                                                    */
/* Author: Detlev Ahlgrimm                                            */
/*         (see EMail Addresses)                                      */
/*                                                                    */

  curMask = ""

  do forever
                    /* get the mask                                   */
    say "Please enter a mask (with ? and *, EXIT <RETURN> to end)"
    say "  Enter <RETURN> to use the mask '" || curMask || "'."
    call CharOut , "> "
    newMask = LineIn()

    if translate( newMask ) = "EXIT" then
      leave

    if NewMask = "" then
      NewMask = curMask
    else
      curMask = newMask

                    /* get the test string                            */
    say "Please enter a test string"
    call CharOut , "> "
    testString = LineIn()

                    /* call the match function and show the result    */
    say "Match( " newMask "," testString  ") is " || ,
         match( NewMask,testString )

  end /* do forever */

exit

/* ------------------------------------------------------------------ */
/* function: Match function in REXX                                   */
/*                                                                    */
/* call:     result = match( spec, name )                             */
/*                                                                    */
/* where:    spec - mask (containing ? and * as joker)                */
/*           name - test string                                       */
/*                                                                    */
/* returns:  1 - name matches spec                                    */
/*           0 - name does not match spec                             */
/*                                                                    */
/* History:                                                           */
/*           C-Version    D.Ahlgrimm     03.1995                      */
/*                        (see EMail Addresses)                       */
/*           REXX-Version D.Ahlgrimm  21.06.1995                      */
/*                                                                    */
/*           05.09.1996   D.Ahlgrimm                                  */
/*                        REXX-Code & Algorithmus optimiert           */
/*                       (u.a. Grenzen genauer)                       */
/*                                                                    */
/*           16.11.1996   Translated comments into english            */
/*                        and reformatted the code /bs                */
/*                                                                    */
Match: PROCEDURE
  PARSE ARG spec, name

  spec_lng = LENGTH( spec )+1
  name_lng = LENGTH( name )+1
  spec_pos = 1
  name_pos = 1

                    /* do for all chars in spec                       */
  DO WHILE spec_pos<spec_lng

    spec_ptr = SUBSTR( spec, spec_pos, 1 )
    name_ptr = SUBSTR( name, name_pos, 1 )

    IF spec_ptr = "*" THEN
    DO
      IF spec_pos+1 = spec_lng THEN
                    /* spec equal '*' -> finished, rest meaningless   */
        RETURN( 1 )

      ss = SUBSTR( spec, spec_pos+1 )

                    /* as: Number of '*' in spec                      */
      as = LENGTH( SPACE( TRANSLATE( ss, COPIES( " ", C2D( "*" ) )"x",, " " ), 0 ) )

      DO i = 0 to name_lng-name_pos-( LENGTH( ss )-as )

                    /* 0 to length - current position - count ...     */
                    /*  ...of the chars not equal '*' in spec         */

        IF Match( ss, SUBSTR( name, name_pos+i ) ) = 1 THEN
                    /* the rest of spec (after the *) matches         */
                    /* the rest of name                               */
          RETURN( 1 )

      END /* DO i = 0 to name_lng-name_pos-( LENGTH( ss )-as ) */

                    /* no match for the rest found                    */
      RETURN( 0 )
    END; /* IF spec_ptr = "*" THEN */
    ELSE
    DO
      IF ( spec_ptr = "?" & name_pos<>name_lng ) | spec_ptr = name_ptr THEN
      DO
        spec_pos = spec_pos+1
        name_pos = name_pos+1
      END /* IF ( spec_ptr = "?" & ... ) */
      ELSE
                    /* spec equal '?' and the name is done ..         */
                    /* ... or character is okay                       */
        RETURN( 0 )
    END /* ELSE */
  END /* DO WHILE spec_pos<spec_lng */

  IF name_pos <> name_lng THEN
                    /* spec is done, name is not                      */
    RETURN( 0 )
                    /* spec and name are both done                    */
RETURN( 1 )


[Back: Using the CLOCK$ device]
[Next: Sample for using BEEP to play sounds]