Overview
Comment: | Built-in fossil trigger added |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64 |
Files: | files | file ages | folders |
SHA1: |
a0d9adf070c22a0a93812bbc17c5c284 |
User & Date: | matt on 2017-03-06 10:49:40 |
Other Links: | branch diff | manifest | tags |
Context
2017-03-06
| ||
11:35 | Added 0/5 type syntax to cron specification check-in: 73a7b5099f user: matt tags: v1.64 | |
10:49 | Built-in fossil trigger added check-in: a0d9adf070 user: matt tags: v1.64 | |
08:45 | Built-in fossil trigger added check-in: 9f0f4f0f04 user: matt tags: v1.64 | |
Changes
Modified common.scm from [88d13978fa] to [f7216b27b7].
︙ | ︙ | |||
1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 | (list yr mo wk day hr min 1) '( y mo w d h m s)))) (list 8 6 5 2 1))) '(5 10 15 20 30 40 50 500)) (if values (apply values result) (values 0 day 1 0 'd)))) ;; given a cron string and the last time event was processed return #t to run or #f to not run ;; ;; min hour dayofmonth month dayofweek ;; 0-59 0-23 1-31 1-12 0-6 ### NOTE: dayofweek does not include 7 ;; ;; #t => yes, run the job | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 | (list yr mo wk day hr min 1) '( y mo w d h m s)))) (list 8 6 5 2 1))) '(5 10 15 20 30 40 50 500)) (if values (apply values result) (values 0 day 1 0 'd)))) ;; given x y lim return the cron expansion ;; (define (common:expand-cron-slash x y lim) (let loop ((curr x) (res `())) (if (< curr lim) (loop (+ curr y) (cons curr res)) (reverse res)))) ;; expand a complex cron string to a list of cron strings ;; ;; x/y => x, x+y, x+2y, x+3y while x+Ny<max_for_field ;; a,b,c => a, b ,c ;; (define (common:cron-expand cron-str) (if (list? cron-str) (map common:cron-expand cron-str) (let ((cron-items (string-split cron-str)) (slash-rx (regexp "(\\d+)/(\\d+)")) (comma-rx (regexp ".*,.*")) (max-vals '((min . 60) (hour . 24) (dayofmonth . 28) ;;; BUG!!!! This will be a bug for some combinations (month . 12) (dayofweek . 7)))) (if (< (length cron-items) 5) ;; bad spec `(,cron-str) ;; just return the string, something downstream will fix it (let loop ((hed (car cron-items)) (tal (cdr cron-items)) (type 'min) (type-tal '(hour dayofmonth month dayofweek)) (res '())) (regex-case hed (slash-rx ( _ base incr ) (let* ((basen (string->number base)) (incrn (string->number incr)) (expanded-vals (common:expand-cron-slash basen incrn (alist-ref type max-vals))) (new-list-crons (fold (lambda (x myres) (cons (conc (string-intersperse res " ") " " x " " (string-intersperse tal " ")) myres)) '() expanded-vals))) (print "new-list-crons: " new-list-crons) new-list-crons)) ;; (map common:cron-expand (map common:cron-expand new-list-crons)))) (else (if (null? tal) cron-str (loop (car tal)(cdr tal)(car type-tal)(cdr type-tal)(append res (list hed))))))))))) ;; given a cron string and the last time event was processed return #t to run or #f to not run ;; ;; min hour dayofmonth month dayofweek ;; 0-59 0-23 1-31 1-12 0-6 ### NOTE: dayofweek does not include 7 ;; ;; #t => yes, run the job |
︙ | ︙ |
Modified megatest.scm from [6ec8351d48] to [4efda530ec].
︙ | ︙ | |||
362 363 364 365 366 367 368 369 370 371 372 373 374 375 | (not (or (args:get-arg "-runstep") (args:get-arg "-envcap") (args:get-arg "-envdelta") ) )) (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " "))) ;; immediately set MT_TARGET if -reqtarg or -target are available ;; (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. | > > > > > > > > > | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 | (not (or (args:get-arg "-runstep") (args:get-arg "-envcap") (args:get-arg "-envdelta") ) )) (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " "))) ;; before doing anything else change to the start-dir if provided ;; (if (args:get-arg "-start-dir") (if (file-exists? (args:get-arg "-start-dir")) (change-directory (args:get-arg "-start-dir")) (begin (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.") (exit 1)))) ;; immediately set MT_TARGET if -reqtarg or -target are available ;; (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. |
︙ | ︙ | |||
436 437 438 439 440 441 442 | (manual-html (conc install-home "/share/docs/megatest_manual.html"))) (if (and install-home (file-exists? manual-html)) (system (conc "(" htmlviewercmd " " manual-html " ) &")) (system (conc "(" htmlviewercmd " http://www.kiatoa.com/cgi-bin/fossils/megatest/doc/tip/docs/manual/megatest_manual.html ) &"))) (exit))) | < < < < < < < | 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | (manual-html (conc install-home "/share/docs/megatest_manual.html"))) (if (and install-home (file-exists? manual-html)) (system (conc "(" htmlviewercmd " " manual-html " ) &")) (system (conc "(" htmlviewercmd " http://www.kiatoa.com/cgi-bin/fossils/megatest/doc/tip/docs/manual/megatest_manual.html ) &"))) (exit))) (if (args:get-arg "-version") (begin (print (common:version-signature)) ;; (print megatest-version) (exit))) (define *didsomething* #f) |
︙ | ︙ |