-- I/O utilities

with text_io; use text_io;

exec sql include sqlca;

exec sql declare person table
   (name     char(20),        -- Person name
    age      smallint,        -- Age
    number   integer);        -- Unique id number

procedure Table_Edit is
      exec sql begin declare section;
          -- Table field row states
          type Row_States is (
              row_undef,      -- Empty or undefined row
              row_new,        -- Appended by user
              row_unchange,  -- Loaded by program, but not updated
              row_change,     -- Loaded by program and updated
              row_delete      -- Deleted by program
          );

          not_found: constant := 100; -- SQLCA value for no rows
          -- Person information corresponds to "person" table
          pname:   String(1..20);  -- Full name
          page:    Short_Integer;  -- Age
          pnumber: Integer;        -- Unique person number
          pmaxid:  Integer;        -- Maximum person id number
          -- Table field entry information
          state: Row_States;       -- State of data set row

          recnum,                  -- Record number
          lastrow: Integer;        -- Last row in table field
          -- Utility buffers
          search:  String(1..20);  -- Name to find in search loop
          password: String(1..13); -- Password buffer
          msgbuf:  String(1..100); -- Message buffer
          respbuf: String(1..1);   -- Response buffer
      exec sql end declare section;

      -- Error handling variables for database updates
      update_error: Boolean; -- Error in updates?
      update_commit: Boolean; -- Commit updates
      -- Load the information from the "person" table into the
      -- person variables. Also, save the maximum person id
      -- number.

      function Load_Table return Integer is
           exec sql begin declare section;
                  -- Person information
                  pname:   String(1..20); -- Full name
                  page:    Short_Integer; -- Age
                  pnumber: Integer;        -- Unique person number
                  maxid:   Integer;    -- Maximum person id number
            exec sql end declare section;
            exec sql declare loadtab cursor for
                  select name, age, number
                  from person;

            -- Set up error handling for loading procedure
            exec sql whenever sqlerror goto Load_End;
            exec sql whenever not found goto Load_End;

      begin                      -- Load_Table
            exec frs message 'Loading Person Information . . .';

            -- Fetch the maximum person id number for later use
            exec sql select max(number)
                  into :maxid
                  from person;

            exec sql open loadtab;

            while (sqlca.sqlcode = 0) loop
                -- Fetch data into record and load table field
                exec sql fetch loadtab into
                                :pname, :page, :pnumber;

                exec frs loadtable personfrm persontbl
                      (name = :pname, age = :page,
                                   number = :pnumber);
            end loop;

      <<Load_End>>
          exec sql whenever sqlerror continue;
          exec sql close loadtab;

          return maxid;
      end Load_Table;

