Changeset 37174 for lang/gauche

Show
Ignore:
Timestamp:
04/09/10 21:12:49 (4 years ago)
Author:
kiyoka
Message:

Added spam rejecting feature.

Location:
lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype
Files:
2 modified

Legend:

Unmodified
Added
Removed
  • lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/util.kahua

    r31444 r37174  
    337337              (entry-lambda (:keyword name comment) 
    338338                (let1 nodes  
    339                       (p/ 
    340                        (oldtype:icon-image 'face-surprise) 
    341                        "Error: commit action failed.") 
    342                       (if (or (> 1 (string-length name)) 
     339                    (p/ 
     340                     (oldtype:icon-image 'face-surprise) 
     341                     "Error: commit action failed.") 
     342                  (if (oldtype:comment-is-spam? comment) 
     343                      #?=(format #f "spam rejected [~a] [~a]" name comment) 
     344                      (if (or (> 1 (string-length #?=name)) 
    343345                              (> 1 (string-length comment))) 
    344346                          (set! nodes (p/ 
     
    350352                                       :pass     (oldtype:get-arguments 'anon-pass) 
    351353                                       :basepath (oldtype:workpath)) 
    352                                 (init work (string-append 
    353                                             (number->string (sys-time)) 
    354                                             "." 
    355                                             (number->string (random-integer 100)))) 
    356                                 (save-text-list work (name-of oldtype-page) 
    357                                                 (oldtype:add-comment oldtype-page name comment)) 
    358                                 (let1 result (status work (name-of oldtype-page)) 
    359                                       (when (string=? "M" (car result)) 
    360                                         (begin 
    361                                           (commit work) 
    362                                           (clean work) 
    363                                           (set! nodes 
    364                                                 (p/ 
    365                                                  (oldtype:icon-image 'face-ok) 
    366                                                  "Thank you! Your comment was registered. Please wait 3 minutes and back."))))))) 
    367                       (standard-page 
    368                        (name-of oldtype-page) 
    369                        (br/) 
    370                        (div/ 
    371                         nodes 
    372                         (p/ "Back to " (oldtype:expand-wiki-name (name-of oldtype-page)))) 
    373                        "" 
    374                        '() 
    375                        1))))) 
     354                            (init work (string-append 
     355                                        (number->string (sys-time)) 
     356                                        "." 
     357                                        (number->string (random-integer 100)))) 
     358                            (save-text-list work (name-of oldtype-page) 
     359                                            (oldtype:add-comment oldtype-page name comment)) 
     360                            (let1 result (status work (name-of oldtype-page)) 
     361                              (when (string=? "M" (car result)) 
     362                                (begin 
     363                                  (commit work) 
     364                                  (clean work) 
     365                                  (set! nodes 
     366                                        (p/ 
     367                                         (oldtype:icon-image 'face-ok) 
     368                                         "Thank you! Your comment was registered. Please wait 3 minutes and back.")))))))) 
     369                  (standard-page 
     370                   (name-of oldtype-page) 
     371                   (br/) 
     372                   (div/ 
     373                    nodes 
     374                    (p/ "Back to " (oldtype:expand-wiki-name (name-of oldtype-page)))) 
     375                   "" 
     376                   '() 
     377                   1))))) 
    376378        (table/ (@/ (class "comment")) 
    377379                (tr/ (th/ 
  • lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/util.scm

    r28220 r37174  
    6262          oldtype:youtube-link 
    6363          oldtype:youtube-thumbnail 
     64          oldtype:comment-is-spam? 
    6465          pretty-print-sexp)) 
    6566(select-module oldtype.util) 
     
    360361  (format #f "http://img.youtube.com/vi/~a/1.jpg" video-id)) 
    361362                                    
     363;;================================================= 
     364;; Utility for Spam 
     365;; 
     366(define (oldtype:comment-is-spam? comment) 
     367  (#/[<][aA][ ]+[hH][rR][eE][fF]/ comment)) 
     368 
    362369 
    363370(provide "oldtype/util")