[Melbourne-pm] Caller depth

[Mathew Robertson]

I do this in one of my CPAN modules "Locale::MakePhrase" ...


package Locale::MakePhrase::Utils;
our $DEBUG = 0;
our $DIE_FROM_CALLER = 0;
use vars (@EXPORT);
@EXPORT = qw( die_from_caller );

=head2 void die_from_caller($message)

=over 2

Throw an exception, from a caller's perspective (ie not from within
the Locale::MakePhrase modules).  This allows us to generate an error
message for which the user can figure out what they did wrong.

Note: if you set C<Locale::MakePhrase::Utils::DIE_FROM_CALLER> to a
value other than zero, die_from_caller() will recurse that number of
levels further up the stack backtrace, before die()ing.  This allows
you to wrap your $makePhrase->translate(...) calls in a global
wrapper function; by setting the value to 1, the message is displayed
with respect to the calling code.

=back

=cut

sub die_from_caller {
  if ($DEBUG) {
    require Carp;
    Carp::confess "Locale::MakePhrase detected an error:";
  }
  my $caller_count = 0;
  while (1) {
    $caller_count++;
    my $caller = caller($caller_count);
    last if (!defined $caller || $caller !~ /^Locale::MakePhrase/);
  }
  my ($caller,$file,$line) = caller($caller_count);
  if (defined $caller) {
    for (1..$DIE_FROM_CALLER) {
      $caller_count++;
      ($caller,$file,$line) = caller($caller_count);
      last unless defined $caller;
    }
  }
  $caller = "main" unless defined $caller;
  my $msg = "Fatal: ". caller() ." detected an error in: $caller\n";
  $msg .= "File: $file\n";
  $msg .= "Line: $line\n";
  @_ and $msg .= join (" ", @_) . "\n";
  die $msg;
}

1;



leif.eriksen at hpa.com.au wrote:

>Well it seems that there isn't a really obvious solution.
>
>Nothing on PerlMonks oddly.
>
>What you want (I believe) is the depth of the internal "markstack" -
>however to do that means writing some XS code. Bleah.
>
>Perhaps one of the Devel:: modules may help. Try Devel::DumpStack,
>Devel::TraceFuncs or Devel::Peek. There may be some help also in the DB
>package too.
>
>Failing in all of those....
>
>Alternatively, you could create an iterator over caller(), that returns 
>1.undef when there are no more levels.
>2. A nicely indented string for each level
>
>
>Note following code is completely untested - just a pseudo-code brain
>dump
>Much work is required to actually make the idea work, but I have a
>conference call now...
>
># dump upto some (global?) depth
>my $callStackIter = getCallStackIterator(maxDepth => $::MAXSTACK);
>
>while (defined (my $callStackDump = $callStackIter->())) {
>	print TRACELOG $callStackDump;
>}
>
>sub getCallStackIterator {
>  my (%args) = @_;
>  my $depth = 1; # don't trace ourselves ?
>  return sub {
>    return if $depth++ > $args{maxDepth};
>    return formatStackDump($depth, caller($depth));
>  }
>}
>
>sub formatStackDump {
>  my ($currentDepth, @stackDump) = @_;
>
>  return sprint("%*s --> %s\n",
>                  $currentDepth, # force field width
>                  ' ',           # value of first %s
>                  $stackDump[3]); # fully qualified function name
>}
>
>Again - this code almost certainly doesn't work, but the idea is to
>localise the depth to each instance of the iterator. An advantage is
>that different iterators will maintain their own depth localisers, so
>you don't have to.
>
>The main problem (apart from it not working) with the above is to skip
>the stack frames related to dumping the caller stack itself - if that's
>important to you.
>
>Now to be completely embarrassed by the complete obvious solution.
>
>Leif
>-----Original Message-----
>Is there any known way to get the 'depth' 
>of the caller without counting?
>**********************************************************************
>IMPORTANT
>The contents of this e-mail and its attachments are confidential and intended
>solely for the use of the individual or entity to whom they are addressed.  If
>you received this e-mail in error, please notify the HPA Postmaster, postmaster at hpa.com.au,
>then delete  the e-mail.
>This footnote also confirms that this e-mail message has been swept for the
>presence of computer viruses by Ironport. Before opening or using any
>attachments, check them for viruses and defects.
>Our liability is limited to resupplying any affected attachments.
>HPA collects personal information to provide and market our services. For more
>information about use, disclosure and access see our Privacy Policy at
>www.hpa.com.au
>**********************************************************************
>_______________________________________________
>Melbourne-pm mailing list
>Melbourne-pm at pm.org
>http://mail.pm.org/mailman/listinfo/melbourne-pm
>  
>