-- Create package for Long_Float I/O so as not to conflict with

-- the default G_FLOAT format. This example assumes that the ACS
-- SET PRAGMA command has been issued.

with text_io;
package long_float_text_io is new text_io.float_io(long_float);

-- I/O utilities
with text_io;                     use text_io;
with integer_text_io;             use integer_text_io;
with short_integer_text_io;       use short_integer_text_io;
with short_short_integer_text_io; use short_short_integer_text_io;
with float_text_io;               use float_text_io;
with long_float_text_io;          use long_float_text_io;

exec sql include sqlca;

-- The department table
exec sql declare dept table
      (name         char(12) not null,      -- Department name
       totsales     money not null,         -- Total sales
       employees    smallint not null);      -- Number of employees

-- The employee table
exec sql declare employee table
      (name         char(20)     not null,    -- Employee name
       age          integer1 not null,        -- Employee age
       idno         integer not null,         -- Unique employee id
       hired        date not null,            -- Date of hire
       dept         char(12) not null,        -- Department of work
       salary       money not null);          -- Yearly salary

-- "State-of-Limbo" for employees who lose their department
exec sql declare toberesolved table
      (name         char(20) not null,        -- Employee name
       age          integer1 not null,        -- Employee age
       idno         integer not null,         -- Unique employee id
       hired        date   not null,          -- Date of hire
       dept         char(12) not null,        -- Department of work
       salary       money not null);          -- Yearly salary

-- Procedure: Process_Expenses -- MAIN
-- Purpose:   Main body of the application. Initialize the
--            database, process each department and terminate
--            the session.
-- Parameters:
--            None

procedure Process_Expenses is
      log_file: File_type;            -- Log file to write to.
      sql_error: exception;
--
-- Procedure:    Init_Db
-- Purpose:      Initialize the database.
--               Connect to the database and abort on error.
--               Before processing departments and employees,
--               create the table for employees who
--               lose their departments, "toberesolved".
-- Parameters:
--             None
--

procedure Init_Db is

begin
    exec sql whenever sqlerror stop;
    exec sql connect personnel;

    put_line(log_file,
      "Creating ""To_Be_Resolved"" table.");
    exec sql create table toberesolved
         (name      char(20) not null,
          age       integer1 not null,
          idno      integer not null,
          hired     date not null,
          dept      char(12) not null,
          salary    money not null);

end Init_Db;

-- Procedure: End_Db
-- Purpose:   Commit the multi-statement transaction and
--            end access to the database.
-- Parameters:
--            None

procedure End_Db is
begin
    exec sql commit;
    exec sql disconnect;
end End_Db;

--
-- Procedure: Close_Down
-- Purpose: Error handler called any time after Init_Db has been
--          successfully completed. In all cases, print the cause
--          of the error and abort the transaction, backing out
--          changes. Note that disconnecting from the database
--          will implicitly close any open cursors.
-- Parameters: None.
--

procedure Close_Down is
      exec sql begin declare section;
             errbuf: String(1..200);
      exec sql end declare section;

begin
      -- Turn off error handling here
      exec sql whenever sqlerror continue;
      exec sql inquire_sql (:errbuf = ERRORTEXT);
      put_line( "Closing Down because of database error.");
      put_line( errbuf );

      exec sql rollback;
      exec sql disconnect;

      raise sql_error; -- No return
end Close_Down;

--
-- Procedure: Process_Employees
-- Purpose:   Scan through all the employees for a particular
--            department.Based on given conditions, the employee
--            may be terminated or given a salary reduction:
--            1. If an employee was hired since 1985, the
--            employee is terminated.
--            2. If the employee's yearly salary is more
--            than the minimum company wage of $14,000 and
--            the employee is not close to retirement
--            (over 58 years of age), the employee takes
--            a 5% salary reduction.
--            3. If the employee's department is dissolved
--            and the employee is not terminated, then
--            the employee is moved into the
--            "toberesolved" table.
-- Parameters:
--            dept_name    - Name of current department.
--            deleted_dept - Is department dissolved?
--            emps_term - Set locally to record how many employees
--                     were terminated for the current department.
procedure Process_Employees
        (dept_name:      in String;
         deleted_dept:   in Boolean;
         emps_term:      in out Integer) is
    exec sql begin declare section;
      -- Emp_Rec corresponds to the "employee" table
      type Emp_Rec is
          record
              name:           String(1..20);
              age:            Short_Short_Integer;
              idno:           Integer;
              hired:          String(1..25);
              salary:         Float;
              hired_since_85: Integer;
          end record;
      erec: Emp_Rec;
      salary_reduc: constant Float := 0.95;
      dname: String(1..12) := dept_name;
    exec sql end declare section;

    min_emp_salary: constant Float := 14000.00;
    nearly_retired: constant Short_Short_Integer := 58;
    title:       String(1..12); -- Formatting values
    descript:    String(1..25);

    -- Note the use of the Ingres function to find out
    -- who has been hired since the start of 1985.

    exec sql declare empcsr cursor for
          select name, age, idno, hired, salary,
          int4(interval('days', hired-date('01-jan-1985')))
          from employee
          where dept = :dname
          for direct update OF name, salary;

