Megatest

Diff
Login

Differences From Artifact [3e3e4527c3]:

To Artifact [0779b6f325]:


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
55
56
57
58
59
60
61
62
63
64
65





66
67
	  last-name))))

(define (str-first-char->number str)
  (char->integer (string-ref str 0)))
 
;; example of how to set up and write target mappers
;;
(hash-table-set! *target-mappers*
		 'prefix-contour
		 (lambda (target run-name area area-path reason contour mode-patt)
		   (conc contour "/" target)))
(hash-table-set! *target-mappers*
		 'prefix-area-contour
		 (lambda (target run-name area area-path reason contour mode-patt)
		   (conc area "/" contour "/" target)))
  
(hash-table-set! *runname-mappers*
		 'corporate-ww
		 (lambda (target run-name area area-path reason contour mode-patt)
		   (print "corporate-ww called with: target=" target " run-name=" run-name " area=" area " area-path=" area-path " reason=" reason " contour=" contour " mode-patt=" mode-patt)
		   (let* ((last-name   (get-last-runname area-path target))
			  (last-letter (let* ((ch (if (string? last-name)
						      (let ((len (string-length last-name)))
							(substring last-name (- len 1) len))
						      "a"))
					      (chnum (str-first-char->number ch))
					      (a     (str-first-char->number "a"))
					      (z     (str-first-char->number "z")))
					 (if (and (>= chnum a)(<= chnum z))
					     chnum
					     #f)))
			  (next-letter (if last-letter
					   (list->string
					    (list
					     (integer->char
					      (+ last-letter 1)))) ;; surely there is an easier way?
					   "a")))
		     ;; (print "last-name: " last-name " last-letter: " last-letter " next-letter: " next-letter)
		     (conc (seconds->wwdate (current-seconds)) next-letter))))

(hash-table-set! *runname-mappers*
		 'auto
		 (lambda (target run-name area area-path reason contour mode-patt)
		   "auto-eh"))






;; (print "Got here!")








<
|
|
|
<
|
|
|

<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
<
|
|

>
>
>
>
>
|

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
55
56
57
58

59
60
61
62
63
64
65
66
67
68
	  last-name))))

(define (str-first-char->number str)
  (char->integer (string-ref str 0)))
 
;; example of how to set up and write target mappers
;;

(add-target-mapper 'prefix-contour
		   (lambda (target run-name area area-path reason contour mode-patt)
		     (conc contour "/" target)))

(add-target-mapper 'prefix-area-contour
		   (lambda (target run-name area area-path reason contour mode-patt)
		     (conc area "/" contour "/" target)))
  

(add-runname-mapper 'corporate-ww
		    (lambda (target run-name area area-path reason contour mode-patt)
		      (print "corporate-ww called with: target=" target " run-name=" run-name " area=" area " area-path=" area-path " reason=" reason " contour=" contour " mode-patt=" mode-patt)
		      (let* ((last-name   (get-last-runname area-path target))
			     (last-letter (let* ((ch (if (string? last-name)
							 (let ((len (string-length last-name)))
							   (substring last-name (- len 1) len))
							 "a"))
						 (chnum (str-first-char->number ch))
						 (a     (str-first-char->number "a"))
						 (z     (str-first-char->number "z")))
					    (if (and (>= chnum a)(<= chnum z))
						chnum
						#f)))
			     (next-letter (if last-letter
					      (list->string
					       (list
						(integer->char
						 (+ last-letter 1)))) ;; surely there is an easier way?
					      "a")))
			;; (print "last-name: " last-name " last-letter: " last-letter " next-letter: " next-letter)
			(conc (seconds->wwdate (current-seconds)) next-letter))))

(add-runname-mapper 'auto

		    (lambda (target run-name area area-path reason contour mode-patt)
		      "auto-eh"))

;; run only areas where first letter of area name is "a"
;;
(add-area-checker 'first-letter-a
		 (lambda (area runkey)
		   (string-match "^a.*$" area)))