[REBOL] Re: REBOL Relational Object-oriented Database
From: louisaturk:eudoramail at: 26-Jun-2001 4:42
Dear Carl,
At 08:38 PM 6/25/2001 -0700, you wrote:
>Louis,
>
>Sorry about the delay in getting back to you.
>Let me take a look... if I can find some time
>in the next few days. Feel free to nag me.
>
>-Carl
Many, many thanks. I am stuck! (Holger, Jeff, Scott, and others have
also given me a lot of help (some of which I obviously haven't completely
understood or implemented properly. So help from them (or anyone else)
would also be appreciated.)
The latest version of my program is below. I am having problems in the
following areas.
1. The edit-data function isn't working---possibly because I don't
understand how to use it.
2. The kbhit function usually works, but sometimes gives the following error:
Enter the # of Choice (or ESC to Exit): ** Script Error: choice has no v
alue
** Where: forever
** Near: choice = kbhit
if choice
>>
Usually I get that error when the program first starts. If I then type
kbhit from the console, and hit a key, it will work properly, and I can
restart the program and it will work.
3. Print Reports does print the data to the screen, but it also causes
loss of all the data! For your own testing purposes, after typing in some
data save it to a CSV file using choice 6 from the main menu. Then if you
lose it using choice 5 you can then read it back in using choice 7.
The rest of the program seems to be working ok, but testing and bug
reporting from anyone would be greatly apprecitated.
Louis
REBOL [Title: "REBOL Relational Object DBMS"
Date: "19 June 2001"
Version: 0.2
File: %db.r
Author: "Carl Sessenrath and Louis A. Turk"
Email: [louisaturk--eudoramail--com]
Language: 'English
Purpose: "A simple but complete relational object-oriented dbms."
Comments: {Carl Sessenrath made these object oriented database
management system functions as an example to teach me,
Louis A. Turk, how to program an object database myself.
Many thanks Carl! The comments about features below are
mostly Carl's, edited by Louis for this script header.
Features:
1. The db works from memory. Load-data brings it into
memory
where the find, remove and other functions operate on
it.
So, you have to load it first, or at least insert-data a
few times to create some data records.
2. You can expand or reduce the record definition without
corrupting or affecting the database.
3. If you expect to grow this database to a large size,
you will want to MAKE HASH! the database when you
load it. make the hash after the database is created
(after the foreach loop).
database: make hash! database
But, don't worry about that until your database gets big.
For a few hundred names, you don't need it.
4. The functions work like this:
rec: find-data [bob--example--com]
print rec/name
print rec/phone
etc.
remove-data [bob--example--com]
save-data ; write back to disk
insert-data [kit--example--com] "Kitty Carson" none
http:/www.a.com
save-data ; write back to disk
5. You can use NONE for any missing value above. You don't
need to do the save-data each time... but you must do it
sooner or later.
6. The data is organized (keyed) by email. To change an
email address, but keep the rest of the record intact,
use the function change-data. Let's examine change-data:
change-data: func [email-old email-new /local record] [
record: find database email-old
if none? record [alert reform ["Missing record:"
email-old] exit]
insert clear first record email-new ; see note below
]
Note: This is subtle, so should be noted... I'm
clearing
out the actual memory string for the old email, then
inserting
the new string into it.
Also, this string is shared. It is used both in the
database
block (as the key) and in the record object
itself. So changing
it here will change it in both places.
Please send any bug reports or features you add to:
[louisaturk--eudoramail--com]
} ; End of Comments
] ;End of Rebol Script Header
db-file: %data.r
record: context [name: email: phone: web: none] ;Place the none value in
all the varables.
database: []
load-data: has [data] [
data: load/all db-file
clear database
foreach item data [
item: make record item
repend database [item/email item]
]
database: make hash! database
]
change-data: func [email-old email-new /local record] [
record: find database email-old
if none? record [alert reform ["Missing record:" email-old] exit]
insert clear first record email-new ; See note in feature #6 above.
]
save-data: has [data] [
data: copy []
foreach [key obj] database [
append/only data third obj
]
save db-file data
]
find-data: func [email] [select database email]
remove-data: func [email] [remove/part find database email 2]
insert-data: func [email' name' phone' web'] [
repend database [
email'
make record [
email: email'
name: name'
phone: phone'
web: web'
]
]
]
edit-data: func [field index /local record] [
record: find database field
if none? record [alert reform ["Missing record:" field] exit]
record/index: field
]
{Holger and Jeff helped me with this function. I changed it some trying to
learn how to use it.}
kbhit: does [
con: open/direct/binary/no-wait console://
until [wait con]
choice: to-char pick con 1
close con
choice
]
;kbhit: does [
; con: open/direct/binary/no-wait console://
; until [wait con]
; first reduce [to-string copy con close con]
;]
{Below is a simple character based user interface for REBOL/Core added by
Louis A. Turk}
load-data
forever [
cls: "^(1B)[J" ; Clear the Screen.
print cls
print "^/ REBOL RELATIONAL OBJECT-ORIENTED DBMS" ; ^/ is a line feed.
print " =====================================^/"
print " 1. Add Record."
print " 2. Edit a Field In a Record."
print " 3. Delete Record."
print " 4. Change Email Address Only."
print " 5. Print Reports."
print " 6. Export Data To CSV File."
print " 7. Import (APPEND) Data From CSV File."
prin "^/ Enter the # of Choice (or ESC to Exit): "
choice = kbhit
if choice = #"1" [
forever [
print cls
print " ADD A RECORD"
print " ============^/"
email: ask " Email Address : "
if email = "" [break]
rec: find database email
either rec = none [
name: ask " Full Name : "
phone: ask " Area Code & Phone# : "
web: ask " Website URL : "
insert-data email name phone web
save-data
][
ask "^/ Record is already in database. Continue? "
]
] ; End forever loop for choice 1
] ; End if choice 1
if choice = #"2" [
forever [
print cls
print " EDIT A FIELD IN A RECORD"
print " ========================^/"
email-old: ask " Email Address: "
record: find database email-old
if record = none [
print cls
print "^/ Missing record: " email-old
ask "^/ Hit Any Key To Continue."
break
]
record: find-data email-old
print ["^/ 1. Email : " record/email]
print [" 2. Name : " record/name]
print [" 3. Phone : " record/phone]
print [" 4. URL : " record/web "^/"]
prin [" Enter number of field to change: "]
choice: kbhit
; I'm using this method of accessing fields since records in
databases
; to be expanded from this one may have 10 to 30 fields with
only
; one usually needing editing.
if choice = #"1" [
print cls
print " EDIT EMAIL ADDRESS"
print " ==================^/"
edit-data record/email 2
save-data
choice: "0" ; Added this hack to solve a logic problem.
ask "^/The email address has been changed to: " email-new
. Continue? ?
]
if choice = "2" [
print cls
print " CHANGE NAME"
print " ===========^/"
name-old: record/name
ask "New function needed here to edit the name field."
save-data
choice: "0"
]
if choice = "3" [
print cls
print " CHANGE PHONE"
print " ===========^/"
ask "New function needed here to edit the phone number field."
save-data
choice: "0"
]
if choice = "4" [
print cls
print " CHANGE URL"
print " ===========^/"
ask "New function needed here to edit the url field."
save-data
choice: "0"
]
] ; End forever loop
] ; End if choice 2
if choice = #"3" [
forever [
print cls
print " DELETE A RECORD"
print " ===============^/"
email-old: ask " Email Address Of Record To Delete: "
;if email-old = "" [
; break
;] ; End if.
record: find database email-old
if none? record [
print cls
print " Record not found.^/"
ask " Hit Any Key To Continue."
break
]
remove-data email-old
save-data
] ; End forever loop for choice 3.
] ; End if choice 3
if choice = #"4" [
forever [
print cls
print " CHANGE EMAIL ADDRESS ONLY"
print " ==========================^/"
email-old: ask " Email Address To Be Changed: "
if email-old = "" [break]
record: find database email-old
if none? record [
print cls
print "Missing record: " email-old
ask "Hit Any Key To Continue."
break
]
email-new: ask " New Email Address: "
change-data email-old email-new
save-data
] ; End forever loop for choice 4
] ; End if choice 4
{Scott Jones provided the core code for choices 4, 5, and 6 below.}
if choice = #"5" [
print cls
print " PRINT FORMATTED REPORTS"
print " =======================^/"
forskip database 2 [
print ["^/Email: " database/2/email]
print ["Name: " database/2/name]
print ["Phone: " database/2/phone]
print ["Web URL: " database/2/web]
]
prin "^/Continue? "
kbhit
]
if choice = #"6" [
print cls
print " EXPORT DATA TO CSV FILE"
print " =======================^/"
csv: ask "Name of CSV File to Write to: "
either not csv = "" [
csv-file: to-file csv
write csv-file "" ;to get fresh file
emit: func [blk] [repend csv-line blk]
forskip database 2 [
csv-line: make string! 1000
emit [{"} database/2/email {","} database/2/name {","}
database/2/phone
{","} database/2/web {"^/}]
write/append csv-file csv-line
]
prin "^/The file has been written. Continue? "
kbhit
][prin "^/You forget to enter a file name. Continue? " kbhit]
]
if choice = #"7" [
print cls
csv: ask "Name of CSV File to Read From: "
either not csv = "" [
csv-file: to-file csv
open/read csv-file
foreach [email name phone web] parse line none [
line: to-string read/lines csv-file
email: to-email trim email
name: trim name
phone: trim phone
either web = "" [web: none][web: to-url trim web]
if not find-data email [insert-data email name phone web]
save-data
]
prin "^/The Data Has Been Appended to the Database. Continue? "
kbhit
][prin "^/You forget to enter a file name. Continue? " kbhit]
]
] ; End forever loop for main program.
