Changeset 4754 in project


Ignore:
Timestamp:
06/29/07 00:39:07 (13 years ago)
Author:
Alaric Snell-Pym
Message:

Clustered writes now work.

Next step: reads!

File:
1 edited

Legend:

Unmodified
Added
Removed
  • memcached/trunk/memcached.scm

    r4669 r4754  
    2626(require-extension regex) ;Regular expressions
    2727
     28;;;; A small internal interface for connecting to a single memcached server
     29;; At this level, keys are always strings
     30
    2831;; Time delay before reconnecting to a down memcached server
    2932(define *reconnect-time* 10)
    30 
    31 ;; A few utility functions to massage input data into canonical forms
    32 
    33 ;; Keys may be in one of two forms: a string, in which case we compute
    34 ;; a hash ourselves, or (<int> <string>), in which case we use the int
    35 ;; as the hash.
    36 
    37 (define (key-hash k)
    38         (cond
    39                 ((pair? k) (car k))
    40                 ((string? k) (u8vector-hash k))
    41                 (else
    42                 (error "Keys must either by strings, or lists with an integer as the first element and a string as the second element"))))
    43 
    44 (define (key-key k)
    45         (cond
    46                 ((pair? k) (cadr k))
    47                 ((string? k) k)
    48                 (else
    49                 (error "Keys must either by strings, or lists with an integer as the first element and a string as the second element"))))
    50 
    51 ;;;; A small internal interface for connecting to a single memcached server
    52 ;; At this level, keys are always strings
    5333
    5434(define-record-type memcache-server
     
    321301;; 3) When a server is down, we don't care - just /dev/null any object stored
    322302;;    there and return nil for any gets. I think that's the best approach.
     303
     304
     305;; A few utility functions to massage input data into canonical forms
     306
     307;; Keys may be in one of two forms: a string, in which case we compute
     308;; a hash ourselves, or (<int> <string>), in which case we use the int
     309;; as the hash.
     310
     311(define (key-hash k)
     312        (cond
     313                ((pair? k) (car k))
     314                ((string? k) (string-hash k))
     315                (else
     316                (error "Keys must either by strings, or lists with an integer as the first element and a string as the second element"))))
     317
     318(define (key-key k)
     319        (cond
     320                ((pair? k) (cadr k))
     321                ((string? k) k)
     322                (else
     323                (error "Keys must either by strings, or lists with an integer as the first element and a string as the second element"))))
     324
     325;; A cluster of servers
     326
     327(define-record-type memcache-cluster
     328        (make-memcache-cluster servers buckets)
     329        memcache-cluster?
     330        (servers get-servers) ; vector of memcache-servers
     331        (buckets get-buckets)) ; vector of memcache-servers, duplicated by weight
     332
     333;; Given a list of server objects, and the serverspec used to create them
     334;; return a list with each server duplicated as many times as the weighting for
     335;; that server in the spec requests
     336(define (assign-buckets servers serverspec)
     337        (if (null? serverspec)
     338                '()
     339                (if (= (third (car serverspec)) 0)
     340                        (assign-buckets (cdr servers) (cdr serverspec))
     341                        (cons (car servers)
     342                                (assign-buckets servers
     343                                        (cons
     344                                                (list (first (car serverspec)) (second (car serverspec)) (- (third (car serverspec)) 1))
     345                                                (cdr serverspec)))))))
     346
     347;;  (assign-buckets '(a b c) '(("a" 1 1) ("b" 1 0) ("c" 1 10)))
     348;; => (a c c c c c c c c c c)
     349
     350;; Argument is list of servers, each represented as a hostname/port/weight list
     351;; eg, '(("server1" 11211 1) ("server2" 11211 1) ("server3" 11211 2))
     352(define (memcache-connect serverspec)
     353        (let ((servers (map
     354                (lambda (server) (single-memcache-connect (first server) (second server)))
     355                serverspec)))
     356        (make-memcache-cluster (list->vector servers) (list->vector (assign-buckets servers serverspec)))))
     357
     358;; (define mcc (memcache-connect '(("localhost" 11211 1) ("localhost" 11212 1))))
     359
     360(define (memcache-disconnect mcc)
     361        (for-each (single-memcache-disconnect) (vector->list (get-servers mcc))))
     362       
     363;; Decide which server a given key lives on
     364(define (which-server mcc key)
     365        (vector-ref (get-buckets mcc)
     366                (modulo (key-hash key) (vector-length (get-buckets mcc)))))
     367
     368;; Do something on each key. The work horse function.
     369;; The 'keys' is actually a list of pairs, with the key as the car.
     370;; and anything else as the cdr.
     371;; Returns a list of the form:
     372;; '((server . (key key key))
     373;;   (server . (key key key)))
     374;; Eg, it assigns each key to a server.
     375(define (group-by-servers mcc keys)
     376        (define ht (make-hash-table))
     377        (define (group-helper keys)
     378                (if (not (null? keys))
     379                        (begin
     380                                (let ((server (which-server mcc (caar keys))))
     381                                        (if (hash-table-exists? ht server)
     382                                                (set! (hash-table-ref ht server)
     383                                                        (cons (car keys) (hash-table-ref ht server)))
     384                                                (set! (hash-table-ref ht server)
     385                                                        (list (car keys)))))
     386                                (group-helper (cdr keys)))))
     387
     388        (group-helper keys)
     389        (hash-table->alist ht))
     390
     391;; operation is "set" "add" or "replace"
     392;; data is a list of (key flags exptime value) entries
     393(define (memcache-store! operation mcc data)
     394        (let ((groups (group-by-servers mcc data)))
     395                ;; groups is now an alist from servers to lists of entries
     396                (map (lambda (server-ops)
     397                        (let ((server (car server-ops))
     398                              (ops (cdr server-ops)))
     399                                (for-each (lambda (entry)
     400                                        (single-memcache-storage! operation server
     401                                                (first entry) ;key
     402                                                (second entry) ;flags
     403                                                (third entry) ;exptime
     404                                                (fourth entry))) ;value
     405                                        ops)))
     406                        groups)))
     407
     408(define (memcache-set*! mcc data)
     409        (memcache-store! "set" mcc data))
     410
     411(define (memcache-add*! mcc data)
     412        (memcache-store! "add" mcc data))
     413
     414(define (memcache-replace*! mcc data)
     415        (memcache-store! "replace" mcc data))
     416
     417(define (memcache-set! mcc key flags exptime value)
     418        (memcache-set*! mcc (list (list key flags exptime value))))
     419
     420(define (memcache-add! mcc key flags exptime value)
     421        (memcache-add*! mcc (list (list key flags exptime value))))
     422
     423(define (memcache-replace! mcc key flags exptime value)
     424        (memcache-replace*! mcc (list (list key flags exptime value))))
     425
     426        ;memcache-get memcache-get*
     427        ;memcache-incr! memcache-decr!
     428        ;memcache-delete! memcache-delete*!
     429        ;memcache-flush!))
Note: See TracChangeset for help on using the changeset viewer.