Changeset 32306 for main

Show
Ignore:
Timestamp:
27.07.2018 19:18:38 (13 months 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.

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • main/trunk/greenstone2/perllib/util.pm

    r32280 r32306  
    662662} 
    663663 
    664  
     664# Debug function to print the caller at the provided depth or else depth=1 (to skip the function 
     665# that called this one, which is at depth 0). 
     666sub debug_print_caller { 
     667    my $depth = shift(@_); 
     668    $depth = 1 unless $depth; # start at 1 to skip printing the function that called this one 
     669    my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller($depth); 
     670    my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/); 
     671    print STDERR "** Calling method at depth $depth: $lcfilename:$cline $cpackage->$csubr\n"; 
     672} 
     673 
     674# Debug function to print the call stack. 
     675# Optional param maxdepth: how many callers up the stack to print, *besides* this function's own 
     676# caller. If maxdepth parameter unspecified, prints the entire call stack. 
     677sub debug_print_call_stack { 
     678    my $maxdepth = shift(@_); 
     679    if($maxdepth) { 
     680    print STDERR "** CALL STACK UP TO AND INCL. MAX DEPTH OF $maxdepth:\n"; 
     681    } else { 
     682    print STDERR "** FULL CALL STACK:\n"; 
     683    } 
     684 
     685    my $depth = 0; # start by just printing this sub's calling function too 
     686    while(1) { 
     687    my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller($depth); 
     688    last unless defined $cfilename; # when call stack printed in full 
     689    my ($lcfilename) = ($cfilename =~ m/([^\\\/]*)$/); 
     690    print STDERR "\t$lcfilename:$cline $cpackage->$csubr\n"; 
     691    $depth++; 
     692    # print out caller at $maxdepth too, even though $depth starts at 0 
     693    # So this method prints out maxdepth+1 callers 
     694    last if($maxdepth && $depth > $maxdepth); 
     695    }     
     696} 
    665697 
    666698# returns 1 if filename1 and filename2 point to the same