Power-Programmierung/CD1.mdf/euphoria/mydata.ex

Text File | 1994-02-11 | 6.6 KB | 280 lines

----------------------- Simple Customizable Database -----------------------

-- files to store the database and a backup copy:
constant DB_NAME   = "mydata.dat",
     BACK_NAME = "mybackup.dat"

constant FIELDS = {  -- Have as many fields as you like. The first one is
             -- used for look-ups. Start a new database if you
             -- change or add fields.
-- example fields:
    "Surname",
    "First name and initial",
    "Phone number"
    }

----------------------------------------------------------------------------
-- How it works:
--
-- The database is just a big Euphoria sequence that is read from
-- a disk file using get(), updated in memory, then written back
-- to the file using print().
--
-- For small amounts of data (up to about a thousand records) this works fine.
-- For very large databases we would want to use the random access I/O
-- functions: seek() and where(), to read/write only a specific portion
-- of the data each time.
----------------------------------------------------------------------------

include get.e
include sort.e

constant KEYBOARD = 0,
     SCREEN   = 1,
     ERROR    = 2

constant TRUE = 1
constant WHITE_SPACE = " \t\n"
constant FORM_FEED = 12

type file_number(integer x)
    return x >= -1
end type

type record(sequence s)
    return length(s) = length(FIELDS)
end type

file_number db    -- number of file containing database

sequence database -- the in-memory database

type record_number(integer x)
    return x >= 0 and x <= length(database)
end type

procedure error(sequence msg)
-- fatal error
    puts(ERROR, '\n' & msg & '\n')
    abort(1)
end procedure

function user_input()
-- get user input from keyboard
    object line

    while TRUE do
    line = gets(KEYBOARD)
    if sequence(line) then
        -- delete any leading whitespace
        while find(line[1], WHITE_SPACE) do
        line = line[2..length(line)]
        if length(line) = 0 then
            exit
        end if
        end while
        if length(line) > 0 then
        exit
        end if
    end if
    puts(SCREEN, "\n? ")
    end while
    -- delete trailing whitespace
    while find(line[length(line)], WHITE_SPACE) do
    line = line[1..length(line)-1]
    end while
    return line
end function

procedure show(file_number f, record rec)
    puts(f, "\n" & rec[1] & '\n')
    for i = 2 to length(FIELDS) do
    puts(f, '\t' & rec[i] & '\n')
    end for
end procedure

function upper(sequence name)
-- convert to upper case
    for i = 1 to length(name) do
    if name[i] >= 'a' and name[i] <= 'z' then
        name[i] = name[i] + 'A' - 'a'
    end if
    end for
    return name
end function

function lookup(sequence name)
-- return record numbers matching name
    sequence matches

    matches = {}
    name = upper(name)
    for i = 1 to length(database) do
    if compare(name, upper(database[i][1])) = 0 then
        matches = matches & i
    end if
    end for
    return matches
end function

procedure db_add()
-- add a new record to the database
    record rec
    sequence matches

    rec = repeat(0, length(FIELDS))
    puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
    rec[1] = user_input()
    matches = lookup(rec[1])
    for i = 1 to length(matches) do
    show(SCREEN, database[matches[i]])
    end for
    for i = 2 to length(FIELDS) do
    puts(SCREEN, "\n\t" & FIELDS[i] & ": ")
    rec[i] = user_input()
    end for
    puts(SCREEN, '\n')
    database = append(database, rec)
end procedure

procedure db_delete()
-- delete a record, given first field
    sequence name, answer
    record_number rec_num
    sequence matches
    integer i

    puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
    name = user_input()
    matches = lookup(name)
    if length(matches) = 0 then
    puts(SCREEN, "\n\tnot found\n")
    return
    end if
    i = 1
    while i <= length(matches) do
    show(SCREEN, database[matches[i]])
    puts(SCREEN, "Delete? ")
    answer = gets(KEYBOARD)
    if find('y', answer) then
        rec_num = matches[i]
        database = database[1..rec_num-1] &
               database[rec_num+1..length(database)]
        exit
    end if
    i = i + 1
    end while
end procedure

procedure db_find()
-- find all records that match value of first field
    sequence name, matches

    puts(SCREEN, "\n\t" & FIELDS[1] & ": ")
    name = user_input()
    matches = lookup(name)
    if length(matches) = 0 then
    puts(SCREEN, "\n\tnot found\n")
    end if
    for i = 1 to length(matches) do
    show(SCREEN, database[matches[i]])
    end for
end procedure

procedure db_list(file_number f)
-- list the entire database to a device
    sequence sorted_database

    sorted_database = sort(database)
    puts(f, '\n')
    for i = 1 to length(sorted_database) do
    show(f, sorted_database[i])
    end for
end procedure

procedure db_save()
-- save in-memory database to disk file
    system("copy " & DB_NAME & " " & BACK_NAME & " > NUL", 2)
    db = open(DB_NAME, "w")
    if db = -1 then
    system("copy " & BACK_NAME & " " & DB_NAME & " > NUL", 2)
    error("Can't save database")
    end if
    -- we could save space in the file by using puts() to output strings
    -- like "ABC". print() outputs numbers like {65, 66, 67}
    print(db, database)
    close(db)
end procedure

procedure db_create()
-- create a new database

    db = open(DB_NAME, "w")
    database = {}
    print(db, database)
    close(db)
    db = open(DB_NAME, "r")
    if db = -1 then
    error("Couldn't open database")
    end if
end procedure

procedure db_main()
    sequence command
    file_number printer

    db = open(DB_NAME, "r")
    if db = -1 then
    db_create()
    else
    database = get(db)
    if database[1] != GET_SUCCESS then
        error("Couldn't read database")
    end if
    database = database[2]
    end if
    close(db)

    clear_screen()
    puts(SCREEN, "\t\tSimple Database\n")
    while TRUE do
    puts(SCREEN,
    "\n(a)dd, (d)elete, (f)ind, (l)ist, (p)rint, (s)ave, (q)uit: ")
    command = user_input()
    if find('a', command) then
        db_add()

    elsif find('d', command) then
        db_delete()

    elsif find('f', command) then
        db_find()

    elsif find('q', command) then
        exit

    elsif find('s', command) then
        db_save()
        exit

    elsif find('l', command) then
        db_list(SCREEN)

    elsif find('p', command) then
        printer = open("PRN", "w")
        if printer = -1 then
        puts(SCREEN, "Can't open printer device\n")
        else
        db_list(printer)
        puts(printer, FORM_FEED)
        close(printer)
        end if
    else
        puts(SCREEN, "\nsay what?\n")
    end if
    end while
end procedure

db_main()