Programmer 7500/MAX_PROGRAMMERS.iso/INFO/CLIPPER/NANNWS14.ARC/MININET.PRG

Text File | 1987-05-28 | 12.3 KB | 376 lines

* MININET.PRG
*
* Date:       April, 1987
* Author:  David Morgan
* Notes:   Mini-program to demonstrate, in Clipper,
*           1)  when private data control is and isn't needed
*               on a network, and
*           2)  programming techniques for using the two tools
*               that achieve private control (namely, locks on
*               files under shared use; and exclusive use)
*
*        To compile and link, required files are:
*             MININET.PRG  LOCKS.PRG  CLIPPER.LIB  DBU.LIB
*           Syntax:
*             CLIPPER MININET
*             LINK MININET,,,CLIPPER DBU
*
*           Uses test file STATES.DBF containing records
*            for the 13 original states
*
*           Structure of STATES.DBF
*
*           Field  Field Name  Type       Width    Dec
*           1  ST_ABBREV   Character      2
*           2  ST_NAME     Character     20
*           3  ST_CAPITAL  Character     20
*           4  ST_UPDATED  Numeric       10
*
*              4th field is update marker (signature field)
*               for flagging all writes to the record
*
*           Corresponding Index Files     Key Expression
*           STATES1.NTX                   ST_ABBREV
*           STATES2.NTX                   ST_NAME
*           STATES3.NTX                   ST_CAPITAL
*

CLEAR
SET PROCEDURE TO LOCKS
SET MESSAGE TO 23
SET KEY -1 TO VIEW_FILE
SET EXCLUSIVE OFF
bell = CHR(7)
st_list = "AK AL AR AZ CA CO CT DC DE FL GA HI IA ID IL IN KS ";
        + "KY LA MA MD ME MI MN MO MS MT NC ND NE NH NJ NM NV ";
        + "NY OH OK OR PA RI SC SD TN TX UT VA VT WA WI WV WY "
IF NET_USE("STATES",.F.,5)
 SET INDEX TO STATES1,STATES2,STATES3
ELSE
 ? 'File not avaiable for shared use. Program terminated.'
 RETURN
ENDIF
@ 1,0 SAY CENTER("===  MININET: Miniature Clipper Network Application  ===",80)
@ 4,45 SAY 'F2 key to view file contents'

DO WHILE .T.
 @  8,25 PROMPT "1. ADD RECORD"  MESSAGE CENTER(">>> NO LOCKING Needed for APPEND BLANK <<<",80)
 @  9,25 PROMPT "2. EDIT RECORD"  MESSAGE CENTER(">>> Record Locking Needed to REPLACE <<<",80)
 @ 10,25 PROMPT "3. EXAMINE/PRINT/REPORT"  MESSAGE CENTER(">>> NO LOCKING Needed for These Passive Operations <<<",80)
 @ 11,25 PROMPT "4. MAINTAIN FILE"  MESSAGE CENTER(">>> File Locking or Exclusive Use Needed <<<",80)
 @ 12,25 PROMPT "5. QUIT"
 MENU TO choice1
 @ 8,0 CLEAR TO 12,79
 @ 23,0
 DO CASE
  CASE choice1 = 1
   DO ADD
  CASE choice1 = 2
   DO EDIT
  CASE choice1 = 3
   SET INDEX TO STATES2
   DO EXAMINE
   SET INDEX TO STATES1,STATES2,STATES3
  CASE choice1 = 4
   DO MAINTAIN
  CASE choice1 = 5
   EXIT
 ENDCASE
 @ 15,0 CLEAR TO 20,79
ENDDO
CLEAR
RETURN
*======================================================================================================================

PROCEDURE ADD
m_abbrev='  '
@ 15,10 SAY 'Give abbreviation for this state' GET m_abbrev VALID CHECK_ST()
READ
IF EMPTY(m_abbrev)
 RETURN
ELSE
 IF ADD_REC(5)
  REPLACE st_abbrev WITH UPPER(m_abbrev)      && ADD_REC already RLOCKed for us
  @ 23,0 SAY CENTER("Record added.",80)
 ELSE
  @ 23,0 SAY CENTER("Can't add record.",80)
 ENDIF
 ?? bell
 INKEY(1)
 RETURN
ENDIF

FUNCTION CHECK_ST                             && must be a real state
m_abbrev = UPPER(m_abbrev)                    && not already in file
SEEK m_abbrev
RETURN( IF(.NOT.FOUND().AND.(m_abbrev+' ')$st_list,.T.,.F.) )
*----------------------------------------------------------------------------------------------------------------------

PROCEDURE EDIT
 DO WHILE .T.                                &&         ^
  *************************************                    &&        |
  * Select a record to edit                        &&          |
  *************************************                    &&         |
