New logging utility functions for REPL usage (#18859)

* New logging utility functions for REPL usage

* Test fix 

* Add support for `:off` and `:fatal` levels.

* Remove NOCOMMIT

test/metabase/test.clj

@@ -204,6 +204,8 @@
   with-open-channels]
 
  [tu.log
+  ns-log-level
+  set-ns-log-level!
   suppress-output
   with-log-messages
   with-log-messages-for-level

test/metabase/test/util/log.clj

 (ns metabase.test.util.log
   "Utils for controlling the logging that goes on when running tests."
-  (:require [clojure.tools.logging :as log]
-            [metabase.test-runner.parallel :as test-runner.parallel])
+  (:require [clojure.test :refer :all]
+            [clojure.tools.logging :as log]
+            [metabase.test-runner.parallel :as test-runner.parallel]
+            [schema.core :as s])
   (:import java.io.PrintStream
            [org.apache.commons.io.output NullOutputStream NullWriter]
            [org.apache.logging.log4j Level LogManager]
-           [org.apache.logging.log4j.core Logger LoggerContext]))
+           [org.apache.logging.log4j.core Logger LoggerContext]
+           [org.apache.logging.log4j.core.config Configuration LoggerConfig]))
 
-(def ^:private logger->original-level
+(def ^:private ^:deprecated logger->original-level
   (delay
     (let [loggers (.getLoggers ^LoggerContext (LogManager/getContext false))]
       (into {} (for [^Logger logger loggers]
@@ -16,7 +19,7 @@
 (def ^:private ^:dynamic *suppressed* false)
 
 (defn ^:deprecated do-with-suppressed-output
-  "Impl for `suppress-output` macro; don't use this directly."
+  "Impl for [[suppress-output]] macro; don't use this directly."
   [f]
   (if *suppressed*
     (f)
@@ -68,34 +71,118 @@
   [& body]
   `(do-with-log-messages (fn [] ~@body)))
 
-(def ^:private level-kwd->level
-  "Conversion from a keyword log level to the Log4J constance mapped to that log level.
-   Not intended for use outside of the `with-log-messages-for-level` macro."
-  {:error Level/ERROR
+(def ^:private keyword->Level
+  {:off   Level/OFF
+   :fatal Level/FATAL
+   :error Level/ERROR
    :warn  Level/WARN
    :info  Level/INFO
    :debug Level/DEBUG
    :trace Level/TRACE})
 
+(def ^:private LogLevelKeyword
+  (apply s/enum (keys keyword->Level)))
+
+(defn- ->Level
+  "Conversion from a keyword log level to the Log4J constance mapped to that log level. Not intended for use outside of
+  the [[with-log-messages-for-level]] macro."
+  ^Level [k]
+  (or (when (instance? Level k)
+        k)
+      (get keyword->Level (keyword k))
+      (throw (ex-info "Invalid log level" {:level k}))))
+
+(s/defn ^:private log-level->keyword :- LogLevelKeyword
+  [level :- Level]
+  (some (fn [[k a-level]]
+          (when (= a-level level)
+            k))
+        keyword->Level))
+
+(defn- logger-context ^LoggerContext []
+  (LogManager/getContext true))
+
+(defn- configuration ^Configuration []
+  (.getConfiguration (logger-context)))
+
+(defn- effective-ns-logger
+  "Get the logger that will be used for the namespace named by `ns-symb`."
+  ^LoggerConfig [ns-symb]
+  {:pre [(symbol? ns-symb)]}
+  (.getLoggerConfig (configuration) (name ns-symb)))
+
+(s/defn ns-log-level :- LogLevelKeyword
+  "Get the log level currently applied to the namespace named by symbol `ns-symb`. `ns-symb` may be a symbol that names
+  an actual namespace, or a prefix such or `metabase` that applies to all 'sub' namespaces that start with
+  `metabase.` (unless a more specific logger is defined for them).
+
+    (mt/ns-log-level 'metabase.query-processor.middleware.cache) ; -> :info"
+  [ns-symb]
+  (log-level->keyword (.getLevel (effective-ns-logger ns-symb))))
+
+(defn- logger-name
+  ^String [^LoggerConfig logger]
+  (.getName logger))
+
+(defn- exact-ns-logger
+  "Get the logger defined for `ns-symb` if it is an exact match; otherwise `nil` if a 'parent' logger will be used."
+  ^LoggerConfig [ns-symb]
+  (let [logger (effective-ns-logger ns-symb)]
+    (when (= (logger-name logger) (name ns-symb))
+      logger)))
+
+(defn- get-or-create-ns-logger!
+  "Get the logger currently used for `ns-symb`. If this logger is a parent logger, create a new logger specifically for
+  this namespace and return that."
+  ^LoggerConfig [ns-symb]
+  (or (exact-ns-logger ns-symb)
+      (let [parent-logger (effective-ns-logger ns-symb)
+            new-logger    (LoggerConfig/createLogger
+                           (.isAdditive parent-logger)
+                           (.getLevel parent-logger)
+                           (name ns-symb)
+                           (str (.isIncludeLocation parent-logger))
+                           ^"[Lorg.apache.logging.log4j.core.config.AppenderRef;"
+                           (into-array org.apache.logging.log4j.core.config.AppenderRef (.getAppenderRefs parent-logger))
+                           ^"[Lorg.apache.logging.log4j.core.config.Property;"
+                           (into-array org.apache.logging.log4j.core.config.Property (.getPropertyList parent-logger))
+                           (configuration)
+                           (.getFilter parent-logger))]
+        (.addLogger (configuration) (name ns-symb) new-logger)
+        (println "Created a new logger for" ns-symb)
+        new-logger)))
+
+(defn- logger-info [^LoggerConfig logger]
+  {:additive?         (.isAdditive logger)
+   :include-location? (.isIncludeLocation logger)
+   :level             (log-level->keyword (.getLevel logger))
+   :name              (.getName logger)
+   :properties        (.getProperties logger)})
+
+(s/defn set-ns-log-level!
+  "Set the log level for the namespace named by `ns-symb`. Intended primarily for REPL usage; for tests,
+  with [[with-log-messages-for-level]] instead. `ns-symb` may be a symbol that names an actual namespace, or can be a
+  prefix such as `metabase` that applies to all 'sub' namespaces that start with `metabase.` (unless a more specific
+  logger is defined for them).
+
+    (mt/set-ns-log-level! 'metabase.query-processor.middleware.cache :debug)"
+  [ns-symb new-level :- LogLevelKeyword]
+  (let [logger    (get-or-create-ns-logger! ns-symb)
+        new-level (->Level new-level)]
+    (.setLevel logger new-level)
+    (.updateLoggers (logger-context))))
+
 (defn do-with-log-messages-for-level [x thunk]
   (test-runner.parallel/assert-test-is-not-parallel "with-log-level")
-  (let [[namespace-symb level] (if (sequential? x)
-                                 x
-                                 ['metabase x])
-        _                      (assert (symbol? namespace-symb))
-        new-level              (or (get level-kwd->level (keyword level))
-                                   (throw (ex-info "Invalid log level" {:level level})))
-        ctx                    ^LoggerContext (LogManager/getContext true)
-        cfg                    (.getConfiguration ctx)
-        logger                 (.getLoggerConfig cfg (name namespace-symb))
-        old-level              (.getLevel logger)]
+  (let [[ns-symb level] (if (sequential? x)
+                          x
+                          ['metabase x])
+        old-level       (ns-log-level ns-symb)]
     (try
-      (.setLevel logger new-level)
-      (.updateLoggers ctx)
+      (set-ns-log-level! ns-symb level)
       (thunk)
       (finally
-        (.setLevel logger old-level)
-        (.updateLoggers ctx)))))
+        (set-ns-log-level! ns-symb old-level)))))
 
 (defmacro with-log-level
   "Sets the log level (e.g. `:debug` or `:trace`) while executing `body`. Not thread safe! But good for debugging from
@@ -130,3 +217,16 @@
   `(with-log-level ~level-kwd
      (with-log-messages
        ~@body)))
+
+(deftest set-ns-log-level!-test
+  (let [original-mb-log-level (ns-log-level 'metabase)]
+    (testing "Should be falling back to the root-level MB logger initially"
+      (is (= (effective-ns-logger 'metabase)
+             (effective-ns-logger 'metabase.test.util.log.fake))))
+    (testing "Should be able to set log level for a namespace"
+      (set-ns-log-level! 'metabase.test.util.log.fake :debug)
+      (is (= :debug
+             (ns-log-level 'metabase.test.util.log.fake))))
+    (testing "Should not affect parent loggers"
+      (is (= original-mb-log-level
+             (ns-log-level 'metabase))))))