begin                    -- Process Employees
    -- All errors from this point on close down the application
    exec sql whenever sqlerror call Close_Down;
    exec sql whenever not found goto Close_Emp_Csr;

    exec sql open empcsr;

    emps_term := 0;             -- Record how many
    while (sqlca.sqlcode = 0) loop
           exec sql fetch empcsr into :erec;

           if (erec.hired_since_85 > 0) then
                exec sql delete from employee
                        where current of empcsr;
                title := "Terminated: ";
                descript := "Reason: Hired since 1985.";
                emps_term := emps_term + 1;

           -- Reduce salary if not nearly retired
           elsif (erec.salary > min_emp_salary) then
                if (erec.age < nearly_retired) then
                    exec sql update employee
                        set salary = salary * :salary_reduc
                        where current of empcsr;
                    title := "Reduction: ";
                    descript := "Reason: Salary. ";
                else
                    -- Do not reduce salary
                    title := "No Changes: ";
                    descript :=
                    "Reason: Retiring. ";
                end if;

           -- Else leave employee alone
           else
                  title := "No Changes: ";
                  descript := "Reason: Salary. ";
           end if;

           -- Was employee's department dissolved?
           if (deleted_dept) then
                exec sql insert into toberesolved
                      select *
                      from employee
                      where idno = :erec.idno;
                exec sql delete from employee
                      where current of empcsr;
          end if;

          -- Log the employee's information
          put(log_file, " " & title & " ");
          put(log_file, erec.idno, 6);
          put(log_file, ", " & erec.name & ", ");
          put(log_file, erec.age, 3);
          put(log_file, ", ");
          put(log_file, erec.salary, 8, 2, 0);
          put_line(log_file, " ; " & descript);
    end loop;

<<Close_Emp_Csr>>
    exec sql whenever not found continue;
    exec sql close empcsr;

end Process_Employees;

-- Procedure:Process_Depts
-- Purpose: Scan through all the departments, processing each
--           one. If the department has made less than $50,000 in
--           sales, dissolve the department. For each department,
--           process all employees (they may even be moved to
--           another database table). If an employee wa
--           terminated, update the department's employee counter.
-- Parameters:
--           None

procedure Process_Depts is
    exec sql begin declare section;
        -- Dept_Rec corresponds to the "dept" table
        type Dept_Rec is
              record
                    name:       String(1..12);
                    totsales:   Long_Float;
                    employees:  Short_Integer;
              end record;
        dept: Dept_Rec;

        -- Employees terminated
        emps_term: Integer := 0;
    exec sql end declare section;

    min_tot_sales: constant := 50000.00;
    deleted_dept: Boolean; -- Was the dept deleted?
    dept_format: String(1..20); -- Formatting value
    exec sql declare deptcsr cursor for
          select name, totsales, employees
          from dept
          for direct update of name, employees;

begin
    -- All errors from this point on close down the application
    exec sql whenever sqlerror call Close_Down;
    exec sql whenever not found goto Close_Dept_Csr;

    exec sql open deptcsr;

    while (sqlca.sqlcode = 0) loop
        exec sql fetch deptcsr into :dept;

        -- Did the department reach minimum sales?
        if (dept.totsales < min_tot_sales) then
            exec sql delete from dept
                where current of deptcsr;
            deleted_dept := TRUE;
            dept_format := " -- DISSOLVED --";
        else
            deleted_dept := FALSE;
            dept_format := (1..20 = > ' ');
        end if;

        -- Log what we have just done
        put(log_file,
            "Department: " & dept.name &
            ", Total Sales: ");
        put(log_file, dept.totsales, 12, 3, 0);
        put_line(log_file, dept_format);
        -- Now process each employee in the department
        Process_Employees(dept.name,
           deleted_dept, emps_term);

        -- If employees were terminated, record the fact
        if (emps_term > 0 and not deleted_dept) then
            exec sql update dept
                set employees = :dept.employee - :emps_term
                where current of deptcsr;
        end if;
    end loop;

<<Close_Dept_Csr>>
    exec sql whenever not found continue;
    exec sql close deptcsr;
end Process_Depts;

begin -- MAIN program
      put_line("Entering application to process expenses.");
      create(log_file, out_file, "expenses.log");
      Init_Db;
      Process_Depts;
      End_Db;
      close(log_file);
      put_line("Completion of application.");

      exception
           when sql_error =>
               null; -- Just go away quietly
end Process_Expenses;