Changeset 15741 for lang/gauche

Timestamp:

07/13/08 15:53:11 (4 months ago)

Author:

kiyoka

Message:

Added plugin svn.scm.

Location:

lang/gauche/oldtype/trunk

Files:

• Kahua/oldtype/oldtype/svn.scm (modified) (4 diffs)
• Kahua/oldtype/plugins/oldtype.scm (modified) (1 diff)
• src/test.scm (modified) (2 diffs)

lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/svn.scm

@@ -38 +38 @@
   (use gauche.process)
   (export init
+          commit
+          status
+          get-fullpath
           <svn-work>
+          ))
 (select-module oldtype.svn)
 
@@ -65 +69 @@
 (define-method init ((self <svn-work>) session-id)
   (set! (path-of self) session-id)
+  ;; /bin/rm if already exist
+  (call-with-input-process
+   (format "/bin/rm -rf ~a" (get-fullpath self))
+   (lambda (p)
+     (display (port->string p))))
   ;; mkdir 
   (make-directory* (get-fullpath self))
   ;; checkout
-  (co self))
+  (_co self))
 
 
-(define-method co ((self <svn-work>))
+
+(define-method _co ((self <svn-work>))
   (call-with-input-process
    (format "cd ~a ; svn co --no-auth-cache --username ~a --password ~a ~a/edit"
@@ -78 +88 @@
            (url-of self))
    (lambda (p)
-     (display (port->string p)))))
+     (let1 str (port->string-list p)
+           (display (port->string p))
+           (last str)))))
 
 
 (define-method get-fullpath ((self <svn-work>))
   (string-append (basepath-of self) "/" (path-of self)))
+
+
+(define-method status ((self <svn-work>) wikiname)
+  (call-with-input-process
+   (format "cd ~a ; svn status --non-interactive --no-auth-cache --username ~a --password ~a edit/~a"
+           (get-fullpath self)
+           (user-of self) (pass-of self)
+           (string-append wikiname ".ot"))
+   (lambda (p)
+     (let1 str (port->string p)
+           (display str)
+           (if (string= "" str)
+               #f
+               (string-split str #/[ ]+/))))))
 
 
@@ -91 +117 @@
            (user-of self) (pass-of self))
    (lambda (p)
-     (display (port->string p)))))
-
+     (display (port->string p))))
+  #t)
 
 

lang/gauche/oldtype/trunk/Kahua/oldtype/plugins/oldtype.scm

@@ -18 +18 @@
 (allow-module oldtype.timeline)
 (allow-module oldtype.page)
+(allow-module oldtype.svn)
 (allow-module rfc.uri)

lang/gauche/oldtype/trunk/src/test.scm

@@ -13 +13 @@
 (use oldtype.page)
 (use oldtype.core)
+(use oldtype.svn)
 (use gauche.test)                                                     
 (use util.list)
@@ -168 +169 @@
       (test-end)
 
+      (test-start "svn commit")
+
+      (let1 work
+            (make <svn-work> :url "http://genkan.sumibi.org/svn/newtype" :user "anonymous" :pass "anonymous" :basepath "/Users/kiyoka/work/tmp")
+            
+            (test "Initialize svn work directory"
+                  #t
+                  (lambda ()
+                    (string? (init work "123"))))
+
+            (test "status of wikiname (no changes)"
+                  #f
+                  (lambda ()
+                    (status work "_kiyoka")))
+
+            (test "status of wikiname (some changes)"
+                  "M"
+                  (lambda ()
+                    (sys-system (format "echo 'a' >> ~a/~a/~a" (get-fullpath work) "edit" "_kiyoka.ot"))
+                    (car (status work "_kiyoka"))))
+
+            (when
+                #f
+              (test "commit from work"
+                    #t
+                    (lambda ()
+                      (commit work)))))
+
+      (test-end)
+      
       )))