begin -- Table_Edit
      -- Set up error handling for main program
      exec sql whenever sqlwarning continue;
      exec sql whenever not found continue;
      exec sql whenever sqlerror STOP;

      -- Start up Ingres and the FORMS system
      exec sql connect 'personnel';

      exec frs forms;

      -- Verify that the user can edit the "person" table
      exec frs prompt noecho ('Password for table editor: ',
                               :password);
      if (password /= "MASTER_OF_ALL") then
          exec frs message 'No permission for task.
                                        Exiting . . .';
          exec frs endforms;
          exec sql disconnect;
          return;
      end if;

      exec frs message 'Initializing Person Form . . .';
      exec frs forminit personfrm;

      -- Initialize "persontbl" table field with a data set
      -- in FILL mode, so that the runtime user can append rows.
      -- To keep track of events occurring to original
      -- rows loaded into the table field, hide the unique
      -- person number.

      exec frs inittable personfrm persontbl FILL
                        (number = integer);

      pmaxid := Load_Table;

      -- Display the form and allow runtime editing
      exec frs display personfrm update;
      exec frs initialize;
      exec frs begin;
          -- Provide menu items, as well as the system FRS
          -- key, to scroll to both extremes of the table field.
          exec frs scroll personfrm persontbl to 1;
      exec frs end;

      exec frs activate menuitem 'Top';
      exec frs begin;
          exec frs scroll personfrm persontbl TO 1; -- Backward
      exec frs end;

      exec frs activate menuitem 'Bottom';
          exec frs begin;
          exec frs scroll personfrm persontbl to end; -- Forward
      exec frs end;

      exec frs activate menuitem 'Remove';
      exec frs begin;
          -- Remove the person in the row the user's cursor
          -- is on. If there are no persons, exit operation
          -- with message. Note that this check cannot
          -- really happen, as there is always at least one
          -- UNDEFINED row in FILL mode.

          exec frs inquire_frs table personfrm
              (:lastrow = lastrow(persontbl));
          if (lastrow = 0) then
              exec frs message 'Nobody to Remove';
              exec frs sleep 2;
              exec frs resume field persontbl;
          end if;

      exec frs deleterow personfrm persontbl;  -- Recorded for
                                               -- later
      exec frs end;

      exec frs activate menuitem 'Find';
      exec frs begin;
          -- Scroll user to the requested table field entry.
          -- Prompt the user for a name, and if one is typed
          -- in, loop through the data set searching for it.

          search := (1..20 => ' ');
              exec frs prompt ('Person''s name : ', :search);
          if (search(1) = ' ') then
              exec frs resume field persontbl;
          end if;

              exec frs unloadtable personfrm persontbl
                   (:pname = name, :recnum = _record,
                    :state = _state);
              exec frs begin;
                  -- Do not compare with deleted rows
                 if (state /= ROW_DELETE and pname = search) then
                   exec frs scroll personfrm persontbl TO :recnum;
                      exec frs resume field persontbl;
                  end if;
           exec frs end;

          -- Fell out of loop without finding name. Issue error.
          msgbuf := (1..100 => ' ');
          msgbuf(1..62) := "Person '" & search &
                "' not found in table [HIT RETURN] ";
          exec frs prompt noecho (:msgbuf, :respbuf);
      exec frs end;

      exec frs activate menuitem 'Exit';
      exec frs begin;
          exec frs validate field persontbl;
          exec frs breakdisplay;
      exec frs end;
      exec frs finalize;

    -- Exit person table editor and unload the table field.
    -- If any updates, deletions or additions were made,
    -- duplicate these changes in the source table. If the
    -- user added new people, assign a unique id to each person
    -- before adding the person to the table. To do this,
    -- increment the previously-saved maximum id number with
    -- each insert.
    -- Do all the updates in a multi-statement transaction
    exec sql savepoint savept;

    update_commit := TRUE;

    -- Hard code the error handling in the UNLOADTABLE loop,
    -- so as to cleanly exit the loop.

    exec sql whenever sqlerror continue;

    exec frs message 'Exiting Person Application . . .';

    exec frs unloadtable personfrm persontbl
        (:pname = name, :page = age,
         :pnumber = number, :state = _state);
    exec frs begin;

        case (state) is
            when row_new =>
                -- Filled by user. Insert with new unique id.
                pmaxid := pmaxid + 1;
                exec sql insert into person (name, age, number)
                   values (:pname, :page, :pmaxid);

            when row_change =>
                -- Updated by user. Reflect in table.
                exec sql update person set
                    name = :pname, age = :page
                    where number = :pnumber;

            when row_delete =>
                -- Deleted by user, so delete from table.
                -- Note that only original rows, not rows
                -- appended at runtime, are saved by the
                -- program.
                exec sql delete from person
                    where number = :pnumber;

            when others =>
                -- Else UNDEFINED or UNCHANGED -
                -- No updates required.
                null;
        end case;

        -- Handle error conditions -
        -- If an error occurred, abort the transaction.
        -- If no rows were updated, inform user and
        -- prompt for continuation.
        if (sqlca.sqlcode < 0) then -- Error
            exec sql inquire_sql (:msgbuf = errortext);
            exec sql rollback to savept;
            update_error := TRUE;
            update_commit := FALSE;
            exec frs endloop;
        elsif (sqlca.sqlcode = NOT_FOUND) then
            msgbuf := (1..100 => ' ');
            msgbuf(1..62) :=
                "Person '" & pname &
                "' not updated. Abort all updates? ";
            exec frs prompt noecho (:msgbuf, :respbuf);
            if (respbuf = "Y" or respbuf = "y") then
                update_commit := FALSE;
                exec sql rollback to savept;
                exec frs endloop;
            end if;
        end if;
    exec frs end;
    if (update_commit) then
        exec sql commit;               -- Commit the updates
    end if;

    exec frs endforms; -- Terminate FORMS and Ingres
    exec sql disconnect;

    if (update_error) then
       put_line( "Your updates were aborted because of error:" );
        put_line( msgbuf );
    end if;

end Table_Edit;