Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[REBOL] Object Database

From: jregent:centrum:cz at: 16-Apr-2001 21:12

Hi Carl, Luis, Dr. Turk &comp I play with Carl's Object Database functions and View too. Carl's code is now modified in fly by actual field list of current file. Layout, context, data manipulation function etc. are generated before doing. This db-edit we will to use for administration of small files and learning. I offer cooperation with share, testing, debuging and finishing this code. Some coment's and idas are welcome. Field-list can be stored in db-file.. If field is named "web" as (example 5 ), data of this field are not saved. I thing name "web" is in conflict with internal word? If are used keys Up/Down many times Rebol crasch (GPF) Rebol is best :-) Many thanks for your work and inspiration. By Jan Regent ---------------------------------------------------------------------------- ------ rebol Title: "db-edit" author: "Jan Regent" need: "view 1.0" ] ;--------------------------------------------------------------------------- -- ; db-lib ;--------------------------------------------------------------------------- -- find-data: func [key] [select database key] remove-data: func [key] [ remove/part find database key 2] ;=========================================================================== ======= db actions save-data: has [data] [ data: copy [] foreach [key obj] database [ append/only data third obj ] save db-file data ] save-data-formated: has [data][ save-data file: read db-file formated-db-file: to-file join db-file "-temp.dat" if exists? formated-db-file [delete formated-db-file] ;--------------------------------------------------------------- record parsing file: replace file "[[" "[" ;! I don't undestand why save-data saved record with "[[" file: replace file "]]" "]" ;! debuging needed while [true] [ parse file [thru "[" copy qrecord to "]" ] file: remove/part file length? qrecord if not found? find qrecord field-list/1 delete db-file qnew-file: split-path db-file rename formated-db-file qnew-file/2 return ] write/append/lines formated-db-file "[" ;------------------------------------------------------- field parsing for i 1 ((length? field-list) - 1) 1 [ i1: i + 1 field-label: field-list/:i field-label2: field-list/:i1 parse qrecord [thru field-label copy qfield to field-label2 ] write/append/lines formated-db-file join " " [field-label " " qfield] ] qfield: remove/part qrecord ((index? find qrecord field-label2) + length? field-label2) write/append/lines formated-db-file join " " [ field-label2 " " qfield] write/append/lines formated-db-file "]" ] ] load-data-template: {has [data] [ data: load/all db-file clear database foreach item data [ item: make record item repend database [item/x-x-key-x-x item] ] ] } load-data-gen: has [][ qitem: copy field-list/1 qitem: replace qitem ":" "" load-data-template: replace load-data-template "x-x-key-x-x" qitem load-data: do load-data-template ] db-create: func [ fields [string!]] [ qfile: split-path db-file if not exists? qfile/1 [ make-dir/deep qfile/1] ddf-file: to-file join db-file ".ddf" write/lines ddf-file "<field-list>" write/lines/append ddf-file join " " fields write/lines/append ddf-file "</field-list>" cmd: join "field-list: [" [ fields "]" ] debug-log cmd do cmd db-context-create insert-data-gen insert-data-new save-data-formated rec-count: 1 rec-count-save ] rec-count-save: has [] [ rec-count-file: to-file join db-file ".reccount" write/lines rec-count-file join "<rec-count> " [rec-count " </rec-count>" ] ] rec-count-read: has [] [ rec-count-file: to-file join db-file ".reccount" parse read rec-count-file [thru "<rec-count>" copy qrec-count to </rec-count> ] qrec-count: trim qrec-count rec-count: to-integer qrec-count ] db-open: has [][ ddf-file: to-file join db-file ".ddf" parse read ddf-file [thru "<field-list>" copy fields to "</field-list>" ] cmd: join "field-list: [" [ fields "]" ] debug-log cmd do cmd db-context-create insert-data-gen rec-count-read ] db-context-create: has [] [ cmd: "context [" foreach item field-list [cmd: join cmd [item " "]] cmd: join cmd " none ]" debug-log cmd record: do cmd ] ;=========================================================================== ==== record actions save-record: has [][ foreach item field-list [ qitem: replace to-string item ":" "" cmd: join "rec/" [item " to-string " qitem "/text"] debug-log cmd do cmd ] record-no: (2 * this-record) - 1 do join "database/" [record-no ": rec"] ] find-record-no: has [][ record-no: (2 * this-record) - 1 rec: find-data database/:record-no if not none? rec [ unview focus name view layout current-layout ] ] insert-data-gen: has [] [ qfunc: {insert-data: func [} foreach item field-list [ qitem: copy item qitem: replace qitem ":" "'" qfunc: join qfunc [qitem " "] ] append qfunc "]" append qfunc newline ;append qfunc { "Insert record into db-file, generated function, key is x-x-x"} ;qfunc: replace qfunc "x-x-x" field-list/1 append qfunc newline qfunc: join qfunc [ {[ repend database [ } replace copy field-list/1 ":" "'" { make record [ } ] foreach item field-list [ qitem: copy item qitem: replace qitem ":" "'" qfunc: join qfunc [" " item " " qitem newline] ] qfunc: join qfunc { ] ] ] } debug qfunc do qfunc ] insert-data-new: has [] [ cmd: "insert-data " foreach item field-list [ cmd: join cmd [{ "" }]] debug-log cmd do cmd ] ;======================================================================== view layouts/ actions gen-form: has [] [ simple-layout: copy [] append simple-layout join {[ h3 } [main-title ] append simple-layout { across ;----------------------------------------------------------------------- fields section } foreach item field-list [ qline: join " label " [{"} item {" 100x24 right } item { }] append simple-layout qline qitem: join "rec/" item qitem: replace qitem ":" "" curr-value: to-string do qitem qline: join {field 362 } [ qitem " return" ] append simple-layout qline append simple-layout newline ] append simple-layout { ;----------------------------------------------------------------------- control section arrow left keycode [up ] [ show-page "prev-record" ] arrow right keycode [down ] [ show-page "next-record" ] label "find: " 42x24 right web: field 362 " " return guide 125x100 button 100 "New" #"^n" [ show-page "new-record" ] button "Del" #"^d" [ ] ;show-page "del-record" button "Close" #"^q" [ save-record save-data-formated unview ] return ] } if exists? %db-edit.frm [ delete %db-edit.frm] write %db-edit.frm simple-layout ] show-page: func [arrow-key][ save-record if "prev-record" = arrow-key [ if this-record > 1 [ this-record: this-record - 1 find-record-no ] ] if "next-record" = arrow-key [ if this-record < rec-count [ this-record: this-record + 1 find-record-no ] ] if "new-record" = arrow-key [ insert-data-new rec-count: rec-count + 1 rec-count-save this-record: rec-count find-record-no ] if "del-record" = arrow-key [ remove-data to-word replace field-list/1 ":" "" rec-count: rec-count - 1 if rec-count = 0 [ rec-count: 1 insert-data-new ] rec-count-save if this-record > rec-count [this-record: rec-count] find-record-no ] ;print [arrow-key this-record ] ] ;=============================================================================================== ; main ;======================================================================= ======================== db-edit: func [db-name [file!] fields [string!] ] [ db-file: copy db-name if not exists? db-file [db-create fields ] db-open load-data-gen load-data rec: find-data database/1 main-title: join {"Data: } [ db-name {"} ] gen-form current-layout: load %db-edit.frm ;debug-log current-layout view layout current-layout ] debug-log: func [text ][ if debug [ write/append/lines %debug.txt "" write/append/lines %debug.txt "" write/append/lines %debug.txt "" write/append/lines %debug.txt to-string text ] ] ;----------------------------------------------------------- <global words> debug: true if debug [if exists? %debug.txt [delete %debug.txt]] record: context [] field-list: [] db-file: %contact-db.dat main-title: join {"} [ db-file {"} ] database: [] this-record: 1 rec-count: 0 rec: "" ;---------------------------------------------------------- </global words> ; examples - only one line can be unremarked ;1 db-edit %db\aa.dat {"email:" "name:" "phone:" "web1:" "web3:" } ;2 ;db-edit %db\cars.dat {"number:" "color:" "type:" "technical-checking:" year: } ;3 ;db-edit %db\users.dat {"email:" "name:" "phone:" "id:" "mobile:" } ;4 ;db-edit %db\main.cfg {"work-dir:" "backup-dir:" "created:" "rights:" } ;5 ;db-edit %db\web.cfg {"name:" "web:" "page:" "rights:" } -- Attached file included as plaintext by Listar -- -- File: db-edit.r rebol [ Title: "db-edit" author: "Jan Regent" need: "view 1.0" ] ;----------------------------------------------------------------------------- ; db-lib ;----------------------------------------------------------------------------- find-data: func [key] [select database key] remove-data: func [key] [ remove/part find database key 2] ;================================================================================== db actions save-data: has [data] [ data: copy [] foreach [key obj] database [ append/only data third obj ] save db-file data ] save-data-formated: has [data][ save-data file: read db-file formated-db-file: to-file join db-file "-temp.dat" if exists? formated-db-file [delete formated-db-file] ;--------------------------------------------------------------- record parsing file: replace file "[[" "[" ;! I don't undestand why save-data saved record with "[[" file: replace file "]]" "]" ;! debuging needed while [true] [ parse file [thru "[" copy qrecord to "]" ] file: remove/part file length? qrecord if not found? find qrecord field-list/1 [ delete db-file qnew-file: split-path db-file rename formated-db-file qnew-file/2 return ] write/append/lines formated-db-file "[" ;------------------------------------------------------- field parsing for i 1 ((length? field-list) - 1) 1 [ i1: i + 1 field-label: field-list/:i field-label2: field-list/:i1 parse qrecord [thru field-label copy qfield to field-label2 ] write/append/lines formated-db-file join " " [field-label " " qfield] ] qfield: remove/part qrecord ((index? find qrecord field-label2) + length? field-label2) write/append/lines formated-db-file join " " [ field-label2 " " qfield] write/append/lines formated-db-file "]" ] ] load-data-template: {has [data] [ data: load/all db-file clear database foreach item data [ item: make record item repend database [item/x-x-key-x-x item] ] ] } load-data-gen: has [][ qitem: copy field-list/1 qitem: replace qitem ":" "" load-data-template: replace load-data-template "x-x-key-x-x" qitem load-data: do load-data-template ] db-create: func [ fields [string!]] [ qfile: split-path db-file if not exists? qfile/1 [ make-dir/deep qfile/1] ddf-file: to-file join db-file ".ddf" write/lines ddf-file "<field-list>" write/lines/append ddf-file join " " fields write/lines/append ddf-file "</field-list>" cmd: join "field-list: [" [ fields "]" ] debug-log cmd do cmd db-context-create insert-data-gen insert-data-new save-data-formated rec-count: 1 rec-count-save ] rec-count-save: has [] [ rec-count-file: to-file join db-file ".reccount" write/lines rec-count-file join "<rec-count> " [rec-count " </rec-count>" ] ] rec-count-read: has [] [ rec-count-file: to-file join db-file ".reccount" parse read rec-count-file [thru "<rec-count>" copy qrec-count to "</rec-count>" ] qrec-count: trim qrec-count rec-count: to-integer qrec-count ] db-open: has [][ ddf-file: to-file join db-file ".ddf" parse read ddf-file [thru "<field-list>" copy fields to "</field-list>" ] cmd: join "field-list: [" [ fields "]" ] debug-log cmd do cmd db-context-create insert-data-gen rec-count-read ] db-context-create: has [] [ cmd: "context [" foreach item field-list [cmd: join cmd [item " "]] cmd: join cmd " none ]" debug-log cmd record: do cmd ] ;=============================================================================== record actions save-record: has [][ foreach item field-list [ qitem: replace to-string item ":" "" cmd: join "rec/" [item " to-string " qitem "/text"] debug-log cmd do cmd ] record-no: (2 * this-record) - 1 do join "database/" [record-no ": rec"] ] find-record-no: has [][ record-no: (2 * this-record) - 1 rec: find-data database/:record-no if not none? rec [ unview focus name view layout current-layout ] ] insert-data-gen: has [] [ qfunc: {insert-data: func [} foreach item field-list [ qitem: copy item qitem: replace qitem ":" "'" qfunc: join qfunc [qitem " "] ] append qfunc "]" append qfunc newline ;append qfunc { "Insert record into db-file, generated function, key is x-x-x"} ;qfunc: replace qfunc "x-x-x" field-list/1 append qfunc newline qfunc: join qfunc [ {[ repend database [ } replace copy field-list/1 ":" "'" { make record [ } ] foreach item field-list [ qitem: copy item qitem: replace qitem ":" "'" qfunc: join qfunc [" " item " " qitem newline] ] qfunc: join qfunc { ] ] ] } debug qfunc do qfunc ] insert-data-new: has [] [ cmd: "insert-data " foreach item field-list [ cmd: join cmd [{ "" }]] debug-log cmd do cmd ] ;======================================================================== view layouts/ actions gen-form: has [] [ simple-layout: copy [] append simple-layout join {[ h3 } [main-title ] append simple-layout { across ;----------------------------------------------------------------------- fields section } foreach item field-list [ qline: join " label " [{"} item {" 100x24 right } item { }] append simple-layout qline qitem: join "rec/" item qitem: replace qitem ":" "" curr-value: to-string do qitem qline: join {field 362 } [ qitem " return" ] append simple-layout qline append simple-layout newline ] append simple-layout { ;----------------------------------------------------------------------- control section arrow left keycode [up ] [ show-page "prev-record" ] arrow right keycode [down ] [ show-page "next-record" ] label "find: " 42x24 right web: field 362 " " return guide 125x100 button 100 "New" #"^n" [ show-page "new-record" ] button "Del" #"^d" [ ] ;show-page "del-record" button "Close" #"^q" [ save-record save-data-formated unview ] return ] } if exists? %db-edit.frm [ delete %db-edit.frm] write %db-edit.frm simple-layout ] show-page: func [arrow-key][ save-record if "prev-record" = arrow-key [ if this-record > 1 [ this-record: this-record - 1 find-record-no ] ] if "next-record" = arrow-key [ if this-record < rec-count [ this-record: this-record + 1 find-record-no ] ] if "new-record" = arrow-key [ insert-data-new rec-count: rec-count + 1 rec-count-save this-record: rec-count find-record-no ] if "del-record" = arrow-key [ remove-data to-word replace field-list/1 ":" "" rec-count: rec-count - 1 if rec-count = 0 [ rec-count: 1 insert-data-new ] rec-count-save if this-record > rec-count [this-record: rec-count] find-record-no ] ;print [arrow-key this-record ] ] ;=============================================================================================== ; main ;===================================================