Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/comten1/path.com
There are 5 other files named path.com in the archive. Click here to see a list.
$ 	verify = F$VERIFY("NO")
$!
$! PATH.COM
$! Stolen:              7-Jul-82 QCJ
$! Modification:	16-Nov-82 SLP (verification)
$! Modification:         6-Jul-83 MEH (check existence of directories when
$!                                     using "."'s and "-"'s in path_spec)
$! Modification:         1-Mar-84 JLD (major cosmetic changes and upgrade to
$!                                     recognize network nodes for DECNET)
$! Modification:        16-May-84 JLD (correct error message on protected
$!                                     subdirectories to not read nonexistent)
$!
$	original = F$LOGICAL("SYS$DISK") + F$DIRECTORY()
$	switch = "N"
$       node = "N"
$	len = F$LENGTH(P1)
$       switch_loc = F$LOCATE("/",P1)
$	IF switch_loc .NE. len THEN switch = "Y"
$       IF .NOT. switch THEN GOTO start
$       switch_val = F$EXTRACT(switch_loc + 1,len - switch_loc - 1,p1)
$       P1 = F$EXTRACT(0,switch_loc,P1)
$ start:
$	ON WARNING THEN GOTO error
$       len = F$LENGTH(P1)
$	IF len .EQ. 0 THEN GOTO out
$ no_switches:
$	IF F$LOCATE("<",P1) .NE. len THEN GOTO pathout
$	IF F$LOCATE(">",P1) .NE. len THEN GOTO pathin
$	IF F$LOCATE("::",P1) .NE. len THEN GOTO network
$	IF F$LOCATE(":",P1) .NE. len THEN GOTO device
$	IF F$LOCATE("[",P1) .NE. len THEN GOTO pmain
$ 	IF F$LOCATE(".",P1) .NE. len THEN GOTO pmain
$	IF F$LOGICAL(P1) .NES. "" THEN GOTO logical
$!
$! Assume this is a main directory and path to it (or create it!!).
$!
$	len = len + 2
$	P1 = "[''P1']"
$	GOTO pmain
$!
$! Comes here if a /switch was included.
$!
$ switches:
$	switch = "N"
$       IF F$LOCATE(switch_val,"MAKE") .EQ. 0 THEN GOTO switch_make
$       IF F$LOCATE(switch_val,"CREATE") .EQ. 0 THEN GOTO switch_make
$	WRITE SYS$OUTPUT "?Invalid switch ''switch_val'"
$	GOTO end
$!
$! The /MAKE or /CREATE switch.
$!
$ switch_make:
$	directory = F$DIRECTORY()
$	WRITE SYS$OUTPUT "$ CREATE/DIRECTORY ''directory'"
$	CREATE/DIRECTORY/NOLOG []
$	GOTO out
$!
$! Comes here to >>>>.
$!
$ pathin:
$	len = len - 1
$	P1 = F$EXTRACT(1,len,P1)
$	IF F$LOCATE("::",P1) .NE. len THEN GOTO network
$	IF F$LOCATE(":",P1) .NE. len THEN GOTO device
$ pathinagain:
$	nextup = F$LOCATE(">",P1)
$	fullen = F$LENGTH(P1)
$	IF nextup .EQ. fullen THEN GOTO pathinok
$       part = F$EXTRACT(0,nextup,P1)
$	tp1 = "[.''part']"
$	nextup = nextup + 1
$	P1 = F$EXTRACT(nextup,fullen,P1)
$	GOTO setpathin
$ pathinok:
$	tp1 = "[.''P1']"
$	IF .NOT. switch THEN GOTO pathinoknotswitch
$	    switchloc = F$LOCATE("/",P1)
$           part = F$EXTRACT(0,switchloc,P1)
$	    tp1 = "[.''part']"
$	    P1 = F$EXTRACT(switchloc,len,P1)
$	    SET DEFAULT 'tp1'
$	    GOTO switches
$ pathinoknotswitch:
$	OPEN/READ/ERROR=checkexistence dirtest 'P1'.DIR
$	CLOSE dirtest
$	P1 = ""
$ setpathin:
$	SET DEFAULT 'tp1'
$	IF P1 .NES. "" THEN GOTO pathinagain
$	GOTO out
$ checkexistence:
$       check = F$SEARCH("''P1'.DIR")
$       IF check .EQS. "" THEN GOTO nonexistent
$       WRITE SYS$OUTPUT "?Subdirectory protected"
$	SET DEFAULT 'original'
$       GOTO end
$ nonexistent:
$	WRITE SYS$OUTPUT "?Nonexistent subdirectory"
$	SET DEFAULT 'original'
$	GOTO end
$!
$! Comes here to "PATH network::".
$!
$ network:
$       node = "Y"
$       colons = F$LOCATE("::",P1)
$       network = F$EXTRACT(0,colons + 2,P1)
$       P1 = F$EXTRACT(colons + 2,len - colons,p1)
$       disk = F$LOGICAL("SYS$DISK")
$       colons = F$LOCATE("::",disk)
$       disklen = F$LENGTH(disk)
$       IF colons .NE. disklen THEN -
           disk = F$EXTRACT(colons + 2,disklen - colons - 2, disk)
