Compare commits
	
		
			5 commits
		
	
	
		
			5f4724874e
			...
			c648fe8c52
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| c648fe8c52 | |||
| 42620b38ff | |||
| b0b558c8d4 | |||
| c06bc95b36 | |||
| 37b608ab67 | 
					 14 changed files with 73 additions and 63 deletions
				
			
		|  | @ -1,6 +1,14 @@ | |||
| ChangeLog | ||||
| ========= | ||||
| 
 | ||||
| 1.19 - released 2025-04-16 | ||||
| -------------------------- | ||||
| 
 | ||||
| * manpage updated | ||||
| * added -n option for dry-runs | ||||
| * removed mailman 2.x support | ||||
| * added "councilml" start/stop support for member files | ||||
| 
 | ||||
| 1.18 - released 2025-01-06 | ||||
| -------------------------- | ||||
| 
 | ||||
|  |  | |||
|  | @ -1,22 +0,0 @@ | |||
| set terminal pngcairo size 1000,600 | ||||
| set title "Members stats" | ||||
| set output 'members-base-stats-2023-11.png' | ||||
| 
 | ||||
| src='members-base-stats-2023-11.data' | ||||
| 
 | ||||
| set timefmt "%Y-%m" | ||||
| set xdata time | ||||
| set format x "%Y-%m" | ||||
| 
 | ||||
| set xlabel "Month" | ||||
| set ylabel "Members" | ||||
| 
 | ||||
| set grid | ||||
| 
 | ||||
| set key out right | ||||
| 
 | ||||
| plot[1420066800:][0:] \ | ||||
| src u 1:3 w l lw 2 t 'active', \ | ||||
| src u 1:4 w l t 'suspended', \ | ||||
| src u 1:5 w l t 'students', \ | ||||
| src u 1:6 w l t 'destroyed' | ||||
|  | @ -188,7 +188,7 @@ progress.o: progress.import.scm | |||
| progress.import.scm: $(PROGRESS-SOURCES) | ||||
| 
 | ||||
| EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm		\
 | ||||
| 	mbase.import.scm brmember.import.scm | ||||
| 	mbase.import.scm brmember.import.scm configuration.import.scm | ||||
| 
 | ||||
| export-cards.o: export-cards.import.scm | ||||
| export-cards.import.scm: $(EXPORT-CARDS-SOURCES) | ||||
|  |  | |||
|  | @ -61,7 +61,8 @@ | |||
| 	  grantstart grantstop | ||||
| 	  joined destroyed | ||||
| 	  feestart feestop | ||||
| 	  phone)) | ||||
| 	  phone | ||||
| 	  councilmlstart councilmlstop)) | ||||
|  (define ignored-keys '(mail2)) | ||||
| 
 | ||||
|  (define known-keys (append mandatory-keys optional-keys)) | ||||
|  | @ -88,6 +89,9 @@ | |||
| 
 | ||||
|      (feestart fee start) | ||||
|      (feestop fee stop) | ||||
| 
 | ||||
|      (councilmlstart councilml start) | ||||
|      (councilmlstop councilml stop) | ||||
|      )) | ||||
|  (define start-stop-markers (map car start-stop-markers-lookup)) | ||||
| 
 | ||||