*-contingency branch point A              <-------------------------------------    |
  choice2=0                                                             &&      |   |
  choice3=0                                &&      |   |
  m_abbrev = '  '                            &&      |   |
  @ 15,10 SAY 'Which state do you want (give abbreviation)?' GET m_abbrev &&    |   |
  READ                                    &&      |   |
  @ 15,10                                &&      |   |
  SEEK UPPER(m_abbrev)                            &&      |   |
  IF .NOT.FOUND()                            &&      |   |
   @ 15,10 SAY 'No such state.'                     &&      |   |
   INKEY(2)                                &&      |   |
   @ 15,0 CLEAR TO 20,79                        &&      |   |
   EXIT                                    &&      |   |
  ENDIF                                    &&      |   |
  *************************************                    &&      |   |
  * Edit selected record                        &&      |   |
  *************************************                    &&      |   |
  DO WHILE .T.                                &&      |   |
*-contingency branch point B          <----------------------------------------------
   m_updated = st_updated                        &&      |   |   |
   m_name = st_name                            &&      |   |   |
   m_capital = st_capital                        &&      |   |   |
   @ 16,10 SAY 'State abbreviation: '+st_abbrev                &&      |   |   |
   @ 18,10 SAY 'Edit state name:    ' GET m_name            &&      |   |   |
   @ 19,10 SAY 'Edit state capital: ' GET m_capital            &&      |   |   |
   READ                                    &&      |   |   |
   DO WHILE .T.                                &&      |   |   |
*-contingency branch point C                        &&      |   |   |
    ***************************************                &&      |   |   |
    * Can't LOCK record - optional branches                &&      |   |   |
    *************************************** &&                        <--------    |   |   |
    IF .NOT.REC_LOCKER(5)                        &&  |   |   |   |
     @ 18,0                                &&  |   |   |   |
     @ 19,10 SAY 'Record NOT AVAILABLE now. Choose a contingency plan: '&&  |   |   |   |
     @ 20,12 PROMPT "1. Retry the lock. Maybe it will free up." &&__________|   |   |   |
     @ 21,12 PROMPT "2. Go back and try locking a different record." &&_________|   |   |
     @ 22,12 PROMPT "3. Abort. Leave edit session, back to main menu."  &&__________|   |
     MENU TO choice2                            &&        |   |
     @ 19,0 CLEAR TO 22,79                        &&        |   |
                        DO CASE            && branch control
                         CASE choice2=1        &&        |   |
                          LOOP            && to pt C direct
                         CASE choice2=2        &&        |   |
                          EXIT            && to pt A indirect
                         OTHERWISE        &&        |   |
                          RETURN        &&        |   |
                        ENDCASE            &&        |   |
    ENDIF                                &&        |   |
    *********************************************            &&        |   |
    * Record contents altered - optional branches            &&        |   |
    *********************************************            &&        |   |
    IF m_updated <> st_updated                        &&        |   |
     UNLOCK                                && relinquish record
     @ 18,0                                &&        |   |
     @ 19,10 SAY "You LOCKED record BUT it's CHANGED. Choose a contingency plan: "&&|   |
     @ 20,12 PROMPT "1. Let me re-edit the new contents of current record." &&__________
     @ 21,12 PROMPT "2. Put my changes in TEMP file. Apply to main file later." &&  |
     @ 22,12 PROMPT "3. Abort. Leave edit session, back to main menu." &&___________|
     MENU TO choice3
     @ 19,0 CLEAR TO 22,79
                        DO CASE            && branch control
                         CASE choice3=1
                          EXIT            && to pt B direct
                         CASE choice3=2
                          *DO TEMP_STORE        && your routine
                          RETURN
                         OTHERWISE
                          RETURN
                        ENDCASE
    ENDIF
  *************************************
  * REPLACE fields in locked record
  *************************************
    REPLACE st_name WITH m_name
    REPLACE st_capital WITH m_capital
    REPLACE st_updated WITH st_updated+1
    UNLOCK
    @ 23,0 SAY CENTER('Data Written To File',80)
    ?? bell
    INKEY(1)
    RETURN          && edit has been completed
   ENDDO :C
                        IF choice2=2    && branch control
                         EXIT        && to pt A direct
                        ENDIF
  ENDDO :B
 ENDDO :A
RETURN
*----------------------------------------------------------------------------------------------------------------------

PROCEDURE EXAMINE
PRIVATE top,left,bottom,right,row,end_file
top    = 11
left   = 17
bottom = 20
right  = 60
SAVE SCREEN
CLEAR
TEXT
 You can read through a lock. Locks at other stations don't affect
  passive operations like:

  LIST  SEEK/SKIP/GOTO  REPORT  @..SAY <fieldname>

 And this station doesn't need to do any locking to execute such commands.

 For example, this display runs identically regardless of others' locks in
  the file being displayed:
ENDTEXT
@ top,left TO bottom,right DOUBLE
row = top+1
FOR I = 1 to (bottom-top-1)
 SAYIT(row)
 row = row  + 1
 SKIP                && unaffected by others' locks
NEXT
GO TOP
end_file = .F.
DO WHILE .NOT.end_file
 INKEY(.3)
 SKIP (bottom-top-1)
 IF EOF()
  SKIP -(bottom-top-1)
  end_file = .T.
 ELSE
  SCROLL(top+1,left+1,bottom-1,right-1,1)
  SAYIT(bottom-1)
  SKIP -(bottom-top-2)
 ENDIF
