(module plugin-counter mzscheme
        (require "hwikiplugin.scm")
        (provide register-plugin-counter
                 )

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; support class
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (def-class
         (this (entry _page _context _langs _ip))
         (supers)
         (private
          (define _tm (current-date))
          )
         (public
          (define (ip)      _ip)
          (define (page)    _page)
          (define (context) _context)
          (define (time)    _tm)
          (define (accepted-languages) (let ((fh (open-output-string)))
                                         (write _langs fh)
                                         (let ((S (get-output-string fh)))
                                           (close-output-port fh)
                                           S)))
          )
         (constructor)
         )

        (define (chan)
          (vector (make-semaphore 1)
                  (make-semaphore 0)
                  #f
                  #f
                  0
                  ))
        
        (define (chan+ c val)
          (semaphore-wait (vector-ref c 0))
          (debug "counter:chan+ 1")
          (if (eq? (vector-ref c 2) #f)
              (begin
                (vector-set! c 2 (vector val #f))
                (vector-set! c 3 (vector-ref c 2)))
              (begin
                (let ((nv (vector val #f)))
                  (vector-set! (vector-ref c 2) 1 nv)
                  (vector-set! c 2 nv))))
          (vector-set! c 4 (+ (vector-ref c 4) 1))
          (semaphore-post (vector-ref c 1))
          (debug "counter:chan+ 2")
          (semaphore-post (vector-ref c 0))
          (debug "counter:chan+ 3")
          )
        
        (define (chan- c)
          (debug "counter:chan- 1")
          ;(semaphore-wait (vector-ref c 1))
          (letrec ((f (lambda ()
                        (sleep 1)
                        (semaphore-wait (vector-ref c 0))
                        (let ((n (vector-ref c 4)))
                          (semaphore-post (vector-ref c 0))
                          (display (format "counter:n=~a~%" n))
                          (if (> n 0)
                              #t
                              (f))))))
            (f))
          (debug "counter:chan- 2")
          (semaphore-wait (vector-ref c 0))
          (let ((v (vector-ref c 3)))
            (if (eq? (vector-ref c 2) (vector-ref c 3))
                (begin
                  (vector-set! c 2 #f)
                  (vector-set! c 3 #f)
                  (vector-ref v 0))
                (begin
                  (vector-set! c 3 (vector-ref (vector-ref c 3) 1))))
            (vector-set! c 4 (- (vector-ref c 4) 1))
            (semaphore-post (vector-ref c 0))
            (debug "counter:chan- 3")
            (vector-ref v 0)))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; counter plugin
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (def-class
         (this (plugin:counter))
         (supers)
         (private

          (define create-tables
            (lambda ()
              (let ((sqli (sqli-provider)))
                (while (eq? sqli #f)
                       (begin
                         (debug "plugin:counter:waiting for sqli provider")
                         (sleep 5)
                         (set! sqli (sqli-provider))))
                (sqli-query sqli "create table access(page varchar,context varchar,ip varchar,accepted_languages varchar,time timestamp)")
                (sqli-query sqli "create table pages(page varchar,context varchar,count integer,primary key (page,context))")
                (sqli-closer sqli))))
              

          (define (inserter entry)
            (create-tables)
            (set! create-tables (lambda () #t))
            (debug "plugin:counter, next entry: " entry)
            (let ((sqli  (sqli-provider)))
              (if (eq? sqli #f)
                  (error "plugin:counter needs a database connection to work"))
              (hlog (format "sqli: after connect to database: ~a" (sqli-error-message sqli)))
              (debug "plugin:counter:begin of transaction")
              (sqli-begin sqli)
              (sqli-query sqli "insert into access(page,context,ip,accepted_languages,time) values($1,$2,$3,$4,$5)"
                          (-> entry page)
                          (-> entry context)
                          (-> entry ip)
                          (-> entry accepted-languages)
                          (-> entry time))
              (sqli-commit sqli)
              (debug "plugin:counter:select page-count in pages")
              (let ((c (begin
                         (sqli-query sqli "select count(*) from pages where page=$1 and context=$2"
                                     (-> entry page) (-> entry context))
                         (string->number (car (sqli-fetchrow sqli))))))
                (sqli-begin sqli)
                                (debug "plugin:counter:update pagecount for page")
                (if (= c 0)
                    (sqli-query sqli "insert into pages(page,context,count) values($1,$2,$3)" (-> entry page) (-> entry context) 1)
                    (sqli-query sqli "update pages set count=count+1 where page=$1 and context=$2" (-> entry page) (-> entry context)))
                (sqli-commit sqli)
                )
                              (debug "close sqli")
              (sqli-closer sqli)
              (debug "plugin:counter:end of transaction")
              ))

          (define (count page context)
            (let ((row (let ((_sqli (sqli-provider)))
                         (display (format "select pages~%"))
                         (sqli-begin _sqli)
                         (sqli-query _sqli "select count from pages where page=$1 and context=$2" page (-> context context))
                         (let ((R (sqli-fetchrow _sqli)))
                           (sqli-commit _sqli)
                           (sqli-closer _sqli)
                           R))))
              (if (eq? row #f)
                  0
                  (car row))))

          )
         (public
          
          (define (counter context)
            (debug "plugin:counter:adding entry to fifo of context " (-> context context))
            (thread (lambda () (inserter (entry (-> context page-name) 
                                                (-> context context)
                                                (-> context accepted-languages)
                                                (-> context from-ip)))))
            "")

          (define (display-counter context)
            (counter context)
            (let ((P    (page context))
                  (part (-> context current-part)))
              (let ((S (if (-> P has-contents? part)
                           (-> P contents part)
                           (_ "page hits: ~a"))))
                (format S (count (-> context page-name) context)))))

          )
         (constructor)
         )

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; counter plugin registration
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (define COUNTER (plugin:counter))
        
        (define (register-plugin-counter)
          (register-plugin 'plugin:counter (->> COUNTER counter))
          (register-plugin 'plugin:display-counter (->> COUNTER display-counter))
          )
        
        (register-plugin-counter)

        )