|  | @ -114,7 +118,7 @@ | |||
|      (info | ||||
|       ,(lambda (mr output key value) | ||||
| 	 (case key | ||||
| 	   ((student suspend member revision chair council grant fee) | ||||
| 	   ((student suspend member revision chair council grant fee councilml) | ||||
| 	    (let* ((res (period-markers->cal-periods value)) | ||||
| 		   (ok? (car res)) | ||||
| 		   (periods0 (cadr res)) | ||||
|  |  | |||
|  | @ -65,6 +65,7 @@ | |||
| 
 | ||||
|   brmember-chair? | ||||
|   brmember-council? | ||||
|   brmember-councilml? | ||||
|   brmember-revision? | ||||
|   brmember-grant? | ||||
|    | ||||
|  | @ -394,6 +395,7 @@ | |||
|  ;; Predicates for all organizational bodies recognized | ||||
|  (define brmember-chair? (brmember-body? 'chair)) | ||||
|  (define brmember-council? (brmember-body? 'council)) | ||||
|  (define brmember-councilml? (brmember-body? 'councilml)) | ||||
|  (define brmember-revision? (brmember-body? 'revision)) | ||||
|  (define brmember-grant? (brmember-body? 'grant)) | ||||
| 
 | ||||
|  |  | |||
|  | @ -43,6 +43,7 @@ | |||
|   *mailman3-sql* | ||||
|   *mailman3-sql-path* | ||||
|   *notifications-cc* | ||||
|   *dummy-run* | ||||
|    | ||||
|   load-configuration! | ||||
|   ) | ||||
|  | @ -100,7 +101,7 @@ | |||
| 
 | ||||
|  ;; Which version of mailman to use | ||||
|  (define *mailman-version* (make-parameter #f)) | ||||
|  (define =mailman-version= 2) | ||||
|  (define =mailman-version= 3) | ||||
| 
 | ||||
|  ;; What is the mailman 3 command | ||||
|  (define *mailman3-bin* (make-parameter #f)) | ||||
|  | @ -111,7 +112,7 @@ | |||
|  ;; A string is the default, gets converted to boolean at the end of | ||||
|  ;; loading configuration | ||||
|  (define *mailman3-sql* (make-parameter #f)) | ||||
|  (define =mailman3-sql= "0") | ||||
|  (define =mailman3-sql= "1") | ||||
| 
 | ||||
|  ;; The path to SQLite3 DB file | ||||
|  (define *mailman3-sql-path* (make-parameter #f)) | ||||
|  | @ -121,6 +122,9 @@ | |||
|  (define *notifications-cc* (make-parameter #f)) | ||||
|  (define =notifications-cc= "rada@brmlab.cz") | ||||
| 
 | ||||
|  ;; If #t, do not do anything | ||||
|  (define *dummy-run* (make-parameter #f)) | ||||
| 
 | ||||
|  (define (load-single-configuration! fname) | ||||
|    (when (file-exists? fname) | ||||
|      (let loop ((lines (read-lines (open-input-file fname)))) | ||||
|  |  | |||
|  | @ -38,7 +38,8 @@ | |||
| 	 (chicken irregex) | ||||
| 	 util-bst-ldict | ||||
| 	 mbase | ||||
| 	 brmember) | ||||
| 	 brmember | ||||
| 	 configuration) | ||||
| 
 | ||||
|  ;; Prints single card type records. | ||||
|  (define (cards-print/type mb type) | ||||
|  | @ -84,7 +85,8 @@ | |||
| 
 | ||||
|  ;; Exports cards and desfires to the files specified. | ||||
|  (define (cards-export mb cardsfn desfirefn) | ||||
|    (when (not (*dummy-run*)) | ||||
|      (cards-export/type mb 'card cardsfn) | ||||
|    (cards-export/type mb 'desfire desfirefn)) | ||||
|      (cards-export/type mb 'desfire desfirefn))) | ||||
| 
 | ||||
|  ) | ||||
|  |  | |||
|  | @ -191,10 +191,11 @@ | |||
| 
 | ||||
|  ;; Generates all members in given directory | ||||
|  (define (gen-html-members mb dir) | ||||
|    (when (not (*dummy-run*)) | ||||
|      (ensure-directory dir) | ||||
|      (with-mbase-progress% | ||||
|       mb dir mr | ||||
|       (gen-html-member mr dir)) | ||||
|    (clean-members-files mb dir)) | ||||
|      (clean-members-files mb dir))) | ||||
| 
 | ||||
|  ) | ||||
|  |  | |||
|  | @ -116,6 +116,8 @@ | |||
|  (-mailman3-sql-path (path) "Set mailman3 direct SQL access path" | ||||
| 		     (*mailman3-sql* "1") | ||||
| 		     (*mailman3-sql-path* path)) | ||||
|  (-n () "Do not do anything" | ||||
|      (*dummy-run* #t)) | ||||
|  "" | ||||
|  "Email options:" | ||||
|  (-from (email) "Sender email address" | ||||
|  |  | |||
|  | @ -73,6 +73,7 @@ | |||
|  (define (rada-ml-pred? mr) | ||||
|    (or (brmember-council? mr) | ||||
|        (brmember-chair? mr) | ||||
|        (brmember-revision? mr))) | ||||
|        (brmember-revision? mr) | ||||
|        (brmember-councilml? mr))) | ||||
| 
 | ||||
|  ) | ||||
|  |  | |||
|  | @ -37,7 +37,8 @@ | |||
| 	 (chicken base) | ||||
| 	 (chicken format) | ||||
| 	 sqlite3 | ||||
| 	 configuration) | ||||
| 	 configuration | ||||
| 	 (chicken condition)) | ||||
| 
 | ||||
|  ;; Thread-local parameter to re-use SQLite3 DB handle for subsequent queries | ||||
|  (define *cached-mailman3-db* (make-parameter #f)) | ||||
|  | @ -55,10 +56,15 @@ | |||
|  ;; Returns the list of mailman3 mailinglists by querying te | ||||
|  ;; underlying SQLite3 DB directly | ||||
|  (define (list-mailman3-sql-lists) | ||||
|    (handle-exceptions | ||||
|        ex | ||||
|        '() | ||||
|      (let ((result | ||||
| 	    (let-values (((stmt _) | ||||
| 			  (prepare (mailman3-db) | ||||
| 				   "SELECT list_name FROM mailinglist"))) | ||||
|      (map-row identity stmt))) | ||||
| 	      (map-row identity stmt)))) | ||||
|        result))) | ||||
| 
 | ||||
|  ;; Returns a list of email addresses subscribed to given mailinglist | ||||
|  (define (list-mailman3-sql-list-members lst) | ||||
|  |  | |||
|  | @ -94,7 +94,8 @@ | |||
| 
 | ||||
|  ;; Adds given email | ||||
|  (define (add-email-to-mailman3-list lst email) | ||||
|    (print "Add " email " to " lst ".") | ||||
|    (print "Add " email " to " lst "." (if (*dummy-run*) " [no-op]" "")) | ||||
|    (when (not (*dummy-run*)) | ||||
|      (let ((result | ||||
| 	    (mailman3-send/recv | ||||
| 	     (list "addmembers" "-" (format "~A@brmlab.cz" lst)) | ||||
|  | @ -102,11 +103,12 @@ | |||
|        (let loop ((lines result)) | ||||
| 	 (when (not (null? lines)) | ||||
| 	   (print " | " (car lines)) | ||||
| 	 (loop (cdr lines)))))) | ||||
| 	   (loop (cdr lines))))))) | ||||
| 
 | ||||
|  ;; Removes given email from given listname | ||||
|  (define (remove-email-from-mailman3-list lst email) | ||||
|    (print "Remove " email " from " lst ".") | ||||
|    (print "Remove " email " from " lst "." (if (*dummy-run*) " [no-op]" "")) | ||||
|    (when (not (*dummy-run*)) | ||||
|      (let ((result | ||||
| 	    (get-mailman3-output-lines | ||||
| 	     "delmembers" | ||||
|  | @ -115,6 +117,6 @@ | |||
|        (let loop ((lines result)) | ||||
| 	 (when (not (null? lines)) | ||||
| 	   (print " | " (car lines)) | ||||
| 	 (loop (cdr lines)))))) | ||||
| 	   (loop (cdr lines))))))) | ||||
|       | ||||
|  ) | ||||
|  |  | |||
|  | @ -114,7 +114,7 @@ | |||
| 						(caddr c))) | ||||
| 					(brmember-credit mr)) | ||||
| 				   #:border '(((#:right light) ... none) ...)))) | ||||
| 			   ((suspend student member council chair revision grant) | ||||
| 			   ((suspend student member council chair revision grant councilml) | ||||
| 			    (let* ((pdata (cons (list "Since" "Until") | ||||
| 						(map | ||||
| 						 (lambda (p) | ||||
|  |  | |||
|  | @ -39,7 +39,7 @@ | |||
| 	 (chicken format)) | ||||
| 
 | ||||
|  ;; Short banner | ||||
|  (define banner-line "HackerBase 1.19-dev (c) 2023-2025 Brmlab, z.s.") | ||||
|  (define banner-line "HackerBase 1.19 (c) 2023-2025 Brmlab, z.s.") | ||||
| 
 | ||||
|  ;; Banner source with numbers for ANSI CSI SGR | ||||
|  (define banner-source " | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue