(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 )