db32-64.l (2597B)
1 # 10nov11abu 2 # (c) Software Lab. Alexander Burger 3 4 ## 1. On the 32-bit system: 5 ## $ pil app/main.l @lib/db32-64.l 6 ## : (export64 "db/app/" *Dbs *Blob) 7 ## : (bye) 8 ## 9 ## 2. Transfer the resulting file "~/.pil/db64.tgz" to the 64-bit system, 10 ## and unpack it in the application's runtime directory 11 ## 12 ## 3. On the 64-bit system: 13 ## $ pil app/main.l @lib/too.l @lib/db32-64.l 14 ## : (pool "db/app/" *Dbs) 15 ## : (import32) 16 ## : (bye) 17 18 # 64-bit DB export -> "~/.pil/db64.tgz" 19 (de export64 (Pool Dbs Blob) 20 (if Blob 21 (call 'tar "cfz" (tmp "db32.tgz") Pool Blob) 22 (call 'tar "cfz" (tmp "db32.tgz") Pool) ) 23 (chdir (tmp) 24 (call 'tar "xfz" "db32.tgz") 25 (pool Pool Dbs) 26 (for (F . @) (or Dbs (2)) 27 (for (S (seq F) S (seq S)) 28 (touch S) 29 (at (0 . 10000) (commit T)) ) ) 30 (commit T) 31 (pool) 32 (for (F . @) Dbs 33 (call 'mv 34 (pack Pool F) 35 (pack Pool (hax (dec F))) ) ) 36 (ifn Blob 37 (call 'tar "cvfz" "../../db64.tgz" Pool) 38 (call 'mv Blob ".blob/") 39 (call 'mkdir "-p" Blob) 40 (use (@S @R Src) 41 (let Pat '`(conc (chop ".blob/") '(@S "." @R)) 42 (in (list 'find ".blob/" "-type" "f") 43 (while (setq Src (line)) 44 (when (match Pat Src) 45 (let 46 (L (split (replace @S "/") "-") 47 Dbf 48 (when (cdr L) 49 (pack 50 (hax (dec (fmt64 (pack (pop 'L))))) 51 "/" ) ) 52 Id 53 (chop (oct (fmt64 (pack (car L))))) 54 Dst 55 (pack 56 Blob 57 Dbf 58 (car Id) 59 (flip 60 (mapcan list 61 (flip (cdr Id)) 62 '(NIL NIL "/" .) ) ) 63 "." 64 @R ) ) 65 (when (dirname Dst) 66 (call 'mkdir "-p" @) ) 67 (call 'mv Src Dst) ) ) ) ) ) ) 68 (call 'tar "cvfz" "../../db64.tgz" Pool Blob) ) ) ) 69 70 # 32-bit -> 64-bit DB import 71 (de import32 () 72 (dbMap NIL 73 '((Base Root Var Cls Hook) 74 (rebuild NIL Var Cls Hook) ) ) ) 75 76 # vi:et:ts=3:sw=3