base: logging enhancements: multiple debug output levels

doc/port.1

@@ -445,7 +445,27 @@ Verbose mode, generates verbose messages
 .PP
 \-d
 .RS 4
-Debug mode, generate debugging messages, implies \-v
+Debug mode, generate debugging messages at standard level, implies \-v
+.RE
+.PP
+\-0
+.RS 4
+Debug mode, generate debugging messages at standard level, implies \-v
+.RE
+.PP
+\-1
+.RS 4
+Debug mode, generate debugging messages at level one, implies \-d
+.RE
+.PP
+\-2
+.RS 4
+Debug mode, generate debugging messages at level two, implies \-d
+.RE
+.PP
+\-3
+.RS 4
+Debug mode, generate debugging messages at level three, implies \-d
 .RE
 .PP
 \-q

doc/port.1.txt

@@ -9,7 +9,7 @@ port - Command line interface for MacPorts
 SYNOPSIS
 --------
 [cmdsynopsis]
-*port* [*-bcdfknNopqRstuvy*] [*-D* 'portdir'|'portname'] [*-F* 'cmdfile'] ['action'] ['actionflags']
+*port* [*-bcdfknNopqRstuvy0123*] [*-D* 'portdir'|'portname'] [*-F* 'cmdfile'] ['action'] ['actionflags']
      [['portname' | 'pseudo-portname' | 'port-expressions' | 'port-url']]
      [['@version'] [+/-variant ...] ... [option=value ...]]
 
@@ -125,7 +125,19 @@ The port command recognizes several global flags and options.
     Verbose mode, generates verbose messages
 
 -d::
-    Debug mode, generate debugging messages, implies -v
+    Debug mode, generate debugging messages at standard level, implies -v
+
+-0::
+    Debug mode, generate debugging messages at standard level, implies -v
+
+-1::
+    Debug mode, generate debugging messages at level one, implies -d
+
+-2::
+    Debug mode, generate debugging messages at level two, implies -d
+
+-3::
+    Debug mode, generate debugging messages at level three, implies -d
 
 -q::
     Quiet mode, suppress informational messages to a minimum, implies -N

portmgr/packaging/packageall.tcl

@@ -37,7 +37,8 @@ set portdir .
 
 # UI Instantiations
 array set ui_options {}
-# ui_options(ports_debug) - If set, output debugging messages.
+# ui_options(ports_debug_x) - If set, output additional debugging messages up to level 'debug<level>'
+# ui_options(ports_debug) - If set, output debugging messages at standard level
 # ui_options(ports_verbose) - If set, output info messages (ui_info)
 # ui_options(ports_quiet) - If set, don't output "standard messages"
 
@@ -52,10 +53,30 @@ proc ui_isset {val} {
 	return 0
 }
 
