Changeset 18852 in project


Ignore:
Timestamp:
07/17/10 07:50:30 (10 years ago)
Author:
Moritz Heidkamp
Message:

vandusen: run commands in separate thread (todo: add thread pool so as not to be flooded)

Location:
release/4/vandusen/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/vandusen/trunk/vandusen-control.scm

    r18788 r18852  
    99                   `(: "join" (+ space) (submatch (+ any)))
    1010                   (lambda (m channel)
    11                      (irc:join connection channel)
     11                     (call-with-connection (cut irc:join <> channel))
    1212                     #t))
    1313
     
    1515                   `(: "leave" (+ space) (submatch (+ any)))
    1616                   (lambda (m channel)
    17                      (irc:leave connection channel)
     17                     (call-with-connection (cut irc:leave <> channel))
    1818                     #t))))
    1919
  • release/4/vandusen/trunk/vandusen.scm

    r18788 r18852  
    44 debug
    55 config
    6  connection
     6 call-with-connection
    77 start
    88 command
     
    1616(require-extension regex)
    1717(import irregex)
    18 (use irc posix)
     18(use irc posix srfi-18)
    1919
    2020(include "irc-helpers")
     
    4646
    4747(define connection #f)
     48(define connection-mutex (make-mutex))
     49
     50(define (call-with-connection proc)
     51  (dynamic-wind
     52      (lambda ()
     53        (mutex-lock! connection-mutex))
     54      (cut proc connection)
     55      (lambda ()
     56        (mutex-unlock! connection-mutex))))
    4857
    4958(define (start config-file)
     
    5463  (irc:connect connection)
    5564 
    56   (for-each (lambda (channel)
    57               (print (format "joining ~A" channel))
    58               (irc:join connection channel)) ($ 'channels))
     65  (call-with-connection
     66      (lambda (c)
     67        (for-each (lambda (channel)
     68                    (print (format "joining ~A" channel))
     69                    (irc:join c channel)) ($ 'channels))))
    5970 
    6071  (let loop ()
    6172    (condition-case (irc:run-message-loop connection debug: ($ 'debug))
    62                     (ex (i/o net)
    63                         (irc:disconnect connection)
    64                         (print-error-message ex (current-error-port))
    65                         (print "reconnecting ...")
    66                         (irc:connect connection)
    67                         (loop)))))
     73        (ex (i/o net)
     74            (irc:disconnect connection)
     75            (print-error-message ex (current-error-port))
     76            (print "reconnecting ...")
     77            (irc:connect connection)
     78            (loop)))))
    6879
    6980
     
    8899
    89100(define (reply-to message text #!key (method irc:say) (prefixed (eq? irc:say method)))
    90   (irc:reply connection message text method prefixed))
     101  (call-with-connection (cut irc:reply <> message text method prefixed)))
    91102
    92 (define say (cut irc:say connection <...>))
     103(define (say . args)
     104  (cut call-with-connection
     105       (lambda (c)
     106         (apply irc:say (cons c args)))))
    93107
    94108(define (match-body matcher)
     
    107121        (let ((matches (irregex-search matcher (irc:message-body m))))
    108122          (if (or public (member (car (irc:message-prefix m)) ($ 'operators)))
    109               (apply handler (cons m (irregex-match-all-submatches matches matcher)))
     123              (thread-start!
     124               (lambda ()
     125                 (apply handler (cons m (irregex-match-all-submatches matches matcher)))))
    110126              (reply-to m "sorry, you are not allowed to do this"))))))
    111127
  • release/4/vandusen/trunk/vandusen.setup

    r18788 r18852  
    1 (compile -s -O2 -d1 vandusen.scm -j vandusen)
    2 (compile -s -O2 -d0 vandusen.import.scm)
    3 (compile -s -O2 -d1 vandusen-doc.scm -j vandusen-doc)
    4 (compile -s -O2 -d0 vandusen-doc.import.scm)
    5 (compile -s -O2 -d1 vandusen-eval.scm -j vandusen-eval)
    6 (compile -s -O2 -d0 vandusen-eval.import.scm)
    7 (compile -s -O2 -d1 vandusen-remote.scm -j vandusen-remote)
    8 (compile -s -O2 -d0 vandusen-remote.import.scm)
    9 (compile -s -O2 -d1 vandusen-random-talk.scm -j vandusen-random-talk)
    10 (compile -s -O2 -d0 vandusen-random-talk.import.scm)
    11 (compile -s -O2 -d1 vandusen-poll.scm -j vandusen-poll)
    12 (compile -s -O2 -d0 vandusen-poll.import.scm)
    13 (compile -s -O2 -d1 vandusen-control.scm -j vandusen-control)
    14 (compile -s -O2 -d0 vandusen-control.import.scm)
    15 (compile -o vandusen -O2 -d1 vandusen-cmd.scm)
     1(define version (call-with-input-file "VERSION" read-line))
    162
    17 (install-extension
    18  'vandusen
    19  '("vandusen.so"
    20    "vandusen.import.so"
    21    "vandusen-doc.so"
    22    "vandusen-doc.import.so"
    23    "vandusen-eval.so"
    24    "vandusen-eval.import.so"   
    25    "vandusen-remote.so"
    26    "vandusen-remote.import.so"
    27    "vandusen-random-talk.so"
    28    "vandusen-random-talk.import.so"
    29    "vandusen-poll.scm"
    30    "vandusen-poll.import.so"
    31    "vandusen-control.scm"
    32    "vandusen-control.import.so")
    33  `((version 0.2)))
     3;; these macros are stolen from hato
    344
    35 (install-program
    36  'vandusen-cmd
    37  '("vandusen")
    38  `((version 0.1)))
     5(define-syntax compile-module
     6  (er-macro-transformer
     7   (lambda (expr rename compare)
     8     (let* ((module (cadr expr))
     9            (mod-str (symbol->string module))
     10            (mod-src (string-append mod-str ".scm"))
     11            (mod-import (string-append mod-str ".import.scm"))
     12            (mod-so (string-append mod-str ".so"))
     13            (mod-import-so (string-append mod-str ".import.so"))
     14            (_begin (rename 'begin))
     15            (_make (rename 'make))
     16            (_compile (rename 'compile))
     17            (_install-extension (rename 'install-extension)))
     18       `(,_make ((,mod-so (,mod-src)
     19                          (,_begin
     20                           (,_compile -s -O2 -j ,module ,mod-src)
     21                           (,_compile -s -O2 ,mod-import)
     22                           (,_install-extension
     23                            ',module
     24                            '(,mod-so ,mod-import-so)
     25                            '((version ,version)))))))))))
     26
     27(define-syntax compile-executable
     28  (er-macro-transformer
     29   (lambda (expr rename compare)
     30     (let* ((executable (cadr expr))
     31            (exec-str (symbol->string (caddr expr)))
     32            (exec-src (string-append (symbol->string (cadr expr)) ".scm"))
     33            (_begin (rename 'begin))
     34            (_make (rename 'make))
     35            (_compile (rename 'compile))
     36            (_install-program (rename 'install-program)))
     37       `(,_make ((,exec-str (,exec-src)
     38                            (,_begin
     39                             (,_compile -O2 -d2 ,exec-src)
     40                             (,_install-program
     41                              ',executable
     42                              '(,exec-str)
     43                              '((version ,version)))))))))))
     44
     45
     46(compile-module vandusen)
     47(compile-module vandusen-doc)
     48(compile-module vandusen-eval)
     49(compile-module vandusen-remote)
     50(compile-module vandusen-random-talk)
     51(compile-module vandusen-poll)
     52(compile-module vandusen-control)
     53(compile-executable vandusen-cmd vandusen)
Note: See TracChangeset for help on using the changeset viewer.