DB-Hooks

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use Module::Build;

my $build = Module::Build->new(
	module_name => 'DB::Hooks',
	dist_author => 'Eugen Konkov <debugger@konkov.top>',
	requires => {
		'Scope::Cleanup' =>  0,
		'Sub::Metadata'  =>  0,
		'B::Deparse'     =>  0,
		'Data::Dump'     =>  0,
		'PadWalker'      =>  0,
		'Package::Stash' =>  0,
		'perl'           =>  '5.12.0',
		'Term::ReadLine::Tiny'    => 0,
		'Syntax::SourceHighlight' => 0,
	},
	recommends         => {
		'Log::Log4perl'   =>  0,            # Devel::DebugHooks::TraceAccess.pm
		'IO::Async::Loop' =>  0,            # bin/dclient.pl
	},
	test_requires      => {

META.json  view on Meta::CPAN

      },
      "runtime" : {
         "recommends" : {
            "IO::Async::Loop" : "0",
            "Log::Log4perl" : "0"
         },
         "requires" : {
            "B::Deparse" : "0",
            "Data::Dump" : "0",
            "Package::Stash" : "0",
            "PadWalker" : "0",
            "Scope::Cleanup" : "0",
            "Sub::Metadata" : "0",
            "Syntax::SourceHighlight" : "0",
            "Term::ReadLine::Tiny" : "0",
            "perl" : "v5.12.0"
         }
      },
      "test" : {
         "requires" : {
            "Data::Section::Simple" : "0",

META.yml  view on Meta::CPAN

    file: lib/DB/Utils.pm
  Logger:
    file: lib/DB/Hooks/TraceVariable.pm
recommends:
  IO::Async::Loop: '0'
  Log::Log4perl: '0'
requires:
  B::Deparse: '0'
  Data::Dump: '0'
  Package::Stash: '0'
  PadWalker: '0'
  Scope::Cleanup: '0'
  Sub::Metadata: '0'
  Syntax::SourceHighlight: '0'
  Term::ReadLine::Tiny: '0'
  perl: v5.12.0
resources:
  IRC: irc://irc.perl.org/#debughooks
  repository: https://github.com/KES777/DB-Hooks
version: '0.0201'
x_serialization_backend: 'CPAN::Meta::YAML version 0.020'

Makefile.PL  view on Meta::CPAN

  'INSTALLDIRS' => 'site',
  'NAME' => 'DB::Hooks',
  'PL_FILES' => {},
  'PREREQ_PM' => {
                   'Term::ReadLine::Tiny' => 0,
                   'Package::Stash' => 0,
                   'Data::Dump' => 0,
                   'Syntax::SourceHighlight' => 0,
                   'B::Deparse' => 0,
                   'Sub::Metadata' => 0,
                   'PadWalker' => 0,
                   'Scope::Cleanup' => 0
                 }
)
;

bin/dclient.pl  view on Meta::CPAN

$loop->add( $timer );
$loop->run;


__END__

MST example:
https://st.aticpan.org/source/MSTROUT/App-Procapult-0.009001/lib/Proc/Apult/Client.pm

# Devel::Caller - like 'caller'
# PadWalker <- debug statements
# Package::Stash - shows package variables
# View op tree: B::Concise
# B::Deparse - deparse CODEREF
#     $deparse = B::Deparse->new("-p", "-sC");
#     print $deparse->coderef2text( \&DB::process );
# B::DeparseTree
# Devel::Size - занятое пространство под переменную
# http://search.cpan.org/~abigail/perl-5.23.5/pod/perldebguts.pod#Using_$ENV{PERL_DEBUG_MSTATS}
# http://www.foo.be/docs/tpj/issues/vol3_2/tpj0302-0011.html
# Devel::Peek - shows info about variables as it exists at internals

lib/DB/Commands.pm  view on Meta::CPAN

    my $pkg =  DB::state( 'package' );
    my $stash =  Package::Stash->new( $pkg )->get_all_symbols();

    return $stash, $pkg;
}



sub get_variables {
    require 'PadWalker.pm';
    # my @subs;
    # my $package_name =  caller( DB::state( 'level.frame' ) )[0];
    # foreach $name ( keys %{$package_name .'::'} ) {
    #   push @subs, $name;
    # }

    my $my  =  PadWalker::peek_my ( DB::state( 'level.frame' ) );
    my $our =  PadWalker::peek_our( DB::state( 'level.frame' ) );



    return $my, $our;
}



sub cmd_variables {
	my( $level, $flags, $expr ) =

lib/DB/Commands.pm  view on Meta::CPAN

		}
		while( @frame =  caller( $frames++ )  and  $level-- > 0 ) {
			$evals++   if $frame[3] eq '(eval)';
		}
		$frames--;
	}



	#FIX: When we debug debugger we can not 'go <line>' we always stops at
	#require at third line at PadWalker.pm. Debug who set $DB::state = 1
	require 'PadWalker.pm';

	my $my  =  PadWalker::peek_my ( $frames -$evals );
	my $our =  PadWalker::peek_our( $frames -$evals );

	if( $type & 1 ) {
		# TODO: for terminals which support color show
		# 1. not used variables as grey
		# 2. closed over variables as green or bold
		DB::say "MY:", join( ', ', sort keys %$my );
	}

	if( $type & 2 ) {
		DB::say "OUR:", join( ', ', sort keys %$our );

lib/DB/Commands.pm  view on Meta::CPAN

		# the $sub contain reference to &vars instead of name of last
		# client's sub
		my $sub =  DB::frames( $level +2 )->[-1][4];
		if( !defined $sub ) {
			# TODO: Mojolicious::__ANON__[/home/feelsafe/perl_lib/lib/perl5/Mojolicious.pm:119]
			# convert this to subroutine refs
			DB::say "Not in a sub: $sub";
		}
		else {
			$sub =  \&$sub;
			DB::say join( ', ', sort keys %{ PadWalker::peek_sub( $sub ) } );
		}
	}

	if( $type & 16 ) {
		DB::say "CLOSED OVER:";

		# First elements starts at -1 subscript
		my $sub =  DB::frames( $level +2 )->[-1][4];
		if( !defined $sub ) {
			DB::say "Not in a sub: $sub";
		}
		else {
			$sub =  \&$sub;
			DB::say join( ', ', sort keys %{ (PadWalker::closed_over( $sub ))[0] } );
		}
	}

	if( $expr ) {
		(my $vars, $expr) =  split ';', $expr, 2;                          # We can explicitly define variables by enumerating them
		my @vars =  ( $vars || $expr ) =~ m/([\$\%\@]\w+)/g;               # Extract variables from varlist or expression
		$expr //=  $vars;                                                  # By default just dump variables
		@vars =  keys %{{ map{ $_ => 1 } @vars }};                         # Make vars uniq

		# PadWalder returns references to variables. We derefference them at