Changeset 32306 for main

Timestamp:

2018-07-27T19:18:38+12:00 (6 years ago)

Author:

ak19

Message:

Adding 2 perl debug subroutines to util.pm, debug_print_caller() and debug_print_call_stack(). The first to print the calling function (optionally at a specified depth) and the second to print the entire call stack or up to a specified maxdepth. Recently also added Java versions of these methods to GLI.

File:

• main/trunk/greenstone2/perllib/util.pm (modified) (1 diff)

main/trunk/greenstone2/perllib/util.pm

@@ -662 +662 @@
 }
 
-
+# Debug function to print the caller at the provided depth or else depth=1 (to skip the function
+# that called this one, which is at depth 0).
+sub debug_print_caller {
+    my $depth = shift(@_);
+    $depth = 1 unless $depth; # start at 1 to skip printing the function that called this one
+    my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller($depth);
+    my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
+    print STDERR "** Calling method at depth $depth: $lcfilename:$cline $cpackage->$csubr\n";
+}
+
+# Debug function to print the call stack.
+# Optional param maxdepth: how many callers up the stack to print, *besides* this function's own
+# caller. If maxdepth parameter unspecified, prints the entire call stack.
+sub debug_print_call_stack {
+    my $maxdepth = shift(@_);
+    if($maxdepth) {
+    print STDERR "** CALL STACK UP TO AND INCL. MAX DEPTH OF $maxdepth:\n";
+    } else {
+    print STDERR "** FULL CALL STACK:\n";
+    }
+
+    my $depth = 0; # start by just printing this sub's calling function too
+    while(1) {
+    my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller($depth);
+    last unless defined $cfilename; # when call stack printed in full
+    my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/);
+    print STDERR "\t$lcfilename:$cline $cpackage->$csubr\n";
+    $depth++;
+    # print out caller at $maxdepth too, even though $depth starts at 0
+    # So this method prints out maxdepth+1 callers
+    last if($maxdepth && $depth > $maxdepth);
+    }    
+}
 
 # returns 1 if filename1 and filename2 point to the same