App-Context

 view release on metacpan or  search on metacpan

lib/App.pm  view on Meta::CPAN

This is called at the beginning of a subroutine or method (even before $self
may be shifted off).

=cut

sub sub_entry {
    if ($App::trace) {
        my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
        $stacklevel = 1;
        ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        while (defined $subroutine && $subroutine eq "(eval)") {
            $stacklevel++;
            ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        }
        my ($name, $obj, $class, $package, $sub, $method, $firstarg, $trailer);

        # split subroutine into its "package" and the "sub" within the package
        if ($subroutine =~ /^(.*)::([^:]+)$/) {
            $package = $1;
            $sub = $2;
        }

        # check if it might be a method call rather than a normal subroutine call

lib/App.pm  view on Meta::CPAN

    * Throws:    none
    * Since:     0.01

This subroutine is called just before you return from a subroutine or method.
=cut

sub sub_exit {
    if ($App::trace) {
        my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
        $stacklevel = 1;
        ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        while (defined $subroutine && $subroutine eq "(eval)") {
            $stacklevel++;
            ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        }

        my ($package, $sub);
        # split subroutine into its "package" and the "sub" within the package
        if ($subroutine =~ /^(.*)::([^:]+)$/) {
            $package = $1;
            $sub = $2;
        }

        return if (%App::scope && !$App::scope{$package} && !$App::scope{"$package.$sub"});

lib/App.pm  view on Meta::CPAN

  if (&App::in_debug_scope) {
      print "This is debug output\n";
  }

=cut

sub in_debug_scope {
    if ($App::debug) {
        my ($stacklevel, $calling_package, $file, $line, $subroutine, $hasargs, $wantarray, $text);
        $stacklevel = 1;
        ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        while (defined $subroutine && $subroutine eq "(eval)") {
            $stacklevel++;
            ($calling_package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
        }
        my ($package, $sub);

        # split subroutine into its "package" and the "sub" within the package
        if ($subroutine =~ /^(.*)::([^:]+)$/) {
            $package = $1;
            $sub = $2;
        }

        if (%App::scope) {

lib/App/Context.pm  view on Meta::CPAN

sub dbg {
    my ($self, $level) = @_;
    return 0 if (! $App::DEBUG);
    $level = 1 if (!defined $level);
    return 0 if (defined $level && $App::DEBUG < $level);
    my ($debug_scope, $stacklevel);
    my ($package, $file, $line, $subroutine, $hasargs, $wantarray);
    $debug_scope = (ref($self) eq "") ? \%debug_scope : $self->{debug_scope};
    $stacklevel = 1;
    ($package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
    while (defined $subroutine && $subroutine eq "(eval)") {
        $stacklevel++;
        ($package, $file, $line, $subroutine, $hasargs, $wantarray) = caller($stacklevel);
    }
    return 1 if (! defined $debug_scope);
    return 1 if (! %$debug_scope);
    return 1 if (defined $debug_scope->{$package});
    return 1 if (defined $debug_scope->{$subroutine});
    return 0;
}

#############################################################################
# dbgprint()