Changeset 4802 in project


Ignore:
Timestamp:
07/01/07 17:53:29 (13 years ago)
Author:
arto
Message:

php-s11n: Minor refactoring of egg in preparation for release.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • php-s11n/trunk/php-s11n.scm

    r4771 r4802  
    2828    (export php-serialize
    2929            php-unserialize
     30            php-s11n-writer
     31            php-s11n-reader
     32            php-s11n-array-reader
     33            php-s11n-object-reader
     34            php-s11n-write
    3035            php-s11n-read
    31             php-s11n-write)))
     36            php-s11n-read-null
     37            php-s11n-read-boolean
     38            php-s11n-read-integer
     39            php-s11n-read-float
     40            php-s11n-read-string
     41            php-s11n-read-array
     42            php-s11n-read-array/alist
     43            php-s11n-read-array/hash-table
     44            php-s11n-read-object)))
     45
     46;;;; Exported parameters
     47
     48(define php-s11n-writer        (make-parameter #f))
     49(define php-s11n-reader        (make-parameter #f))
     50(define php-s11n-array-reader  (make-parameter #f))
     51(define php-s11n-object-reader (make-parameter #f))
     52
     53;;;; Internal parameters
     54
     55(define php-s11n-read-table    (make-parameter '()))
    3256
    3357;;;; Exported procedures
    3458
    35 ;;; See http://php.net/manual/en/function.serialize.php
     59;; See http://php.net/manual/en/function.serialize.php
    3660(define (php-serialize value)
    3761  (with-output-to-string (lambda () (php-s11n-write value))))
    3862
    39 ;;; See http://php.net/manual/en/function.unserialize.php
     63;; See http://php.net/manual/en/function.unserialize.php
    4064(define (php-unserialize string)
    4165  (call-with-input-string string php-s11n-read))
     66
     67;;; Output
    4268
    4369(define (php-s11n-write value #!optional (port (current-output-port)))
     
    5076        ((and (number? value) (inexact? value)) ; => float
    5177         (fprintf port "d:~A;" value))
     78        ((char? value) ; => string
     79         (php-s11n-write (string value) port))
     80        ((symbol? value) ; => string
     81         (php-s11n-write (symbol->string value) port))
    5282        ((string? value) ; => string
    5383         (fprintf port "s:~A:~S;" (string-length value) value))
    54         ((symbol? value) ; => string
    55          (php-s11n-write (symbol->string value) port))
    56         ((char? value) ; => string
    57          (php-s11n-write (string value) port))
    5884        ((vector? value) ; => array
    5985         (fprintf port "a:~A:{" (vector-length value))
     
    6793         (fprintf port "a:~A:{" (length value))
    6894         (for-each (lambda (e)
    69                      (php-s11n-write (car e) port)
     95                     (php-s11n-write (->array-key (car e)) port)
    7096                     (php-s11n-write (cdr e) port))
    7197                   value)
    7298         (fprintf port "}"))
    73         ((kvlist? value) ; => associative array
    74          (fprintf port "a:~A:{" (/ (length value) 2))
    75          (for-each (lambda (e)
    76                      (php-s11n-write (keyword->string (first e)) port)
    77                      (php-s11n-write (second e) port))
    78                    (chop value 2))
    79          (fprintf port "}"))
    8099        ((hash-table? value) ; => associative array
    81100         (php-s11n-write (hash-table->alist value) port))
    82         #;((procedure? serializer) (serializer value port))
     101        ((procedure? (php-s11n-writer))
     102         ((php-s11n-writer) value port))
    83103        (else (error 'php-s11n-write "unable to serialize object" value))))
     104
     105;;; Input
    84106
    85107(define (php-s11n-read #!optional (port (current-input-port)))
    86108  (let ((char (peek-char port)))
    87     (cond ((assq char php-s11n-readers) => (lambda (e) ((cdr e) port)))
    88           ((eof-object? char) (error 'php-s11n-read "unexpected end of input" port))
    89           (else (error 'php-s11n-read "invalid type specifier" char)))))
    90 
    91 ;;;; Internal procedures
     109    (cond ((eof-object? char) (error 'php-s11n-read "unexpected end of input" port))
     110          ((assq char (php-s11n-read-table)) => (lambda (e) ((cdr e) port)))
     111          ((procedure? (php-s11n-reader)) ((php-s11n-reader) port))
     112          (else (error 'php-s11n-read "unable to unserialize object of type" char)))))
    92113
    93114(define (php-s11n-read-null port)
     
    99120
    100121(define (php-s11n-read-integer port)
    101   (string->number (expect port "i:" #/[+\-\d]+/ ";")))
     122  (string->number (expect port "i:" #/[+\-\de]+/i ";")))
    102123
    103124(define (php-s11n-read-float port)
    104   (string->number (expect port "d:" #/[+\-\d\.]+/ ";")))
     125  (string->number (expect port "d:" #/[+\-\d\.e]i+/ ";")))
    105126
    106127(define (php-s11n-read-string port)
     
    130151                      values))))))
    131152
     153(define (php-s11n-read-array/hash-table port)
     154  (alist->hash-table (php-s11n-read-array/alist port)))
     155
    132156(define (php-s11n-read-object port)
    133   (error 'php-s11n-read "object unserialization not implemented yet"))
    134 
    135 (define php-s11n-readers
    136   `((#\N . ,php-s11n-read-null)
    137     (#\b . ,php-s11n-read-boolean)
    138     (#\i . ,php-s11n-read-integer)
    139     (#\d . ,php-s11n-read-float)
    140     (#\s . ,php-s11n-read-string)
    141     (#\a . ,php-s11n-read-array)
    142     (#\O . ,php-s11n-read-object)))
    143 
    144 ;;;; Lexer helper procedures
     157  (error 'php-s11n-read "object unserialization not supported"))
     158
     159;;;; Initialization
     160
     161(begin
     162  (php-s11n-array-reader php-s11n-read-array)
     163  (php-s11n-object-reader php-s11n-read-object)
     164  (php-s11n-read-table
     165    `((#\N . ,php-s11n-read-null)
     166      (#\b . ,php-s11n-read-boolean)
     167      (#\i . ,php-s11n-read-integer)
     168      (#\d . ,php-s11n-read-float)
     169      (#\s . ,php-s11n-read-string)
     170      (#\a . ,(lambda (port) ((php-s11n-array-reader) port)))
     171      (#\O . ,(lambda (port) ((php-s11n-object-reader) port))))))
     172
     173;;;; Internal procedures
     174
     175;;; Lexer implementation
    145176
    146177(define (expect-char port char)
     
    169200    value))
    170201
    171 ;;;; General helper procedures
    172 
    173 (define (vector-like-array? array)
    174   (let ((count (length array))
    175         (keys  (map car array)))
    176     (and (every integer? keys)
    177          (equal? (iota count) keys))))
     202;;; General helpers
    178203
    179204(define (void? x) (eq? x (void)))
     
    183208       (every pair? x)))
    184209
    185 (define (kvlist? x)
    186   (and (proper-list? x)
    187        (zero? (modulo (length x) 2))
    188        (every (lambda (e) (keyword? (car e)))
    189               (chop x 2))))
     210(define (integer-like-string? x)
     211  (and (string? x)
     212       (string-match #/^[1-9][0-9]*$/ x)))
     213
     214(define (vector-like-array? x)
     215  (let ((keys (map car x)))
     216    (and (every integer? keys)
     217         (equal? (iota (length x)) keys))))
     218
     219(define (->array-key value)
     220  (cond ((integer? value) value)
     221        ((integer-like-string? value) (string->number value))
     222        ((string? value) value)
     223        ((flonum? value) (inexact->exact (floor value)))
     224        ((boolean? value) (if value 1 0))
     225        ((keyword? value) (->array-key (keyword->string value)))
     226        ((symbol? value) (->array-key (symbol->string value)))
     227        (else (->array-key (->string value)))))
Note: See TracChangeset for help on using the changeset viewer.