+proc ui_debug_x_enabled {priority} {
+	global ui_options
+	set debug_enabled 0
+
+	if {[info exists ui_options(ports_debug_x)]} {
+		set ports_debug_x \
+			$ui_options(ports_debug_x)
+
+		if {[string compare ${priority} ${ports_debug_x}] <= 0} {
+			set debug_enabled 1
+		}
+	}
+
+	return ${debug_enabled}
+}
+
 # UI Callback
 
 proc ui_prefix {priority} {
-	switch $priority {
+	switch -regexp -- $priority {
+		debug[0-9] {
+			set debug_level [regsub {debug(\d)} ${priority} {\1}]
+			return "DEBUG${debug_level}: "
+		}
 		debug {
 			return "DEBUG: "
 		}
@@ -73,7 +94,14 @@ proc ui_prefix {priority} {
 
 proc ui_channels {priority} {
 	global logfd
-	switch $priority {
+	switch -regexp -- $priority {
+		debug[0-9] {
+			if {[ui_debug_x_enabled ${priority}]} {
+				return {stdout}
+			} else {
+				return {}
+			}
+		}
 		debug {
 			if {[ui_isset ports_debug]} {
 				return {stdout}

src/macports1.0/macports.tcl

@@ -79,7 +79,7 @@ namespace eval macports {
 
     variable open_mports {}
 
-    variable ui_priorities "error warn msg notice info debug any"
+    variable ui_priorities "error warn msg notice info debug debug1 debug2 debug3 any"
     variable current_phase main
 
     variable ui_prefix "---> "
@@ -125,7 +125,6 @@ proc macports::ui_isset {val} {
     return 0
 }
 
-
 # global_options accessor
 proc macports::global_option_isset {val} {
     if {[info exists macports::global_options($val)]} {
@@ -134,6 +133,21 @@ proc macports::global_option_isset {val} {
     return 0
 }
 
+proc macports::ui_debug_x_enabled {priority} {
+    set debug_enabled 0
+
+    if {[info exists macports::ui_options(ports_debug_x)]} {
+        set ports_debug_x \
+            $macports::ui_options(ports_debug_x)
+
+        if {[string compare ${priority} ${ports_debug_x}] <= 0} {
+            set debug_enabled 1
+        }
+    }
+
+    return ${debug_enabled}
+}
+
 proc macports::init_logging {mport} {
     if {[getuid] == 0 && [geteuid] != 0} {
         seteuid 0; setegid 0
@@ -318,7 +332,11 @@ proc macports::ui_init {priority args} {
 
 # Default implementation of ui_prefix
 proc macports::ui_prefix_default {priority} {
-    switch -- $priority {
+    switch -regexp -- $priority {
+        debug[0-9] {
+            set debug_level [regsub {debug(\d)} ${priority} {\1}]
+            return "DEBUG${debug_level}: "
+        }
         debug {
             return "DEBUG: "
         }
@@ -335,11 +353,19 @@ proc macports::ui_prefix_default {priority} {
 }
 
 # Default implementation of ui_channels:
-# ui_options(ports_debug) - If set, output debugging messages
+# ui_options(ports_debug_x) - If set, output additional debugging messages up to level 'debug<level>'
+# ui_options(ports_debug) - If set, output debugging messages at standard level
 # ui_options(ports_verbose) - If set, output info messages (ui_info)
 # ui_options(ports_quiet) - If set, don't output "standard messages"
 proc macports::ui_channels_default {priority} {
-    switch -- $priority {
+    switch -regexp -- $priority {
+        debug[0-9] {
+            if {[ui_debug_x_enabled ${priority}]} {
+                return stderr
+            } else {
+                return {}
+            }
+        }
         debug {
             if {[ui_isset ports_debug]} {
                 return stderr

src/pextlib1.0/Pextlib.c

@@ -135,6 +135,20 @@ static void ui_message(Tcl_Interp *interp, const char *severity, const char *for
     free(tclcmd);
 }
 
+__attribute__((format(printf, 3, 0)))
+static void ui_debug_x(Tcl_Interp *interp, unsigned int level, const char *format, va_list va) {
+    char cLevel[21];
+    int cLevel_size = ( sizeof(cLevel) - 1 );
+
+    // Ensure our dest string is null-terminated, even if overflow occurs
+    cLevel[cLevel_size] = '\0';
+
+    // Note: Specifying buf size one less than actual, so we'll always be null-terminated
+    // p.s. This shouldn't be needed for C99 and later. But better to be safe.
+    snprintf(cLevel, cLevel_size, "debug%u", level);
+    ui_message(interp, cLevel, format, va);
+}
+
 __attribute__((format(printf, 2, 3)))
 void ui_error(Tcl_Interp *interp, const char *format, ...) {
     va_list va;
@@ -187,6 +201,33 @@ void ui_debug(Tcl_Interp *interp, const char *format, ...) {
     va_end(va);
 }
 
+__attribute__((format(printf, 2, 3)))
+void ui_debug1(Tcl_Interp *interp, const char *format, ...) {
+    va_list va;
+
+    va_start(va, format);
+    ui_debug_x(interp, 1 /*debug level*/, format, va);
+    va_end(va);
+}
+
+__attribute__((format(printf, 2, 3)))
+void ui_debug2(Tcl_Interp *interp, const char *format, ...) {
+    va_list va;
+
+    va_start(va, format);
+    ui_debug_x(interp, 2 /*debug level*/, format, va);
+    va_end(va);
+}
+
+__attribute__((format(printf, 2, 3)))
+void ui_debug3(Tcl_Interp *interp, const char *format, ...) {
+    va_list va;
+
+    va_start(va, format);
+    ui_debug_x(interp, 3 /*debug level*/, format, va);
+    va_end(va);
+}
+
 int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
 {
     char *pattern, *string, *res;

src/pextlib1.0/Pextlib.h

@@ -35,6 +35,9 @@ void ui_msg(Tcl_Interp *interp, const char *format, ...) __attribute__((format(p
 void ui_notice(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
 void ui_info(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
 void ui_debug(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
+void ui_debug1(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
+void ui_debug2(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
+void ui_debug3(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
 
 /* Mount point file system case-sensitivity caching infrastructure. */
 typedef struct _mount_cs_cache mount_cs_cache_t;

src/pextlib1.0/tests/system.tcl

@@ -12,6 +12,15 @@ set failures 0
 proc ui_debug {args} {
     # ignored
 }
+proc ui_debug1 {args} {
+    # ignored
+}
+proc ui_debug2 {args} {
+    # ignored
+}
+proc ui_debug3 {args} {
+    # ignored
+}
 proc ui_info {args} {
     global output
     append output "$args\n"

src/port/port.tcl

@@ -50,7 +50,7 @@ package require Pextlib 1.0
 proc print_usage {{verbose 1}} {
     global cmdname
     set syntax {
-        [-bcdfknNopqRstuvy] [-D portdir|portname] [-F cmdfile] action [actionflags]
+        [-bcdfknNopqRstuvy0123] [-D portdir|portname] [-F cmdfile] action [actionflags]
         [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]...
     }
 
@@ -4614,7 +4614,7 @@ proc parse_options { action ui_options_name global_options_name } {
             # Process short arg(s)
             set opts [string range $arg 1 end]
             foreach c [split $opts {}] {
-                switch -- $c {
+                switch -regexp -- $c {
                     v {
                         set ui_options(ports_verbose) yes
                     }
@@ -4623,6 +4623,13 @@ proc parse_options { action ui_options_name global_options_name } {
                         # debug implies verbose
                         set ui_options(ports_verbose) yes
                     }
+                    [0-3] {    # Debug levels: 0 (synonymous with -d), plus 1-3
+                        set ui_options(ports_debug) yes
+                        # debug implies verbose
+                        set ui_options(ports_verbose) yes
+
+                        set ui_options(ports_debug_x) "debug${c}"
+                    }
                     q {
                         set ui_options(ports_quiet) yes
                         # quiet implies noninteractive

src/port/portindex.tcl

@@ -309,6 +309,12 @@ for {set i 0} {$i < $argc} {incr i} {
         {^-.+} {
             if {$arg eq "-d"} { # Turn on debug output
                 set ui_options(ports_debug) yes
+            } elseif {[regexp {\-[0-3]} ${arg}] == 1} { # Turn on debugX output
+                set ui_options(ports_debug) yes
+
+                set debug_level [regsub {\-(\d)} ${arg} {\1}]
+                set ui_options(ports_debug_x) "debug${debug_level}"
+                unset debug_level
             } elseif {$arg eq "-o"} { # Set output directory
                 incr i
                 set outdir [file join [pwd] [lindex $argv $i]]

src/port1.0/port.tcl

@@ -54,9 +54,9 @@ namespace eval port {
 	proc run_callbacks {} {
 		variable _callback_list
 		foreach callback ${_callback_list} {
-			ui_debug "Running callback ${callback}"
+			ui_debug1 "Running callback ${callback}"
 			${callback}
-			ui_debug "Finished running callback ${callback}"
+			ui_debug1 "Finished running callback ${callback}"
 		}
 		set _callback_list [list]
 	}