Devel-DebugHooks

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use Module::Build;

my $build = Module::Build->new(
	module_name => 'Devel::DebugHooks',
	dist_author => 'Eugen Konkov <cpan@konkov.top>',
	requires => {
		'Scope::Cleanup' =>  0,
		'Sub::Metadata'  =>  0,
		'B::Deparse'     =>  0,
		'Data::Dump'     =>  0,
		'PadWalker'      =>  0,
		'Package::Stash' =>  0,
		'perl'           =>  '5.12.0',
	},
	recommends         => {
		'Log::Log4perl'   =>  0,            # Devel::DebugHooks::TraceAccess.pm
		'IO::Async::Loop' =>  0,            # bin/dclient.pl
	},
	test_requires      => {                 # Requires Module::Build 0.4004
		'Test::More'            =>  0,
		'Test::Output'          =>  0,

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",
            "perl" : "v5.12.0"
         }
      },
      "test" : {
         "requires" : {
            "Data::Section::Simple" : "0",
            "Test::CheckDeps" : "0",
            "Test::Differences" : "0",

META.yml  view on Meta::CPAN

    file: lib/Devel/DebugHooks/Verbose.pm
  Logger:
    file: lib/Devel/DebugHooks/TraceAccess.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'
  perl: v5.12.0
resources:
  IRC: irc://irc.perl.org/#debughooks
  bugtracker: https://github.com/KES777/Devel-DebugHooks/issues
  license: http://dev.perl.org/licenses/
  repository: https://github.com/KES777/Devel-DebugHooks
version: '0.07'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

Makefile.PL  view on Meta::CPAN

# Note: this file was auto-generated by Module::Build::Compat version 0.4231
require 5.012000;
use ExtUtils::MakeMaker;
WriteMakefile
(
  'PREREQ_PM' => {
                   'Scope::Cleanup' => 0,
                   'B::Deparse' => 0,
                   'Data::Dump' => 0,
                   'Sub::Metadata' => 0,
                   'PadWalker' => 0,
                   'Package::Stash' => 0
                 },
  'NAME' => 'Devel::DebugHooks',
  'EXE_FILES' => [
                   'bin/analizer.pl',
                   'bin/dclient.pl'
                 ],
  'INSTALLDIRS' => 'site',
  'VERSION_FROM' => 'lib/Devel/DebugHooks.pm',
  'PL_FILES' => {}

bin/dclient.pl  view on Meta::CPAN

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


__END__


# 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/Devel/DebugHooks.pm  view on Meta::CPAN

		# $@ is cleared when compiller enters *eval* or *BEGIN* block
		$@ =  $DB::context[4];
	CODE
	# http://perldoc.perl.org/functions/eval.html
	# We may define eval in other package if we want to place eval into other
	# namespace. It will still "doesn't see the usual surrounding lexical scope"
	# because "it is defined in the DB package"
	# sub My::eval {
	sub eval {
		my( $expr ) =  @_;
		# BUG: PadWalker does not show DB::eval's lexicals
		# Q? It is better that PadWalker return undef instead of warn when out of level

		print $DB::OUT "Evaluating '$expr'...\n"   if DB::state( 'ddd' );

		establish_cleanup \&eval_cleanup;
		DB::state( 'eval', 1 );

		my $package =  DB::state( 'package' );
		DB::state( 'inDB', undef );

lib/Devel/DebugHooks/Commands.pm  view on Meta::CPAN

		my $dbg_frames =  0;
		{ # Count debugger frames
			my @frame;
			1 while( @frame =  caller( $dbg_frames++ )  and  $frame[3] ne 'DB::DB' );
			$dbg_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';
		require 'Package/Stash.pm'; # BUG? spoils DB:: by emacs, dbline

		my $my =   PadWalker::peek_my(  $level +$dbg_frames );
		my $our =  PadWalker::peek_our( $level +$dbg_frames );

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

		if( $type & 2 ) {
			print $DB::OUT "\nOUR:\n", join( ', ', sort keys %$our ), "\n";

lib/Devel/DebugHooks/Commands.pm  view on Meta::CPAN

			# client's sub
			my $sub =  DB::state( 'stack' )->[ -$level -1 ]{ sub };
			if( !defined $sub ) {
				# TODO: Mojolicious::__ANON__[/home/feelsafe/perl_lib/lib/perl5/Mojolicious.pm:119]
				# convert this to subroutine refs
				# print $DB::OUT "Not in a sub: $sub\n";
				print $DB::OUT "Not in a sub\n";
			}
			else {
				$sub =  \&$sub;
				print $DB::OUT join( ', ', sort keys %{ PadWalker::peek_sub( $sub ) } ), "\n";
			}
		}

		if( $type & 16 ) {
			print $DB::OUT "\nCLOSED OVER:\n";

			# First elements starts at -1 subscript
			my $sub =  DB::state( 'stack' )->[ -$level -1 ]{ sub };
			if( !defined $sub ) {
				print $DB::OUT "Not in a sub\n";
				# print $DB::OUT (ref $sub ) ."Not in a sub: $sub\n";
			}
			else {
				$sub =  \&$sub;
				print $DB::OUT join( ', ', sort keys %{ (PadWalker::closed_over( $sub ))[0] } ), "\n";
			}
		}

		if( $var ) {
			my( $sigil, $name, $extra ) =  $var =~ m/^(.)(\w+)(.*)$/;

			$var =  $sigil .$name;
			unless( exists $my->{ $var } || exists $our->{ $var } ) {
				print $DB::OUT "Variable '$var' does not exists at this scope\n";
				return -1;