From 536fe1394ceb1ebaae2568de003dcb94fd76d617 Mon Sep 17 00:00:00 2001 From: interp Date: Sun, 9 Mar 2003 18:37:38 +0000 Subject: [PATCH] no changes (internal restructuring using COMPOUND-INTERFACE) --- scheme/httpd/surflets/packages.scm | 587 +++++++++++++++-------------- 1 file changed, 311 insertions(+), 276 deletions(-) diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index 33de184..5d415c1 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -1,8 +1,209 @@ ;; Structures and interfaces for surflets. -;; NOTE: SSAX/lib/packages.scm must be loaded before you can use this -;; downloadable from http://sourceforge.net/project/showfiles.php?group_id=30687 -;; (take the r5rs compliant version (ssax-sr5rs-plt200-4.9.tar.gz)) +;;; Copyright 2002, 2003 Andreas Bernauer +;;; Copyright 2002 Martin Gasbichler + +;;; NOTE: SSAX/lib/packages.scm must be loaded before you can use this +;;; downloadable from +;;; http://sourceforge.net/project/showfiles.php?group_id=30687 (take +;;; the r5rs compliant version (ssax-sr5rs-plt200-4.9.tar.gz); and +;;; patch string->goodhtml in packages.scm to string->goodHTML) + +;;; Interfaces +;; Surflet Handler +(define-interface surflet-handler-interface + (export surflet-handler)) + +;; Use for SUrflets +(define-interface surflet-handler/surflets-interface + (compound-interface + surflet-handler/responses-interface + (export send/suspend ;send and suspend + send/finish ;send and finish + send ;just send (no finish, no suspend) + send-error ;send error response + set-session-data! + get-session-data + adjust-timeout ;adjusts timeout of current session + ;Without `!' because PLT + ;doesn't have it. + ))) + +;; Use for adminstration of the Surflet Handler +(define-interface surflet-handler/admin-interface + (export get-loaded-surflets + unload-surflet + + options-session-lifetime + options-cache-surflets? + options-surflet-path + set-options-session-lifetime + set-options-cache-surflets? + + get-sessions + session-surflet-name + session-memo + session-continuation-table + session-continuation-table-lock + session-continuation-counter + delete-session! + + session-adjust-timeout! + adjust-timeout + + get-continuations + delete-continuation! + instance-session-id + + resume-url? + resume-url-ids + resume-url-session-id + resume-url-continuation-id)) + +;; Responses from SUrflets +(define-interface surflet-handler/responses-interface + (export make-surflet-response + surflet-response? + surflet-response-status + surflet-response-content-type + surflet-response-headers + surflet-response-data)) + + +;; Helping functions for surflets +(define-interface surflets-interface + (compound-interface + surflet-handler/surflets-interface + (export send-html/suspend + send-html/finish + send-html + + form-query + get-bindings + extract-bindings + extract-single-binding + + adjust-timeout + + make-outdater + (if-outdated :syntax) + show-outdated + + generate-input-field-name + make-input-field + make-higher-input-field + make-text-input-field + make-hidden-input-field + make-password-input-field + make-number-input-field + make-textarea-input-field + make-select-input-field + make-checkbox-input-field + make-radio-input-fields + + make-submit-button + make-reset-button + make-image-button + input-field-value + raw-input-field-value + input-field-binding + + make-address + make-annotated-address + + returned-via + returned-via? + + (case-returned-via :syntax) + + make-callback))) + +;; THE interface that SUrflets use. +(define-interface surflet-interface + (export main)) ; MAIN gets one parameter, the REQUEST + +;; Simple Surflet API as known from PLT +(define-interface simple-surflet-api-interface + (export single-query + queries + form-query + inform + final-page + make-password + make-number + make-boolean + make-radio + make-yes-no + extract/single + extract)) + +;; shift-reset +(define-interface shift-reset-interface + (export (reset :syntax) + (shift :syntax))) + +;; For memory profiling +(define-interface profiling-interface + (export profile-space + profile-result + profile-results + write-gnuplot-data-file + + space-info-pair space-info-symbol + space-info-vector space-info-closure + space-info-location space-info-cell + space-info-channel space-info-port + space-info-ratnum space-info-record + space-info-continuation space-info-extended-number + space-info-template space-info-weak-pointer + space-info-shared-binding space-info-unused-d-header1 + space-info-unused-d-header2 space-info-string + space-info-byte-vector space-info-double + space-info-bignum space-info-total + + set-space-info-pair! set-space-info-symbol! + set-space-info-vector! set-space-info-closure! + set-space-info-location! set-space-info-cell! + set-space-info-channel! set-space-info-port! + set-space-info-ratnum! set-space-info-record! + set-space-info-continuation! set-space-info-extended-number! + set-space-info-template! set-space-info-weak-pointer! + set-space-info-shared-binding! set-space-info-unused-d-header1! + set-space-info-unused-d-header2! set-space-info-string! + set-space-info-byte-vector! set-space-info-double! + set-space-info-bignum! set-space-info-total! + + pure-count pure-bytes + impure-count impure-bytes + total-count total-bytes + )) + +;; Handling every condition +(define-interface handle-fatal-interface + (export with-fatal-handler* + (with-fatal-handler :syntax))) + +;; Thread-safe counter +(define-interface thread-safe-counter-interface + (export make-thread-safe-counter + thread-safe-counter-value + thread-safe-counter-next! + thread-safe-counter?)) + +;; SUrflet-requests as expected from the surflet handler +(define-interface surflet-requests-interface + (export make-surflet-request + surflet-request? + surflet-request-request + surflet-request-input-port + surflet-request-method + surflet-request-uri + surflet-request-url + surflet-request-version + surflet-request-headers + surflet-request-socket)) + +;; These two are from Martin Gasbichler: (define-interface rt-module-language-interface (export ((lambda-interface with-names-from-rt-structure) @@ -19,6 +220,113 @@ rt-structure-binding load-structure)) + +;;; Structures (GREP) +;; structures from SUrflet Handler +(define-structures + ((surflet-handler surflet-handler-interface) + (surflet-handler/surflets surflet-handler/surflets-interface) + (surflet-handler/admin surflet-handler/admin-interface) + (surflet-handler/responses surflet-handler/responses-interface)) + (open define-record-types ;DEFINE-RECORD-TYPE + handle-fatal ;WITH-FATAL-ERROR-HANDLER* et al. + handle-fatal-error + httpd-errors ;errors for httpd + httpd-logging ;HTTP-SYSLOG + httpd-requests ;requests from httpd + httpd-responses ;replies for httpd + locks ;MAKE-LOCK et al. + profiling ;PROFILE-SPACE + rt-module-language ;get structures dynamically + scheme-with-scsh ;regexp et al. + shift-reset ;SHIFT and RESET + srfi-6 ;string-ports + srfi-14 ;CHAR-SET:DIGIT + srfi-27 ;random numbers + surflet-requests ;requests for surflets + sxml-to-html ;SXML->HTML + tables ;HASH-TABLES + thread-cells ;THREAD-CELL et al. + thread-fluids ;FORK-THREAD + thread-safe-counter + threads ;SLEEP + uri ;URI-PATH-LIST->PATH + ) + (files surflet-handler)) + +;; SUrflets library of helping functions +(define-structure surflets surflets-interface + (open surflet-handler/surflets + surflet-handler/responses + httpd-responses ; STATUS-CODE + surflet-requests ; HTTP-URL:SEARCH + url ; REQUEST:URL + (subset uri (escape-uri unescape-uri)) + parse-html-forms + sxml-to-html ; SXML->HTML + srfi-1 ; FILTER + (subset srfi-13 (string-index)) + sxml-tree-trans + define-record-types + weak ;MAKE-WEAK-POINTER + locks + let-opt ;:OPTIONAL + handle-fatal-error + (subset sunet-utilities (get-header)) ; GET-HEADER + scheme-with-scsh) + (files surflets)) + +;; Shift-Reset +(define-structure shift-reset shift-reset-interface + (open scheme + signals + escapes + thread-cells) + (files shift-reset)) + +;; Measuring memory usage. +(define-structure profiling profiling-interface + (open let-opt + define-record-types + spatial + srfi-13 + srfi-1 + locks + scheme-with-scsh) + (files profile)) + +;; Simple Surflet API as known from PLT. +(define-structure simple-surflet-api simple-surflet-api-interface + (open scheme-with-scsh + define-record-types + let-opt + surflets + (subset srfi-1 (zip filter find make-list)) + handle-fatal-error + ) + (files simple-surflet-api)) + +;; Handling every condition +(define-structure handle-fatal handle-fatal-interface + (open scheme conditions handle) + (files handle-fatal)) + + +;; Thread-safe counter +(define-structure thread-safe-counter thread-safe-counter-interface + (open scheme + locks + define-record-types) + (files thread-safe-counter)) + +;; SUrflet-requests as expected from the SUrflet handler +(define-structure surflet-requests surflet-requests-interface + (open scheme + define-record-types + httpd-requests) + (files surflet-request)) + +;; These two are from Martin Gasbichler: (define-structure rt-module-language rt-module-language-interface (open scheme rt-modules) @@ -64,276 +372,3 @@ ensures-loaded package-commands-internal) (files rt-module)) - -(define-interface surflet-handler-interface - (export surflet-handler)) - -(define-interface surflet-handler/surflets-interface - (export send/suspend ;send and suspend - send/finish ;send and finish - send ;just send (no finish, no suspend) - send-error ;send error response - set-session-data! - get-session-data - adjust-timeout ;adjusts timeout of current session - ;Without `!' because PLT - ;doesn't have it. - )) - -(define-interface surflet-handler/admin-interface - (export get-loaded-surflets - unload-surflet - set-options-session-lifetime - options-session-lifetime - set-options-cache-surflets? - options-cache-surflets? - options-surflet-path - get-sessions - session-surflet-name - session-memo - session-continuation-table - session-continuation-table-lock - session-continuation-counter - delete-session! - session-adjust-timeout! - adjust-timeout - get-continuations - delete-continuation! - instance-session-id - resume-url? - resume-url-ids - resume-url-session-id - resume-url-continuation-id)) - -(define-interface surflet-handler/responses-interface - (export make-surflet-response - surflet-response? - surflet-response-status - surflet-response-content-type - surflet-response-headers - surflet-response-data)) - -(define-structures - ((surflet-handler surflet-handler-interface) - (surflet-handler/surflets surflet-handler/surflets-interface) - (surflet-handler/admin surflet-handler/admin-interface) - (surflet-handler/responses surflet-handler/responses-interface)) - (open httpd-responses ;replies for httpd - httpd-requests ;requests from httpd - surflet-requests ;requests for surflets - httpd-errors ;errors for httpd - uri ;URI-PATH-LIST->PATH - tables ;HASH-TABLES - define-record-types ;DEFINE-RECORD-TYPE - rt-module-language ;get structures dynamically -; srfi-13 ;string - srfi-14 ;CHAR-SET:DIGIT - handle-fatal ;WITH-FATAL-ERROR-HANDLER* et al. - srfi-27 ;random numbers - locks ;MAKE-LOCK et al. - thread-cells ;THREAD-CELL et al. - profiling ;PROFILE-SPACE - httpd-logging ;HTTP-SYSLOG - shift-reset ;SHIFT and RESET - threads ;SLEEP - thread-fluids ;FORK-THREAD - sxml-to-html ;SXML->HTML - scheme-with-scsh ;regexp et al. - srfi-6 ;string-ports - thread-safe-counter - handle-fatal-error - ) - (files surflet-handler)) - - -(define-interface surflets-interface - (export send/suspend - send/finish - send - send-error - send-html/suspend - send-html/finish - send-html - form-query - get-bindings - extract-bindings - extract-single-binding - - adjust-timeout - - make-outdater - (if-outdated :syntax) - show-outdated - - generate-input-field-name - make-input-field - make-higher-input-field - make-text-input-field - make-hidden-input-field - make-password-input-field - make-number-input-field - make-textarea-input-field - make-select-input-field - make-checkbox-input-field - make-radio-input-fields - - make-submit-button - make-reset-button - make-image-button - input-field-value - raw-input-field-value - input-field-binding - - make-address - make-annotated-address - returned-via - returned-via? - (case-returned-via :syntax) - make-callback - - set-session-data! - get-session-data)) - -(define-structure surflets surflets-interface - (open surflet-handler/surflets - surflet-handler/responses - httpd-responses ; STATUS-CODE - surflet-requests ; HTTP-URL:SEARCH - url ; REQUEST:URL - (subset uri (escape-uri unescape-uri)) - parse-html-forms - sxml-to-html ; SXML->HTML - srfi-1 ; FILTER - (subset srfi-13 (string-index)) - sxml-tree-trans - define-record-types - weak ;MAKE-WEAK-POINTER - locks - let-opt ;:OPTIONAL - handle-fatal-error - (subset sunet-utilities (get-header)) ; GET-HEADER - scheme-with-scsh) - (files surflets)) - -(define-interface surflet-interface - (export main)) ; MAIN gets one parameter, the REQUEST - -(define-interface shift-reset-interface - (export (reset :syntax) - (shift :syntax))) - -(define-structure shift-reset shift-reset-interface - (open scheme - signals - escapes - thread-cells) - (files shift-reset)) - -(define-interface profiling-interface - (export profile-space - profile-result - profile-results - write-gnuplot-data-file - - space-info-pair space-info-symbol - space-info-vector space-info-closure - space-info-location space-info-cell - space-info-channel space-info-port - space-info-ratnum space-info-record - space-info-continuation space-info-extended-number - space-info-template space-info-weak-pointer - space-info-shared-binding space-info-unused-d-header1 - space-info-unused-d-header2 space-info-string - space-info-byte-vector space-info-double - space-info-bignum space-info-total - - set-space-info-pair! set-space-info-symbol! - set-space-info-vector! set-space-info-closure! - set-space-info-location! set-space-info-cell! - set-space-info-channel! set-space-info-port! - set-space-info-ratnum! set-space-info-record! - set-space-info-continuation! set-space-info-extended-number! - set-space-info-template! set-space-info-weak-pointer! - set-space-info-shared-binding! set-space-info-unused-d-header1! - set-space-info-unused-d-header2! set-space-info-string! - set-space-info-byte-vector! set-space-info-double! - set-space-info-bignum! set-space-info-total! - - pure-count pure-bytes - impure-count impure-bytes - total-count total-bytes - )) - -(define-structure profiling profiling-interface - (open let-opt - define-record-types - spatial - srfi-13 - srfi-1 - locks - scheme-with-scsh) - (files profile)) - -(define-interface simple-surflet-api-interface - (export single-query - queries - form-query - inform - final-page - make-password - make-number - make-boolean - make-radio - make-yes-no - extract/single - extract)) - -(define-structure simple-surflet-api simple-surflet-api-interface - (open scheme-with-scsh - define-record-types - let-opt - surflets - (subset srfi-1 (zip filter find make-list)) - handle-fatal-error - ) - (files simple-surflet-api)) - -(define-interface handle-fatal-interface - (export with-fatal-handler* - (with-fatal-handler :syntax))) - -(define-structure handle-fatal handle-fatal-interface - (open scheme conditions handle) - (files handle-fatal)) - - -(define-interface thread-safe-counter-interface - (export make-thread-safe-counter - thread-safe-counter-value - thread-safe-counter-next! - thread-safe-counter?)) - -(define-structure thread-safe-counter thread-safe-counter-interface - (open scheme - locks - define-record-types) - (files thread-safe-counter)) - -(define-interface surflet-requests-interface - (export make-surflet-request - surflet-request? - surflet-request-request - surflet-request-input-port - surflet-request-method - surflet-request-uri - surflet-request-url - surflet-request-version - surflet-request-headers - surflet-request-socket)) - -(define-structure surflet-requests surflet-requests-interface - (open scheme - define-record-types - httpd-requests) - (files surflet-request)) -