view release on metacpan or  search on metacpan

lib/Devel/STDERR/Indent.pm  view on Meta::CPAN

#!/usr/bin/perl

package Devel::STDERR::Indent;
use Moose;

no warnings 'recursion';

use Scalar::Util qw(weaken);

use namespace::clean -except => "meta";

use Sub::Exporter -setup => {
	exports => [qw(indent)],
};

our $VERSION = "0.06";

sub indent {
	my $h = __PACKAGE__->new(@_);
	$h->enter;
	return $h;
}

sub BUILDARGS {
	my ( $class, @args ) = @_;

	unshift @args, "message" if @args % 2 == 1;

	return {@args};
}

has message => (
	isa => "Str",
	is  => "ro",
	predicate => "has_message",
);

has indent_string => (
	isa => "Str",
	is  => "ro",
	default => "    ",
);

has enter_string => (
	isa => "Str",
	is  => "ro",
	default => " -> ",
);

has leave_string => (
	isa => "Str",
	is  => "ro",
	default => " <- ",
);

has _previous_hook => (
	is  => "rw",
	predicate => "_has_previous_hook",
);

has _active => (
	isa => "Bool",
	is  => "rw",
);	

sub DEMOLISH {
	my $self = shift;
	$self->leave;

lib/Devel/STDERR/Indent.pm  view on Meta::CPAN

	$self->_active(0);
}

sub warn {
	my ( $self, @output ) = @_;

	$self->emit( $self->format(@output) );
}

sub emit {
	my ( $self, @output ) = @_;

	if ( my $hook = $self->_previous_hook ) {
		$hook->(@output);
	} else {
		local $,;
		local $\;
		print STDERR @output;
	}
}

sub format {
	my ( $self, @str ) = @_;

	my $str = join "", @str;

	if ( $self->should_indent ) {
		my $indent = $self->indent_string;

		# indent every line
		$str =~ s/^/$indent/gm;

		return $str;
	} else {
		return $str;
	}
}

sub should_indent {
	my $self = shift;

	# always indent if there's an enter/leave message
	return 1 if $self->has_message;

	# indent if we're nested
	if ( $self->_has_previous_hook ) {
		my $hook = $self->_previous_hook;
		if ( blessed($hook) and $hook->isa("Devel::STDERR::Indent::Hook") ) {
			return 1;
		}
	}

	# otherwise we're at the top level, don't indent unnecessarily, it's distracting
	return;
}

sub install {
	my $self = shift;

	my $weak = $self;
	weaken($weak);

	if ( my $prev = $SIG{__WARN__} ) {
		$self->_previous_hook($prev);
	}

	$SIG{__WARN__} = bless sub { $weak->warn(@_) }, "Devel::STDERR::Indent::Hook";
}

sub uninstall {
	my $self = shift;

	if ( my $prev = $self->_previous_hook ) {
		$SIG{__WARN__} = $prev;
	} else {
		delete $SIG{__WARN__};
	}
}

__PACKAGE__;

__END__

=pod

=head1 NAME

Devel::STDERR::Indent - Indents STDERR to aid in print-debugging recursive algorithms.

=head1 SYNOPSIS

	use Devel::STDERR::Indent qw/indent/;

	sub factorial {
		my $h = indent; # causes indentation

		my $n = shift;
		warn "computing factorial $n"; # indented based on call depth

		if ($n == 0) {
			return 1
		} else {
			my $got = factorial($n - 1);
			warn "got back $got, multiplying by $n";
			return $n * $got;
		}
	}

=head1 DESCRIPTION

When debugging recursive code it's very usefl to indent traces, but often too
much trouble.

This module makes automates the indentation. When you call the C<indent>
function the indentation level is increased for as long as you keep the value
you got back. Once that goes out of scope the indentation level is decreased
again.

=head1 EXPORTS

All exports are optional, and may be accessed fully qualified instead.