Overview
Comment:Self contained approach now working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | selfcontained
Files: files | file ages | folders
SHA1: 2da502548b5c596db21bea3879d1d5fe4dd3b5c0
User & Date: matt on 2013-05-19 07:01:37
Other Links: branch diff | manifest | tags
Context
2013-05-19
07:03
Added some missing files check-in: 154b67c8ea user: matt tags: selfcontained
07:01
Self contained approach now working check-in: 2da502548b user: matt tags: selfcontained
2013-05-18
21:13
Added utility to rollup pages check-in: 136be142e4 user: matt tags: selfcontained
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [74ba9265cf] to [943370488e].

︙
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41



42
43


44
45
46
47
48
49
50

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45


46
47
48
49
50
51
52
53
54








+








-
+












+
+
+
-
-
+
+








SOFILES     = $(MODULEFILES:%.scm=%.so)
CFILES      = $(MODULEFILES:%.scm=%.c)
OFILES      = $(SRCFILES:%.scm=%.o)
TARGFILES   = $(notdir $(SOFILES))
MODULES     = $(addprefix $(TARGDIR)/modules/,$(TARGFILES))

install : $(TARGDIR)/stmlrun $(LOGDIR) $(MODULES)
	chicken-install

all : $(SOFILES)

# stmlrun : stmlrun.scm formdat.scm  misc-stml.scm  session.scm stml.scm \
#           setup.scm html-filter.scm requirements.scm keystore.scm \
#           cookie.scm sqltbl.scm
# 	csc stmlrun.scm

$(TARGDIR)/stmlrun : stmlrun
$(TARGDIR)/stmlrun : stmlrun stml.so
	install stmlrun $(TARGDIR)
	chmod a+rx $(TARGDIR)/stmlrun

$(TARGDIR)/modules :
	mkdir -p $(TARGDIR)/modules

$(MODULES) : $(SOFILES) $(TARGDIR)/modules
	cp $< $@

stmlrun : $(OFILES) stmlrun.scm requirements.scm stmlcommon.scm
	csc $(OFILES) stmlrun.scm -o stmlrun

stml.so : stmlmodule.so
	cp stmlmodule.so stml.so

stml.so : $(OFILES) stmlmodule.scm requirements.scm stmlcommon.scm
	csc $(OFILES) -s stml.scm
stmlmodule.so : $(OFILES) stmlmodule.scm requirements.scm stmlcommon.scm
	csc $(OFILES) -s stmlmodule.scm

# logging currently relies on this
#
$(LOGDIR) :
	mkdir -p $(LOGDIR)
	chmod a+rwx $(LOGDIR)
︙

Modified rollup-pages.scm from [6207d17268] to [a76b5d67f0].

︙
16
17
18
19
20
21
22
23
24
25
26




27
28
29
30
31

16
17
18
19
20
21
22




23
24
25
26
27
28
29
30
31








