$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 5-MAR-1992 16:23:06.68 By user UDAA055 $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. [.WILD]WILD.COM;1 $! 2. [.WILD]WILD.HLP;3 $! 3. [.WILD]WILD.PAS;38 $! 4. [.WILD]WILD_CLD.CLD;10 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X$ pascal/opt/nochec/nodeb wild X$ set command/obj wild_cld X$ link/notrace wild,wild_cld $ CALL UNPACK [.WILD]WILD.COM;1 138234923 $ create 'f' X1 WILD XWILD does wildcard searches on a text file. X XUsage: X $ WILD file1`5B,file2`5B,file3...`5D`5D pat1`5B,pat2`5B,pat3...`5D`5D Xwhere file1... are text files to search and pat1... are the wildcard pattern Vs Xto search for. X X2 Description XWILD looks through the specified files matching each line of file against Xthe various patterns. All matching lines are printed to SYS$OUTPUT. If no Xmatching lines are found WILD returned an informational message (i.e., X$SEVERITY = 3). X XThe patterns can contain the wildcard characters * and % which match an Xarbitrary string and a single character respectively. X XWildcards can be used in the file specifications. (You may want to specify X /HEADING in this case so that you get told the actual names of the files.) X XThe match is to the entire line of the input file unless the qualifiers X /POSITION and /SIZE are specified. These defined a range of columns in the Xinput file to be used. In addition the /PARTIAL qualifier is equivalent to Xprefixing and suffixing each pattern with a '*'. The match is case Xinsensitive unless /EXACT is specified. The /TRIM qualifier is used to Xremove trailing blanks from the file and the patterns before the match is Xattempted. X2 Qualifiers X/EXACT X /EXACT X /NOEXACT (D) XIf /EXACT is specified then the match is case sensitive. X X/TRIM X /TRIM X /NOTRIM (D) XIf /TRIM is specified the patterns and the lines in the file are trimmed of Xtrailing blanks before the match is made X X/POSITION X /POSITION=integer Xspecifies a starting column in the file at which the attempted match is Xbegun. Default is /POSITION=1, i.e., the beginning of the line. X X/SIZE X /SIZE=integer XSpecifies the number of columns used in the match. The default is to use Xthe whole line beginning at /POSITION. X X/PARTIAL X /PARTIAL X /NOPARTIAL (D) XIf /PARTIAL is specified then the match is made on partial lines. This is Xachieved by converting pati to *pati*. X XNote that the default is /NOPARTIAL which may result in no output appearing Xwhen a line in fact contains the specified string. This differs from the VM VS XSEARCH command. It is usually best to specify /PARTIAL to ensure that all Xlines containing the pattern are found. X/HEADING X /HEADING X /NOHEADING (D) XIf /HEADING is specified, the names of the files in which the patterns are Xfound is reported. X2 Restrictions XAt most 32 match patterns can be specified. XThe maximum length of lines in file is 512 characters. $ CALL UNPACK [.WILD]WILD.HLP;3 1280060651 $ create 'f' X(* Call wild_match on every line of a file, printing out the matches. XUsage X wild file str1`5B,str2`5B,str3...`5D`5D X XRestrictions X maximum of 32 pattern can be searched for X file must be a text file with lines of at most 512 characters X XWritten by Charles Karney (Karney@ccc.nmfecc.gov), Sept 9, 1987. X X*) X X`5Binherit ('SYS$LIBRARY:STARLET')`5D Xprogram wild(output); Xconst X linel=512; X maxstring=32; X cli$_absent=%x'000381F0'; X cli$_concat=%x'0003FD29'; X cli$_defaulted=%x'0003FD21'; X cli$_locneg=%x'00038230'; X cli$_locpres=%x'0003FD31'; X cli$_negated=%x'000381F8'; X cli$_present=%x'0003FD19'; Xtype X uword=`5Bword`5D 0..65535; X line=varying `5Blinel`5D of char; X sigarr=array `5B0..20`5D of integer; X mecharr=array `5B0..4`5D of integer; Xlabel 3; Xvar X cmd_line,file_name,this_file,default_spec,input_line,buf1,buf2:line; X match:array `5B0..maxstring-1`5D of line; X input_file:text; X stat,nstrings,i,position,size,length,flags:integer; X found,exact,trim,partial,heading,first:boolean; X context:unsigned; X lib$get_input,wild_match_cld:`5Bexternal`5D unsigned; X Xfunction lib$get_foreign( X %stdescr cmdlin:`5Bvolatile`5D packed array `5Bl1..u1:integer`5D of char X`09:=%immed 0; X %stdescr prompt:`5Bvolatile`5D packed array `5Bl2..u2:integer`5D of char X`09:=%immed 0; X var len : `5Bvolatile`5D uword := %immed 0; X var flag : `5Bvolatile`5D integer := %immed 0):integer; external; Xfunction cli$dcl_parse( X %stdescr cmd_string:packed array `5Bl1..u1:integer`5D of char X :=%immed 0; X var table:unsigned:=%immed 0; X var param_routine:unsigned:=%immed 0; X var prompt_routine:unsigned:=%immed 0; X %stdescr prompt_string:packed array `5Bl2..u2:integer`5D of char X :=%immed 0):integer; external; Xfunction cli$present( X %stdescr name:packed array`5Bl..u:integer`5D of char):integer; external; Xfunction cli$get_value( X %stdescr name:packed array`5Bl1..u1:integer`5D of char; X %stdescr retbuf:packed array`5Bl2..u2:integer`5D of char; X var ret_len : uword := %immed 0):integer; external; Xfunction str$upcase( X var dst_str : varying `5Blen1`5D of char; X src_str : varying `5Blen2`5D of char):unsigned; external; Xfunction str$trim( X var dst_str : varying `5Blen1`5D of char; X src_str : varying `5Blen2`5D of char; X var out_len : uword := %immed 0):integer;external; Xfunction str$match_wild( X cand_str : varying `5Blen1`5D of char; X pattern_str : varying `5Blen2`5D of char):integer; external; X XFUNCTION lib$find_file X ( file_spec : VARYING `5B$len1`5D OF CHAR; X VAR result_spec : VARYING `5B$len2`5D OF CHAR; X %ref context : UNSIGNED; X default_spec : VARYING `5B$len4`5D OF CHAR := %immed 0; X related_spec : VARYING `5B$len5`5D OF CHAR := %immed 0; X VAR stv_addr : UNSIGNED := %immed 0; X user_flags : UNSIGNED := %immed 0 ) X : UNSIGNED; X X EXTERNAL; X X`5BASYNCHRONOUS, UNBOUND`5D XFUNCTION lib$find_file_end X (%ref context : UNSIGNED ) X : UNSIGNED; X X EXTERNAL; Xbegin X stat := lib$get_foreign(cmd_line.body,,cmd_line.length,); X if not odd(stat) then $exit(stat); X stat := cli$dcl_parse('wild_match '+cmd_line,wild_match_cld, X`09lib$get_input); X if not odd(stat) then $exit(stat); X nstrings:=0; X heading:=odd(cli$present('heading')); X exact:=odd(cli$present('exact')); X trim:=odd(cli$present('trim')); X partial:=odd(cli$present('partial')); X while (nstrings0 then X`09`09open(file_variable:=input_file, X`09`09 file_name:=this_file, X`09`09 history:=readonly); X`09 reset(input_file); X`09 first:=true; X`09 while not eof(input_file) do begin X`09`09readln(input_file,input_line); X`09`09length:=min(input_line.length+1-position,size); X`09`09if length>0 then buf2:=substr(input_line,position,length) X`09`09else buf2:=''; X`09`09if buf2.length>0 then begin X`09`09 if not(exact) then str$upcase(buf1,buf2) else buf1:=buf2; X`09`09 if trim then str$trim(buf2,buf1) else buf2:=buf1; X`09`09 if buf2.length>0 then X`09`09`09for i:=0 to nstrings do X`09`09`09 if odd(str$match_wild(buf2,match`5Bi`5D)) then begin X`09`09`09`09if first and heading then begin X`09`09`09`09 if found then writeln; X`09`09`09`09 writeln('******************************'); X`09`09`09`09 writeln(this_file); X`09`09`09`09 writeln; X`09`09`09`09end; X`09`09`09`09writeln(input_line); X`09`09`09`09found:=true; X`09`09`09`09first:=false; X`09`09`09`09goto 3; X`09`09`09 end; X3:`09`09end; X`09 end; X`09 close(file_variable:=input_file); X`09end; X end; X if not found then begin X`09writeln('%WILD-I-NOMATCHES, no strings matched'); X`09$exit(sts$k_info+sts$m_inhib_msg); X end; Xend. $ CALL UNPACK [.WILD]WILD.PAS;38 2099472612 $ create 'f' Xmodule wild_match_cld Xdefine verb wild_match X parameter p1 , label=source , prompt="filename" X value (required,list,type=$infile) X parameter p2 , label=string , prompt="pattern(s)" X value (required,list) X qualifier heading, negatable X qualifier trim, negatable X qualifier exact, negatable X qualifier partial, negatable X qualifier position, negatable, value(required,type=$number) X qualifier size, negatable, value(required,type=$number) $ CALL UNPACK [.WILD]WILD_CLD.CLD;10 2097183604 $ v=f$verify(v) $ EXIT