commit 3e345ebd65cf58c73ed5164862b8a514211395f1 parent 3347572fd3f3f8a0cf4eae57d29b4706f293ae90 Author: Alexander Burger <abu@software-lab.de> Date: Fri, 12 Jul 2013 21:36:22 +0200 'snapshot' omit dot separator Diffstat:
| M | lib/too.l | | | 72 | ++++++++++++++++++++++++++++++++++++------------------------------------ |
1 file changed, 36 insertions(+), 36 deletions(-)
diff --git a/lib/too.l b/lib/too.l @@ -1,47 +1,47 @@ -# 02jul13abu +# 12jul13abu # (c) Software Lab. Alexander Burger ### Local Backup ### (de snapshot (Dst Max . @) (let I -1 - (while (info (pack Dst "." (inc 'I)))) + (while (info (pack Dst (inc 'I)))) (while (>= (dec 'I) Max) - (call 'rm "-rf" (pack Dst "." I)) ) + (call 'rm "-rf" (pack Dst I)) ) (while (ge0 I) - (call 'mv (pack Dst "." I) (pack Dst "." (inc I))) + (call 'mv (pack Dst I) (pack Dst (inc I))) (dec 'I) ) ) - (call 'mkdir (pack Dst ".0")) - (while (args) - (let - (Lst (filter bool (split (chop (next)) '/)) - Src (car Lst) - Old (pack Dst ".1/" Src) - New (pack Dst ".0/" Src) ) - (recur (Lst Src Old New) - (ifn (cdr Lst) - (recur (Src Old New) - (cond - ((=T (car (info Src T))) # Directory - (call 'mkdir "-p" New) - (for F (dir Src T) - (unless (member F '("." "..")) - (recurse - (pack Src '/ F) - (pack Old '/ F) - (pack New '/ F) ) ) ) - (call 'touch "-r" Src New) ) - ((= (info Src T) (info Old T)) # Same - `(if (== 64 64) - '(native "@" "link" 'I Old New) - '(call 'ln Old New) ) ) - (T (call 'cp "-a" Src New)) ) ) # Changed or new - (call 'mkdir "-p" New) - (recurse - (cdr Lst) - (pack Src '/ (cadr Lst)) - (pack Old '/ (cadr Lst)) - (pack New '/ (cadr Lst)) ) - (call 'touch "-r" Src New) ) ) ) ) ) + (when (call 'mkdir (pack Dst 0)) + (while (args) + (let + (Lst (filter bool (split (chop (next)) '/)) + Src (car Lst) + Old (pack Dst "1/" Src) + New (pack Dst "0/" Src) ) + (recur (Lst Src Old New) + (ifn (cdr Lst) + (recur (Src Old New) + (cond + ((=T (car (info Src T))) # Directory + (call 'mkdir "-p" New) + (for F (dir Src T) + (unless (member F '("." "..")) + (recurse + (pack Src '/ F) + (pack Old '/ F) + (pack New '/ F) ) ) ) + (call 'touch "-r" Src New) ) + ((= (info Src T) (info Old T)) # Same + `(if (== 64 64) + '(native "@" "link" 'I Old New) + '(call 'ln Old New) ) ) + (T (call 'cp "-a" Src New)) ) ) # Changed or new + (call 'mkdir "-p" New) + (recurse + (cdr Lst) + (pack Src '/ (cadr Lst)) + (pack Old '/ (cadr Lst)) + (pack New '/ (cadr Lst)) ) + (call 'touch "-r" Src New) ) ) ) ) ) ) ### DB Garbage Collection ### (de dbgc ()