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

Devel-STDERR-Indent documentation Contained in the Devel-STDERR-Indent distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

	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;
		}
	}

DESCRIPTION

Top

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 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.

EXPORTS

Top

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

indent

Top

Returns an object which you keep around for as long as you want another indent level:

	my $h = $indent;
	# ... all warnings are indented by one additional level
	$h = undef; # one indentation level removed

Instantiates a new indentation guard and calls enter on it before returning it.

Parameters are passed to new:

	indent "foo"; # will print enter/leave messages too

METHODS

Top

Creates the indentation helper, but does not install it yet.

If given a single argument it is assumed to be for the message attribute.

Output a warning with the previous installed hook.

Indent a message.

Calls format and then emit.

Calls install the hook and outputs the optional message.

Calls uninstall the hook and outputs the optional message.

Installs the hook in $SIG{__WARN__}.

Uninstalls the hook restoring the previous value.

ATTRIBUTES

Top

If supplied will be printed in enter prefixed by enter_string and in leave prefixed by leave_string.

Defaults to ' ' (four spaces).

Defaults to ' -> '.

Defaults to ' <- '.

VERSION CONTROL

Top

http://nothingmuch.woobling.org/code

Devel-STDERR-Indent documentation Contained in the Devel-STDERR-Indent distribution. 
#!/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;
}

sub enter {
	my $self = shift;

	return if $self->_active;

	$self->install;

	if ( $self->has_message ) {
		$self->emit( $self->enter_string . $self->message, "\n" );
	}

	$self->_active(1);
}

sub leave {
	my $self = shift;

	return unless $self->_active;

	if ( $self->has_message ) {
		$self->emit( $self->leave_string . $self->message, "\n" );
	}

	$self->uninstall;

	$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__