cobol
REWRITEステートメント

備考

RELATIVEアクセスファイル内のレコードのREWRITE

GCobol >>SOURCE FORMAT IS FIXED
      *> ***************************************************************
      *> Purpose:   RELATIVE file organization  REWRITE example
      *> Tectonics: cobc -g -debug -W -x relatives.cob
      *> ***************************************************************
       identification division.
       program-id. relatives.

       environment division.
       configuration section.
       repository.
           function all intrinsic.

       input-output section.
       file-control.
           select optional relatives
               assign to "relatives.dat"
               file status is filestatus
               organization is relative
               access mode is dynamic
               relative key is nicknum.

       data division.
       file section.
       fd relatives.
          01 person.
             05 firstname      pic x(48).
             05 lastname       pic x(64).
             05 relationship   pic x(32).

       working-storage section.
       77 filestatus pic 9(2).
          88 ineof value 1 when set to false is 0.

       77 satisfaction pic 9.
          88 satisfied value 1 when set to false is 0.

       77 nicknum   pic 9(2).

       77 title-line pic x(34).
          88 writing-names value "Adding, Overwriting.  00 to finish".
          88 reading-names value "Which record?         00 to quit".
       77 problem   pic x(80).

       screen section.
       01 detail-screen.
          05           line 1 column 1  from title-line erase eos.
          05           line 2 column 1  value "Record: ".
          05 pic 9(2)  line 2 column 16 using nicknum.
          05           line 3 column 1  value "First name: ".
          05 pic x(48) line 3 column 16 using firstname.
          05           line 4 column 1  value "Last name: ".
          05 pic x(64) line 4 column 16 using lastname.
          05           line 5 column 1  value "Relation: ".
          05 pic x(32) line 5 column 16 using relationship.
          05 pic x(80) line 6 column 1  from problem.

       01 show-screen.
          05           line 1 column 1  from title-line erase eos.
          05           line 2 column 1  value "Record: ".
          05 pic 9(2)  line 2 column 16 using nicknum.
          05           line 3 column 1  value "First name: ".
          05 pic x(48) line 3 column 16 from firstname.
          05           line 4 column 1  value "Last name: ".
          05 pic x(64) line 4 column 16 from lastname.
          05           line 5 column 1  value "Relation: ".
          05 pic x(32) line 5 column 16 from relationship.
          05 pic x(80) line 6 column 1  from problem.

      *> -*********-*********-*********-*********-*********-*********-**
       procedure division.
       beginning.

      *> Open the file and find the highest record number
      *> which is a sequential read operation after START
           open input relatives

           move 99 to nicknum
           start relatives key is less than or equal to nicknum
               invalid key
                   move concatenate('NO START' space filestatus)
                     to problem
                   move 00 to nicknum
               not invalid key
                   read relatives next end-read
           end-start

      *> Close and open for i-o
           close relatives
           open i-o relatives

      *> Prompt for numbers and names to add until 00
           set writing-names to true
           set satisfied to false
           perform fill-file through fill-file-end
               until satisfied

           close relatives

      *> Prompt for numbers to view names of until 00
           open input relatives

           set reading-names to true
           set satisfied to false
           perform record-request through record-request-end
               until satisfied

           perform close-shop
       .
       ending.
           goback.

      *> get some user data to add
       fill-file.
           display detail-screen.
           accept detail-screen.
           move spaces to problem
           if nicknum equal 0
               set satisfied to true
               go to fill-file-end
           end-if.
       .
       write-file.
           write person
               invalid key
                   move concatenate("overwriting: " nicknum) to problem
                   REWRITE person
                       invalid key
                           move concatenate(
                               exception-location() space nicknum
                               space filestatus)
                           to problem
                   END-REWRITE
           end-write.
           display detail-screen

       .
       fill-file-end.
       .

      *> get keys to display
       record-request.
           display show-screen
           accept show-screen
           move spaces to problem
           if nicknum equals 0
               set satisfied to true
               go to record-request-end
           end-if
       .

      *> The magic of relative record number reads
       read-relation.
           read relatives
               invalid key
                   move exception-location() to problem
               not invalid key
                   move spaces to problem
           end-read
           display show-screen
       .

       record-request-end.
       .

      *> get out <*
       close-shop.
           close relatives.
           goback.
       .
       end program relatives.