plugin-counter.scm
(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)
         )

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; counter plugin
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (def-class
         (this (plugin:counter))
         (supers)
         (private
          (define _fifos     (make-hash-table 'equal))
          (define _sqlis     (make-hash-table 'equal))
          (define _inserters (make-hash-table 'equal))

          (define (create-context context)
            ;(display (format "create-context:~s~%"  context))
            (let ((FIFO (hash-table-get _fifos (-> context context)
                                        (lambda ()
                                          ;(display (format "plugin:counter:creating context ~a~%" (-> context context)))
                                          (hash-table-put! _fifos (-> context context) (fifo))
                                          (let ((sqli (sqli-provider)))
                                            (if (eq? sqli #f)
                                                (error "plugin:counter needs a database connection to work")
                                                (begin
                                                  (hlog (format "sqli: after connect to database: ~a" (sqli-error-message sqli)))
                                                  (hash-table-put! _sqlis (-> context context) sqli)
                                                  (hash-table-put! _inserters (-> context context) (thread (lambda () (inserter context))))
                                                  (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))")
                                                  )))))))
              #t))

          (define (get-sqli context)
            (create-context context)
            (hash-table-get _sqlis (-> context context)))

          (define (get-fifo context)
            (create-context context)
            (hash-table-get _fifos (-> context context)))

          (define (get-inserter context)
            (create-context context)
            (hash-table-get _inserters (-> context context)))

          (define (inserter context)
            (let ((sqli (sqli-provider))
                  (FIFO (get-fifo context)))
              (if (eq? sqli #f)
                  (error "plugin:counter needs a database connection to work")
                  (begin
                    (hlog (format "sqli: after connect to database: ~a" (sqli-error-message sqli)))
                    (letrec ((f (lambda ()
                                  (let ((entry (fifo- FIFO)))
                                    (display (format "begin~%"))
                                    (sqli-begin sqli)
                                    (display (format "insert access~%"))
                                    (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))
                                    (let ((c (begin
                                               (display (format "count pages~%"))
                                               (sqli-query sqli "select count(*) from pages where page=$1 and context=$2"
                                                           (-> entry page) (-> entry context))
                                               (string->number (car (sqli-fetchrow sqli))))))
                                      (display (format "insert or update pages~%"))
                                      (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)))
                                      (display (format "commit pages~%"))
                                      (sqli-commit sqli)))
                                  (f))))
                      (f))))))

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

          )
         (public
          (define (counter context)
            (fifo+ (get-fifo context) 
                   (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 #f)
        
        (define (register-plugin-counter)
          (if (eq? COUNTER #f)
              (set! COUNTER (plugin:counter)))
          (register-plugin 'plugin:counter (->> COUNTER counter))
          (register-plugin 'plugin:display-counter (->> COUNTER display-counter)))

        )