Start renaming.

bbstool.scm

@@ -0,0 +1,140 @@
+;;
+;; brmsaptool.scm
+;;
+;; Brmlab members management tool.
+;;
+
+;; The license of this file and of the whole suite.
+(define license-text "ISC License
+
+Copyright 2023 Brmlab, z.s.
+Dominik Pantůček <dominik.pantucek@trustica.cz>
+
+Permission to use, copy, modify, and/or distribute this software
+for any purpose with or without fee is hereby granted, provided
+that the above copyright notice and this permission notice appear
+in all copies.
+
+THE SOFTWARE IS PROVIDED \"AS IS\" AND THE AUTHOR DISCLAIMS ALL
+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+")
+
+(import testing
+	listing
+	dictionary
+	month
+	period
+	member-file
+	command-line
+	utils
+	ansi
+	members-base
+	primes
+	member-record
+	configuration)
+
+;; Print banner
+(print "brmsaptool 0.4 (c) 2023 Brmlab, z.s.")
+(newline)
+
+;; Command-line options and configurable parameters
+(define *members-directory* (make-parameter "members"))
+(define -member-id- (make-parameter #f))
+(define -member-nick- (make-parameter #f))
+(define -action- (make-parameter #f))
+(define -fname- (make-parameter #f))
+(define -run-tests?- (make-parameter #f))
+
+;; Arguments parsing
+(command-line
+ print-help
+ (-h () "This help"
+     (print "Command-line options:")
+     (newline)
+     (print-help)
+     (newline)
+     (exit 0))
+ (-license () "Show licensing terms"
+	   (print license-text)
+	   (exit 0))
+ (-MB (dir) "Members base directory" (*members-directory* dir))
+ (-mfkw () "Member-File invalid Key Warning" (*member-file-check-syntax* 'warning))
+ (-mfkq () "Member-File invalid Key Quiet" (*member-file-check-syntax* 'quiet))
+ (-mfec (n) "Member-File parser Error Context (lines)" (*member-file-context* (string->number n)))
+ (-mi (id) "Specify member by id" (-member-id- (string->number id)))
+ (-mn (nick) "Specify member by nick" (-member-nick- nick))
+ (-pi () "Print information" (-action- 'print-info))
+ (-stats (fname) "Get stats for all months"
+	 (-action- 'print-stats)
+	 (-fname- fname))
+ (-month (month) "Specify current month"
+	 (*current-month* (string->month month)))
+ (-print () "Print given member file"
+	 (-action- 'print-member-file))
+ (-tests () "Run self-tests upon startup" (-run-tests?- #t))
+ (-idstats () "Returns information about available member ids" (-action- 'print-idstats))
+ (-genid () "Generates random member id" (-action- 'genid))
+ )
+
+;; Run tests
+(when (-run-tests?-)
+  (listing-tests!)
+  (dictionary-tests!)
+  (month-tests!)
+  (period-tests!)
+  (utils-tests!)
+  (ansi-tests!)
+  (member-file-tests!)
+  (command-line-tests!)
+  (members-base-tests!)
+  (primes-tests!)
+  (member-record-tests!)
+  (newline))
+
+;; Load the members database (required for everything anyway)
+(define MB (load-members (*members-directory*) #t))
+
+;; If a member is specified by either id or nick, get its record
+(define mr (if (-member-id-)
+	       (find-member-by-id MB (-member-id-))
+	       (if (-member-nick-)
+		   (find-member-by-nick MB (-member-nick-))
+		   #f)))
+
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Perform requested action
+(case (-action-)
+  ((print-info)
+   (newline)
+   (if mr
+       (print-member-record-info mr)
+       (print-members-base-info MB))
+   (newline))
+  ((print-stats)
+   (newline)
+   (parameterize ((current-output-port (open-output-file (-fname-))))
+     (print-members-base-stats
+      (members-base-stats MB))))
+  ((print-member-file)
+   (cond (mr
+	  (newline)
+	  (print-member-source mr))
+	 (else
+	  (print "No member specified!"))))
+  ((print-idstats)
+   (newline)
+   (print-members-ids-stats MB)
+   (newline))
+  ((genid)
+   (newline)
+   (print "New member id: " (gen-member-id MB))
+   (newline))
+  )