PROGRAM MOVE C+ C------------------------------------------------------------------------- C PROGRAM MOVE C C Operating System: RSX-11/M-PLUS V 3.0C* C Environment: System utilities C Env. Vsn: 01.02 C C Program Description: C C This is an outgrowth of the MOVE.CMD file I wrote to change C directories, including logical names and named directories. C I wanted to run it faster (don't we all), but I wanted to be C able to read it later, so I chose FORTRAN, since it is a compiled C language, fairly quick, and easier to read than MACRO. C C Since then, I have also written such a program for VAX/VMS, so C I have integrated some of my ideas from that into this program. C C Many buffers were used to hold data. Data is not written over, C but instead counters are manipulated to point to start and end C of string. C C The task MOVE should be installed as ...MOV, or as ...DEF, but C should not have a UIC assigned. This way it can find the default C and protection UICs for a user as if it is for the task. C C The first chore was finding a way to identify directory and C non-directory modes. The GETDDS directive does this quite well, C since in NONAMED mode the returned value has length 2 and the C value '[]'. C C Then the arduous task of parsing the input command string starts. C C After parsing, the SET /DEF and ASN commands are spawned to MCR. C C The display looks like the SET /DEF display. This way, some C consistency is maintained. C C Additional features have been added: C C If the destination device is not mounted and the user is privileged, C a MOU /OVR/LOCK=NO will be spawned. C C The VAX IN foreign command defaults are used, ie. HOME or $ gets C you to SYS$LOGIN, and . or PRE takes you to your last directory. C C The * has been implemented as follows: C C 1) If DEF * is entered, the specified device C is searched for all directories and the user is C prompted for each. Y changes directories and ends C program, N checks for next directory. C C 2) If DEF nnn,* or DEF *,nnn is C entered, only matching directories will be prompted C for. C C If the destination directory does not exist, an informational C message is generated. This can be prevented by commenting out C the call to DIRUIC and the following IF test based on EXISTS. C I did this because I type too fast for my own good, and often C end up where I did not intend. Sometimes, however, you want C to move to a non-existant directory. I have compromised in C this way. C C I hope that a paper on this stuff will be forthcoming to the C Multi-tasker. C C Environmental Requirements: C C Re-build Procedure: MOVE.CMD C Command Procedures: NONE C Libraries: MOVE.OLB C Modules: SETTRM ( MOVE.OLB ) C GETLOG ( MOVE.OLB ) C GETDEF ( MOVE.OLB ) C GETMCR ( Executive ) C SKPSPC ( MOVE.OLB ) C PARSE ( MOVE.OLB ) C DEVUIC ( MOVE.OLB ) C CHKDEV ( MOVE.OLB ) C MCRCMD ( MOVE.OLB ) C CHKUIC ( MOVE.OLB ) C ASNRST ( MOVE.OLB ) C EXIT ( Executive ) C DEFCMD ( MOVE.OLB ) C DIRUIC ( MOVE.OLB ) C C Test Procedures: C Test Data Files: NONE C Test Scripts: NONE C Documents: NONE C C Required Logicals: KMS$CURRENT - ( Defined by MOVE ) C KMS$LAST - ( Defined by MOVE ) C C Required Files: NONE C C Required COMMON blocks: NONE C C C Written By: Robert Hays C KMS Fusion, Inc. C P.O. Box 1567 C Ann Arbor, Mich. 48106 C C Date: September 29, 1986 C C C Change Log: C C Date | Initials | Ident | Description C---------------+-----------+-------+---------------------------------------- C 06-NOV-86 | RLH | 001 | Add mount command, add IN mimics. C 14-JAN-87 | RLH | 002 | Add informational message for existance. C---------------------------------------------------------------------------- C- C IDENT /01.02/ C CHARACTER*80 cmdstr ! String gotten from MCR. CHARACTER*80 defuic ! Starting UIC or directory. CHARACTER*80 prtuic ! Protection UIC. CHARACTER*80 defdev ! Default device (SY:) CHARACTER*80 device ! Final device spec, if any. CHARACTER*80 dstuic ! Final destination UIC, if any. CHARACTER*80 setuic ! SET /DEF command for MCR. CHARACTER*80 moucmd ! MOU command for MCR, if need. CHARACTER*80 trns ! Logical name translations. CHARACTER*80 work ! Work space. I needed an extra ! string. . . CHARACTER*80 work1 ! Work space for device. CHARACTER*80 work2 ! Work space for UIC. CHARACTER*80 asn ! Assign command in MCR. CHARACTER*10 mode ! Mode display flag. CHARACTER*6 trmnam ! Name of local terminal. CHARACTER*1 space, ! Constants. + colon ! C LOGICAL dirmod ! Flag directory vs. UIC mode. LOGICAL priv ! Is terminal privileged? LOGICAL spw1, spw2 ! Indicates if device or UIC ! changes were successfully ! spawned. LOGICAL mou ! Is destination mounted? LOGICAL exists ! Does destination directory ! exist? C INTEGER*2 ids ! Error flags. INTEGER*2 luntrm, ! Terminal lun. + tstlun ! Lun for testing device name. INTEGER*2 lendir, lenprt ! Length of DEFUIC, PRTUIC. INTEGER*2 lendev ! Length of default device. INTEGER*2 devlen ! Length of final device. INTEGER*2 lentrn ! Length of TRNS. INTEGER*2 lentrm ! Length of terminal name. INTEGER*2 loccol(6), locspc(6) ! Returned from PARSE. INTEGER*2 lenwrk ! Work space in use. INTEGER*2 idev, ! Length of device name. + iuic ! Length of UIC or directory ! command. INTEGER*2 lenuic ! Length of UIC only. INTEGER*2 trmmne ! Terminal mnemonic. INTEGER*2 trmunt ! Terminal unit number. INTEGER*2 lmou ! Length of moucmd. INTEGER*2 deverr, uicerr ! Temporary error storage. C DATA cmdstr/' '/ ! Init command buffer. DATA space/' '/, ! Character constants. + colon/':'/ ! DATA luntrm/1/, ! Save space: use first two + tstlun/2/ ! units only. DATA lenwrk/0/ ! No work space in use at start. C C Executable begins here. C deverr = 1 ! Init for success. uicerr = 1 ! Ditto. CALL SETTRM ( luntrm, trmnam, lentrm, ! Get default terminal + trmmne, trmunt, priv ) ! characteristics. CALL GETLOG ( 'SY', 1, 2, 80, defdev, ! Try to translate default + lendev, ids ) ! device SY:. IF ( ids .NE. 1 ) THEN ! Default to LB: if no SY:. defdev = 'LB:' ! lendev = 3 ! END IF ! CALL GETDEF ( defuic, lendir, lenprt, ! Get default UIC and protection + prtuic, dirmod, ids ) ! UIC. Indicate if in directory ! mode. C CALL GETMCR ( cmdstr, ids ) ! Get MCR command line. IF ( ids .GT. 0 ) THEN ! Got a command, so C ! Process it. istrt = 1 ! Start parsing at the beginning. iend = ids ! Parse it all. D WRITE ( luntrm, 1111 ) 'SKPSPC' D1111 FORMAT ( ' CALLING ', A ) CALL SKPSPC ( cmdstr, istrt, iend, ! Remove the command from the + ids ) ! command line from GETMCR. IF ( ids .GT. 0 ) THEN ! Got a command more than the ! first three letters. CALL DEFCMD ( luntrm, cmdstr, istrt,! If ., $, pre, home, or *, + iend, direct, ier ) ! process and use defaults. D WRITE ( luntrm, 1111 ) 'DEFCMD' IF ( ier .LT. 0 ) GO TO 9000 ! Failure. D WRITE ( luntrm, 1111 ) 'PARSE' CALL PARSE ( cmdstr, istrt, iend, ! Find colons. + colon, loccol, ids ) ! IF ( loccol(1) .GT. 0 ) THEN ! Since we found a colon, assume ! it implys a device or logical. work(1:loccol(1)-istrt-1) = ! Load before : into work space. + cmdstr(istrt:loccol(1)-2) ! lenwrk = loccol(1) - istrt - 1 ! Update work space use. IF ( loccol(1) .GT. iend ) THEN ! Nothing else on command line. iend = 0 ! Mark all done with CMDSTR. istrt = 0 ! Ditto. ELSE ! cmdstr(1:iend-loccol(1)+1) = ! Load all after : back into + cmdstr(loccol(1):iend) ! CMDSTR. iend = iend - loccol(1) + 1 ! Update end of CMDSTR. istrt = 1 ! Update its start, too. j = 0 ! Init. pointer to first blank. DO 110 i = istrt, iend ! Check for leading spaces and IF ( cmdstr(i:i) .EQ. ! Found a blank. + ' ' ) THEN ! j = i ! Update pointer. ELSE ! Not a blank. GOTO 111 ! No more leading spaces. END IF ! End blank check. 110 CONTINUE ! End loop for CMDSTR check. 111 CONTINUE ! Jump here for non-blank. IF ( j .GT. 0 ) THEN ! There are leading blanks. cmdstr(istrt:iend-j) = ! Remove them by overwriting. + cmdstr(j+1:iend) ! iend = iend - j - istrt + 1 ! Update end pointer. END IF ! End leading blank removal. END IF ! End nothing else on command ! line check. ELSE ! No colon found in command ! line. D WRITE ( luntrm, 1111 ) 'PARSE' CALL PARSE ( cmdstr, istrt, iend, ! Find spaces. + space, locspc, ids ) ! IF ( locspc(1) .GT. 0 ) THEN ! work(1:locspc(1)-istrt-1) = ! Load work space. + cmdstr(istrt:locspc(1)-2) ! lenwrk = locspc(1) - istrt - 1 ! Update end of work space. cmdstr(1:iend-locspc(1)+1) = ! Update CMDSTR. + cmdstr(locspc(1):iend) ! iend = iend - locspc(1) + 1 ! Update end of string. istrt = 1 ! Update start. ELSE ! Just a logical or UIC. work(1:iend-istrt+1) = ! Load whole string into + cmdstr(istrt:iend) ! work space. lenwrk = iend - istrt + 1 ! Update length of work space. iend = 0 ! Nothing in CMDSTR now. istrt = 0 ! Ditto. END IF ! END IF ! D WRITE ( luntrm, 1111 ) 'GETLOG' CALL GETLOG ( work, 1, ! See if DEVICE is a logical + lenwrk, 80, ! name. + trns, lentrn, ! + ids ) ! IF ( ids .LE. 0 ) THEN ! No logical name translated. device(1:lenwrk) = ! Copy WORK into DEVICE. + work(1:lenwrk) ! idev = lenwrk ! ELSE ! Got a translation, so... D WRITE ( luntrm, 1111 ) 'DEFUIC' CALL DEVUIC ( trns, lentrn, ! Parse TRNS into WORK and/ + work, lenwrk, ! or DSTUIC. + dstuic, iuic ) ! IF ( lenwrk .GT. 0 ) THEN ! Found a potential device, so D WRITE ( luntrm, 1111 ) 'GETLOG' CALL GETLOG ( work, 1, lenwrk, ! try translating it again. + 80, trns, ! Do this because some logicals + lentrn, ids ) ! translate into logical + UIC, ! and some into a logical again. IF ( ids .GT. 0 ) THEN ! It translated. D WRITE ( luntrm, 1111 ) 'DEVUIC' CALL DEVUIC ( trns, lentrn, ! Parse TRNS into device and/ + work2, iwrk2, ! or UIC. + work1, iwrk1 ) ! NOTE: IWRK1 -> UIC ! IWRK2 -> Device IF ( iwrk1 .GT. 0 ) THEN ! Got a UIC. dstuic(1:iwrk1) = ! Load value + work1(1:iwrk1) ! and iuic = iwrk1 ! update length. END IF ! IF ( iwrk2 .GT. 0 ) THEN ! Got a device, so... device(1:iwrk2) = ! TRNS into DEVICE, the final + work2(1:iwrk2) ! device string. idev = iwrk2 ! Save length, indicating we ! got a value. lenwrk = 0 ! Clear work buffer. ELSE ! No parse in DEVUIC, so device(1:lentrn) = ! pass it on and check it out. + trns(1:lentrn) ! idev = lentrn ! Mark length. lenwrk = 0 ! Clear work buffer. END IF ! ELSE ! No translation, so save device(1:lenwrk) = ! WORK, the last known device, + work(1:lenwrk) ! in DEVICE. idev = lenwrk ! Mark the event. lenwrk = 0 ! Clear WORK. END IF ! IF ( idev .GT. 0 ) THEN ! Strip off any loctmp = INDEX ( device(1:idev), ! remaining colons. + colon ) ! IF ( loctmp .GT. 0 ) THEN ! Found one. idev = loctmp - 1 ! Reset end of DEVICE. END IF ! End colon check. END IF ! End IDEV test. END IF ! END IF ! spw1 = .FALSE. ! Initialize flag for device ! change success. IF ( idev .GT. 0 ) THEN ! Got a device, so try it out. D WRITE ( luntrm, 1111 ) 'CHKDEV' CALL CHKDEV ( luntrm, tstlun, ! Check the device. + device, ! + devlen, idev, asn, ! + mou, moucmd, lmou, ! + ids ) ! deverr = ids ! Save device error. IF ( ids .GT. 0 .OR. ! Check result of check. + idev .GT. 0 ) THEN ! lenwrk = 0 ! Clear work buffer, since we ! Got a device. IF ( .NOT. mou .AND. ! Privileged and + priv ) THEN ! device not mounted. CALL MCRCMD ( moucmd, lmou, ! Issue command to mount device. + trmunt, trmmne, ! + ids ) ! END IF ! spw1 = .TRUE. ! Mark success. END IF ! IF ( lenwrk .GT. 0 ) THEN ! Work buffer non-empty. dstuic(1:lenwrk) = ! Try as UIC or named dir then. + work(1:lenwrk) ! iuic = lenwrk ! Save length. END IF ! End work buffer check. END IF ! End work on potential devices. IF ( iend .GT. 0 ) THEN ! Load CMDSTR into DSTUIC. dstuic(iuic+1:iuic+1) = space ! Insert a space. dstuic(iuic+2:iuic+iend-istrt+2) =! It can only be a UIC. + cmdstr(istrt:iend) ! Notice that CMDSTR is tacked iuic = iuic + iend - istrt + 2 ! on after WORK, if necessary, END IF ! or loaded in at start. spw2 = .FALSE. ! Init UIC flag. IF ( iuic .GT. 0 ) THEN ! Got a UIC. D WRITE ( luntrm, 1111 ) 'CHKUIC' CALL CHKUIC ( luntrm, tstlun, ! Check it out and create + dirmod, dstuic, ! an MCR SET /DEF command. + iuic, lenuic, ! + setuic, defuic, ! + lendir, ! + device, devlen, ! + ids ) ! uicerr = ids ! Save UIC error. IF ( ids .GT. 0 ) THEN ! UIC checked out, so do it. CALL MCRCMD ( setuic, iuic, ! Spawn SET /DEF command. + trmunt, trmmne, ! + ids ) ! IF ( ids .NE. 1 ) THEN ! Failed setting WRITE ( luntrm, 6020 ) ! default. 6020 FORMAT ( ' %DEF-F-DIR, Direct', ! + 'ory not available.' ) ! GO TO 9000 ! ELSE ! spw2 = .TRUE. ! Flag success. END IF ! ELSE ! Bad directory or UIC. WRITE ( luntrm, 6025 ) ! Issue message. 6025 FORMAT ( ' %DEF-F-DIR, illegal',! + ' device or', ! + ' directory.' ) ! GO TO 9000 ! Exit. END IF ! END IF ! End UIC checks. IF ( spw1 ) THEN ! Spawn ASN command. CALL MCRCMD ( asn, idev, ! Spawn command to ASN device to + trmunt, trmmne, ! SY:. + ids ) ! IF ( ids .NE. 1 ) THEN ! Check SPAWN directive. WRITE ( luntrm, 6010 ) ! 6010 FORMAT ( ' %DEF-F-DEV, Device', ! + ' not available.' ) ! GO TO 9000 ! Exit. END IF ! END IF ! End spawn ASN commands. IF ( iuic .LE. 0 ) THEN ! No UIC given, so use default. dstuic(1:lendir) = ! Stuff default in for none. + defuic(1:lendir) ! lenuic = lendir ! Replace length, too. END IF ! End UIC check. IF ( idev .LE. 0 ) THEN ! No device specified, so use device(1:lendev) = ! the default one. + defdev(1:lendev) ! devlen = lendev ! Get length. END IF ! End device check. D WRITE ( luntrm, 1111 ) 'ASNRST' CALL ASNRST ( spw1, spw2, device, ! Set up CURRENT and LAST + devlen, dstuic, ! logical names. + lenuic, defdev, ! + lendev, defuic, ! + lendir, ids ) ! ELSE ! Nothing after first ! characters of command. dstuic(1:lendir) = defuic(1:lendir) ! Use default directory. lenuic = lendir ! Replace length, too. device(1:lendev) = defdev(1:lendev) ! Use default device. devlen = lendev ! Get length. END IF ! D WRITE ( luntrm, 1111 ) 'DIRUIC' CALL DIRUIC ( luntrm, tstlun, dstuic, ! Check destination for + lenuic, device, devlen, ! existance. + exists ) ! IF ( .NOT. exists ) THEN ! Does not exist. WRITE ( luntrm, 7625 ) ! Issue message. 7625 FORMAT ( ' %DEF-I-NOEXIST, Direct', ! + 'ory does not exist.' ) ! END IF ! ELSE ! No command string at all. dstuic(1:lendir) = defuic(1:lendir) ! Use default directory. lenuic = lendir ! Replace length, too. device(1:lendev) = defdev(1:lendev) ! Use default device. devlen = lendev ! Get length. END IF ! IF ( dirmod ) THEN ! Directory mode flag. mode = 'Named' ! Named mode, so flag with modlen = 5 ! message and save length. ELSE ! Not named mode, so mode = 'Nonamed' ! use NONAMED message and modlen = 7 ! length. IF ( priv ) THEN ! prtuic(1:lenuic) = dstuic(1:lenuic) ! lenprt = lenuic ! END IF ! END IF ! IF ( deverr .LT. 0 .AND. ! Failed totally. + uicerr .LT. 0 ) THEN ! WRITE ( luntrm, 7500 ) ! Output message. 7500 FORMAT ( ' %DEF-F, Illegal device ',! + 'or directory.' ) ! GO TO 9000 ! Exit. END IF ! End error check. WRITE ( luntrm, 8000 ) device(1:devlen),! Write location message. + dstuic(1:lenuic),! This mimics the MCR SET /DEF + mode(1:modlen), ! output. + trmnam(1:lentrm),! + prtuic(1:lenprt) ! 8000 FORMAT ( ' ',A,A,T20, ! + A,T32,A/ ! + ' Protection UIC: ',A )! 9000 CONTINUE ! Jump here on fatal error. CALL EXIT END