-
-
-
-
+
+
+
+






		     all))))
       (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
  (print "Pages: " pages)
  (with-output-to-file "all_pages.scm"
    (lambda ()
      (for-each (lambda (page)
		  (print "(define (pages:" page ")")
		  (if (hash-table-ref/default lookup (conc page "_view") #f)
		      (print "(include \"pages/" page "_view.scm\")"))
		  (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
		      (print "(include \"pages/" page "_ctrl.scm\")"))
		  (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
		      (print "(include \"pages/" page "_ctrl.scm\")"))
		  (if (hash-table-ref/default lookup (conc page "_view") #f)
		      (print "(include \"pages/" page "_view.scm\")"))
		  (print ")\n"))
		pages))))

Modified session.scm from [35fee6e1bc] to [b7ff27d8a3].

︙
570
571
572
573
574
575
576






577
578
579
580








581

582
583
584


585
586
587
588
589
590





591
592
593


594
595
596
597
598
599
600
601
602
603
604
605
606


607
608
609
610
611
612
613
614
615
616
617





618
619
620
621
622




623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
639
640
641
642
643



644

645
646
647
648
649
650
651
652
653
654
655
656








657
658
659


660
661
662
663
664
665
666

570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594

595
596


597
598






599
600
601
602
603



604
605













606
607











608
609
610
611
612





613
614
615
616








617













618
619
620

621
622
623
624
625








626
627
628
629
630
631
632
633
634


635
636
637
638
639
640
641
642
643








+
+
+
+
+
+




+
+
+
+
+
+
+
+
-
+

-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
+




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+








       (cond
	((list? x) x)
	((string? x) x)
	(else '())))
     (port-map (lambda (s)
		 (eval s e))
	       (lambda ()(read p))))))

(define (session:process-file f)
  (let* ((p    (open-input-file f))
	 (dat  (process-port p)))
    (close-input-port p)
    dat))

;; May 2011, putting all pages into one directory for the following reasons:
;;   1. want filename to reflect page name (emacs limitation)
;;   2. that's it! no other reason. could make it configurable ...
;; page-dir-style is:
;;  'stored   => stored in executable
;;  'flat     => pages flat directory
;;  'dir      => directory tree pages/<pagename>/{view,control}.scm
;; parts:
;;  'both     => load control and view (anything other than view or control
;;  'view     => load view only
;;  'control  => load control only
(define (session:call-parts self page parts)
(define (session:call-parts self page #!key (parts 'both))
  (sdat-set-curr-page! self page)
  ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
  (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
  (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
  (let* ((dir-style    (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
	  (sdat-get-page-dir-style self))
	 (dir     (string-append (sdat-get-sroot self) 
				 (if dir-style 
				     (conc "/pages/")
				     (conc "/pages/" page))))
	 (control (string-append dir (if dir-style 
	 (dir          (string-append (sdat-get-sroot self) 
				      (if dir-style 
					  (conc "/pages/")
					  (conc "/pages/" page)))))
    (case dir-style
					 (conc page "_ctrl.scm")
					 "/control.scm")))
	 (view    (string-append dir (if dir-style 
      ;; NB// Stored always loads both control and view
      ((stored)((eval (string->symbol (conc "pages:" page)))))
					 (conc page "_view.scm")
					 "/view.scm")))
	 (load-view    (and (file-exists? view)
			    (or (eq? parts 'both)(eq? parts 'view))))
	 (load-control (and (file-exists? control)
			    (or (eq? parts 'both)(eq? parts 'control))))
	 (view-dat   '()))
    ;; (session:log self "dir-style: " dir-style)
 ;;   (sugar "/home/matt/kiatoa/stml/sugar.scm" ))
    ;; (print "dir=" dir " control=" control " view=" view " load-view=" load-view " load=control=" load-control)
    (if load-control
	(begin
	  (load control)
      ((dir)   
       ;; first the control
	  (session:set-called! self page)))
    ;; move this to where it gets exectuted only once
    ;;
    ;;(s:log "s:b yields " (s:b "blah"))
    (if load-view
	;; option one:
	;;
	;; (let ((inp (open-input-string 
	;; 	    (files-read->string "/home/matt/kiatoa/stml/sugar.scm" 
	;; 				view))))
	;;   (map 
       (let ((control-file (conc "pages/" page "_ctrl.scm"))
	     (view-file    (conc "pages/" page "_view.scm")))
	 (if (and (file-exists? control-file)
		  (not (eq? parts 'view)))
	     (begin
	;;    (lambda (x)
	;;      (cond
	;;       ((list? x) x)
	;;       ((string? x) x)
	;;       (else '())))
	       (session:set-called! self page)
	       (load control-file)))
	 (if (file-exists? view-file)
	     (if (not (eq? parts 'control))
	;;    (port-map eval (lambda ()
	;; 		 (read inp)))))
	;;
	;; option two:
	;;
	(let* (;; (inps (map open-input-file (list view))) ;; sugar view)))
	       (p    (open-input-file view)) ;; (apply make-concatenated-port inps))
	       (dat  (process-port p)))
		 (session:process-file view-file))
		;;(map 
		;;      (lambda (x)
		;;	(cond
		;;	 ((list? x) x)
		;;	 ((string? x) x)
		;;	 (else '())))
		;;      (port-map eval (lambda ()(read p))))))
	  ;; (map close-input-port inps)
	  (close-input-port p)
	  dat)
	(list "<p>Page not found " page " </p>"))))

;;(define (session:call self page)
	     (list "<p>Page not found " page " </p>"))))
      ((flat))
      (else
;;  (session:call-parts self page 'both))
       (list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))

(define (session:call self page parts)
  (session:call-parts self page 'both))

(define (session:load-model self model)
  (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
    (if (file-exists? model.so)
	(load model.so)
	(if (file-exists? model.scm)
	    (load model.scm)
	    (s:log "ERROR: model " model.scm " not found")))))
;; (define (session:load-model self model)
;;   (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
;; 	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
;;     (if (file-exists? model.so)
;; 	(load model.so)
;; 	(if (file-exists? model.scm)
;; 	    (load model.scm)
;; 	    (s:log "ERROR: model " model.scm " not found")))))

(define (session:model-path self model)
  (string-append (sdat-get-sroot self) "/models/" model ".scm"))
;; (define (session:model-path self model)
;;   (string-append (sdat-get-sroot self) "/models/" model ".scm"))

(define (session:pp-formdat self)
  (let ((dat (formdat:all->strings (sdat-get-formdat self))))
    (string-intersperse dat "<br> ")))

(define (session:param->string params)
  ;; (err:log "params=" params)
︙