view release on metacpan or  search on metacpan

lib/Fred/Fish/DBUG/ON.pm  view on Meta::CPAN

=cut

# ==============================================================
sub DBUG_POP
{
   warn "DBUG_POP() is currently a NO-OP!\n";
}


=item DBUG_ENTER_FUNC ( [@arguments] )

Its expected to be called whenever you enter a function.  You pass all the
arguments from the calling function to this one (B<@_>).  It automatically
knows the calling function without having to be told what it is.

To keep things in the B<fish> logs balanced, it expects you to call one of the
I<DBUG_RETURN> variant methods when exiting your function!

This function also works when called inside named blocks such as B<eval> blocks
or even try/catch blocks.

It returns the name of the calling function.  In rare cases this name can be
useful.

See I<DBUG_MASK_NEXT_FUNC_CALL> should you need to mask any arguments!

=cut

# ==============================================================
sub DBUG_ENTER_FUNC
{
   # Who called this function ...
   my $func = (caller (1))[3] || $dbug_global_vars{main};

   # Check if eval needs rebalancing ...
   _dbug_auto_fix_eval_exception ();

   # Count how deep in eval blocks we are so DBUG_CATCH can work!
   my ($eval_cnt, $eval_lns) = _eval_depth (1);
   my $eval_flg = 0;
   if ( $func eq "(eval)" ) {
      $func .="  [${eval_cnt}, " . $eval_lns->[0] . "]";
      $eval_flg = 1;
   }

   # This special function traps calls to undefined functions.
   # So we want to know what the user was really calling by
   # referencing the special variable named after the function!
   if ( $func =~ m/::AUTOLOAD$/ ) {
      no strict;      # So can indirectly access the variable as a ref.
      my $aka = ${$func};
      $aka = $1   if ( $dbug_global_vars{strip} && $aka =~ m/::([^:]+)$/ );
      $func .= " <aka ${aka}>";
   }

   # Do we need to know who called ${func} at this time ???
   my $line="";
   if ( $dbug_global_vars{who_called} && $func ne $dbug_global_vars{main} ) {
      # Special functions where there are no valid callers ...
      if ( $eval_flg || $func =~ m/::END$/ || $func =~ m/::BEGIN$/ ||
           $func =~ m/::UNITCHECK$/ || $func =~ m/::CHECK$/ || $func =~ m/::INIT$/ ||
           $func =~ m/::DESTROY$/ ) {
         $line = _dbug_called_by (0, 0, 0);

      # When Try::Tiny renames the __ANON__ function to ... "YourModule::xxx {...}"
      # It doesn't always do this ...
      } elsif ( $func =~ m/::try [{][.]{3}[}]\s*$/ ||
                $func =~ m/::catch [{][.]{3}[}]\s*$/ ||
                $func =~ m/::finally [{][.]{3}[}]\s*$/ ) {
         $line = _dbug_called_by (0, 0, 0);

      # Want who called the logged function, not who called DBUG_ENTER_FUNC ...
      } else {
         my $may_be_a_try_catch_finally_event = ( $func =~ m/::__ANON__$/ );
         $line = _dbug_called_by (0, 1, $may_be_a_try_catch_finally_event);
         $line = _dbug_called_by (0, 0, 0)   unless ( $line );
      }
   }

   # Put a blank line before all END blocks ...
   my $skip = ( $func =~ m/::END$/ ) ? "\n" : "";

   # Strip off any module info from the calling function's name?
   $func = $1   if ( $dbug_global_vars{strip} && $func =~ m/::([^:]+)$/ );

   my @colors = _get_filter_color (DBUG_FILTER_LEVEL_FUNC);
   if ( DBUG_EXECUTE ( DBUG_FILTER_LEVEL_FUNC ) ) {
      _printing ( $skip, $colors[0], _indent (">${func}${line}"), $colors[1], "\n");
   }

   my %block = ( NAME    => $func,
                 PAUSED  => $dbug_global_vars{pause},
                 EVAL    => $eval_cnt,
                 EVAL_LN => $eval_lns->[0],
                 LINE    => $line,
                 FUNC    => 1,
                 COLOR1  => $colors[0],
                 COLOR2  => $colors[1] );
   $block{TIME} = time ()  if ( $dbug_global_vars{elapsed} );
   $block{MULTI} = _indent_multi (1)  if ( $dbug_global_vars{multi} );

   push ( @{$dbug_global_vars{functions}}, \%block );

   _dbug_args ( @_ );

   return ( $func );
}


# Helper method to DBUG_ENTER_FUNC & DBUG_ENTER_BLOCK!
# Called almost as frequently as DBUG_PRINT ...
sub _dbug_args
{
   my @args = @_;

   $dbug_global_vars{mask_last_argument_count} = 0;

   # If nothing to write to fish ...
   if ( $#args == -1 ) {
      delete $dbug_global_vars{mask_func_call};
      return;