$       network_device = network + disk
$	SET DEFAULT 'network_device'
$       GOTO start
$!
$! Comes here to "PATH device:".
$!
$ device:
$       colon = F$LOCATE(":",P1)
$       device = F$EXTRACT(0,colon + 1,P1)
$       P1 = F$EXTRACT(colon + 1,len - colon,p1)
$       len = F$LENGTH(P1)
$       IF node THEN device = network + device
$	SET DEFAULT 'device'
$       IF len .LE. 0 THEN GOTO out
$!
$! Comes here to "PATH [".
$!
$ pmain:
$!
$	IF len .EQ. 1 THEN SET DEFAULT 'F$LOGICAL("SYS$LOGIN")'
$       IF len .EQ. 1 THEN GOTO out
$!
$       IF F$LOCATE("[",P1) .NE. len THEN GOTO left_bracket
$       P1 = "[" + P1
$       len = len + 1
$ left_bracket:
$       IF F$LOCATE("]",P1) .NE. len THEN GOTO right_bracket
$       P1 = P1 + "]"
$       len = len + 1
$ right_bracket:
$!
$       rghtbrck = F$LOCATE("[",p1)
$       IF F$EXTRACT(rghtbrck + 1,1,P1) .EQS. "." THEN GOTO not_a_top_directory
$       first_dot = F$LOCATE(".",P1)
$       top_directory = F$EXTRACT(rghtbrck+1,first_dot - 1,P1)
$       top_len = F$LENGTH(top_directory)
$       IF F$LOCATE("[",top_directory) .NE. top_len THEN GOTO left_brack
$       top_directory = "[''top_directory'"
$       top_len = top_len + 1
$!
$ left_brack:
$       IF F$LOCATE("]",top_directory) .NE. top_len THEN GOTO right_brack
$       top_directory = top_directory + "]"
$ right_brack:
$       SET DEFAULT 'top_directory'
$       P1 = "[" + F$EXTRACT(first_dot,len - first_dot,P1)
$       len = F$LENGTH(P1)
$ not_a_top_directory:
$!
$       no_of_dashes = 0
$       other_dashes = 0
$       dash = F$LOCATE("-",P1)
$       IF dash .EQ. len THEN GOTO check_periods
$       tmp_dash = dash
$!
$ find_more_dashes:
$       no_of_dashes = no_of_dashes + 1
$       tmp_string = F$EXTRACT(tmp_dash + 1,len - tmp_dash - 1,P1)
$       other_dashes = F$LOCATE("-",tmp_string) + tmp_dash + 1
$       IF other_dashes .EQ. len THEN GOTO no_more_dashes
$       tmp_dash = other_dashes
$       GOTO find_more_dashes
$!
$ no_more_dashes:
$       P1 = F$EXTRACT(tmp_dash + 1,len - tmp_dash - 1,P1)
$	len = F$LENGTH(p1)
$!
$ move_up_a_level:
$       IF no_of_dashes .LE. 0 THEN GOTO check_periods
$       no_of_dashes = no_of_dashes - 1
$       SET DEFAULT [-]
$       GOTO move_up_a_level
$!
$ check_periods:
$       IF (len .EQ. 1) .AND. (P1 .EQS. "]") THEN GOTO out
$       no_of_periods = 0
$       other_periods = 0
$       period = F$LOCATE(".",P1)
$       IF period .EQ. len THEN GOTO no_period
$       tmp_period = period
$!
$ find_more_periods:
$       no_of_periods = no_of_periods + 1
$       tmp_string = F$EXTRACT(tmp_period + 1,len - tmp_period - 1,P1)
$       other_periods = F$LOCATE(".",tmp_string) + tmp_period + 1
$       IF other_periods .EQ. len THEN GOTO no_more_periods
$       dir_no_'no_of_periods' = F$EXTRACT(tmp_period + 1,other_periods - tmp_period - 1,P1)
$       tmp_period = other_periods
$       GOTO find_more_periods
$!
$ no_more_periods:
$       dir_no_'no_of_periods' = F$EXTRACT(tmp_period + 1,other_periods - tmp_period - 2,P1)
$       total_dirs = no_of_periods
$!
$ test_existence:
$       IF no_of_periods .LE. 0 THEN GOTO out
$       number = total_dirs - no_of_periods + 1
$       test_dir = dir_no_'number'
$       no_of_periods = no_of_periods - 1
$       IF switch THEN GOTO creating_directory
$	OPEN/READ/ERROR=check_existence dirtest 'test_dir'.DIR
$	CLOSE dirtest
$!
$ creating_directory:
$       SET DEFAULT [.'test_dir']
$       GOTO test_existence
$!
$ check_existence:
$       check = F$SEARCH("''test_dir'.DIR")
$       IF check .EQS. "" THEN GOTO nonexistent
$       WRITE SYS$OUTPUT "?Subdirectory protected"
$	SET DEFAULT 'original'
$       GOTO end
$!
$ no_period:
$       IF F$LOCATE("[",P1) .NE. len THEN GOTO nexta
$       P1 = "[" + P1
$       len = len + 1
$ nexta:
$	IF F$LOCATE("]",P1) .NE. len THEN GOTO next
$	P1 = P1 + "]"
$       len = len + 1
$ next:
$	SET DEFAULT 'P1'
$	GOTO out
$!
$! Comes here to "PATH <<<".
$!
$ pathout:
$	k = F$DIRECTORY()
$	IF F$LOCATE(".",k) .EQ. F$LENGTH(k) THEN GOTO inroot
$	SET DEFAULT [-]
$ inroot:
$	P1 = F$EXTRACT(1,len,P1)
$	tp1 = F$EXTRACT(0,1,P1)
$	IF tp1 .EQS. "<" THEN GOTO pathout
$	IF P1 .NES. "" THEN GOTO start
$	GOTO out
$!
$! Comes here to "PATH logical".
$!
$ logical:
$	SET DEFAULT 'p1'
$	GOTO out
$!
$! End on errors.
$!
$ error:
$	WRITE SYS$OUTPUT "?Invalid path command"
$	SET DEFAULT 'original'
$       GOTO end
$!
$! General end.
$!
$ out:
$	IF switch THEN GOTO switches
$	IF F$LENGTH(P2) .EQ. 0 THEN GOTO end
$	PATH 'P2' 'P3' 'P4' 'P5' 'P6'
$       EXIT
$ end:
$	SHOW DEFAULT
$ 	IF verify THEN SET VERIFY