ENDDO
@ 24,2 SAY 'Press any key to continue . . . '
INKEY(0)
RESTORE SCREEN
RETURN

FUNCTION SAYIT
PRIVATE row
PARAMETERS row
 f2=FIELDNAME(2)
 f3=FIELDNAME(3)
 @ row,left+2 say &f2.            && unaffected by others'
 @ row,left+(right-left)/2 SAY &f3.    &&  locks
RETURN("")
*----------------------------------------------------------------------------------------------------------------------

PROCEDURE MAINTAIN
@ 19,12 PROMPT "1. Reset Update Marker Field to Zero, all records" MESSAGE CENTER(">>> Requires a File Lock <<<",80)
@ 20,12 PROMPT "2. Reindex File" MESSAGE CENTER(">>> Requires Exclusive USE <<<",80)
@ 21,12 PROMPT "3. PACK to 13 Original States" MESSAGE CENTER(">>> Requires Exclusive USE <<<",80)
MENU TO choice2
@ 19,0 CLEAR TO 23,79
DO CASE
 CASE choice2 = 1
  IF FIL_LOCK(5)
   REPLACE ALL st_updated WITH 0
   UNLOCK
   @ 23,0 SAY CENTER("All Update Markers Reset.",80)
  ELSE
   @ 23,0 SAY CENTER("Did not REPLACE fields because can't lock file.",80)
  ENDIF
 CASE choice2 = 2
  IF NET_USE("STATES",.T.,5)
   SET INDEX TO STATES1,STATES2,STATES3
   REINDEX
   @ 23,0 SAY CENTER("File Reindexed.",80)
  ELSE
   @ 23,0 SAY CENTER("Did not REINDEX because can't get exclusive use.",80)
  ENDIF
  DO RESHARE
 CASE choice2 = 3
  IF NET_USE("STATES",.T.,5)
   SET INDEX TO STATES1,STATES2,STATES3
   DELETE FOR RECNO() > 13
   PACK
   @ 23,0 SAY CENTER("File PACKed to original contents.",80)
  ELSE
   @ 23,0 SAY CENTER("Did not PACK because can't get exclusive use.",80)
  ENDIF
  DO RESHARE
ENDCASE
?? bell
INKEY(1)
RETURN

PROCEDURE RESHARE
* Attempt to re-establish shared use after having relinquished it
*  through an attempt to get exclusive use
IF NET_USE("STATES",.F.,5)
 SET INDEX TO STATES1,STATES2,STATES3
ELSE
 CLEAR
 ? 'File not recoverable for shared mode use. Program terminated.'
 CLOSE
 ? bell
 QUIT
ENDIF
RETURN
*----------------------------------------------------------------------------------------------------------------------

PROCEDURE VIEW_FILE
PARAMETERS A,B,C
SAVE SCREEN
@ 3,0 CLEAR TO 24,79
@ 4,42 SAY  '<Esc> key to go back to demo program'
DECLARE field_list[4]
field_list[1] = FIELDNAME(2)
field_list[2] = FIELDNAME(1)
field_list[3] = FIELDNAME(3)
field_list[4] = FIELDNAME(4)
SET INDEX TO STATES2
DBEDIT(5, 0, 22, 79, field_list, "ed")
SET INDEX TO STATES1,STATES2,STATES3
RESTORE SCREEN
RETURN

FUNCTION ed
* user defined function to be called from DBEDIT
PARAMETERS mode,i
DO CASE
 CASE mode < 3
  @ 4,10 SAY "Record " + SUBSTR('     '+STR(RECNO()),LEN('     '+STR(RECNO()))-4)
  RETURN(1)
 CASE LASTKEY() = 27
  RETURN(0)
 OTHERWISE
  RETURN(1)
ENDCASE
*----------------------------------------------------------------------------------------------------------------------

FUNCTION CENTER
* Syntax....:CENTER(<expC>,<expN>)
* Notes.....:Returns the expC centered in the width expN by
*           padding leading blanks.
PRIVATE string, width
PARAMETERS string, width
IF LEN(string) >= width         && Too long to center
   RETURN (string)
ENDIF
RETURN (SPACE(INT(width/2) -  INT(LEN(string)/2)) + string)
*----------------------------------------------------------------------------------------------------------------------

FUNCTION REC_LOCKER
*
* altered version of REC_LOCK() that allows interruption by Esc key
*
PARAMETERS wait
PRIVATE forever
IF RLOCK()
 RETURN (.T.)
ENDIF
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)
 IF RLOCK()
  RETURN (.T.)
 ENDIF
 IF INKEY(.5) = 27        && here are the only differences
  EXIT                &&  between this function and
 ENDIF                &&  REC_LOCK() in LOCKS.PRG
 wait = wait - .5
ENDDO
RETURN (.F.)
*----------------------------------------------------------------------------------------------------------------------