File Coverage

blib/lib/Filter/HereDocIndent.pm

Criterion	Covered	Total	%
statement	60	67	89.5
branch	18	26	69.2
condition			n/a
subroutine	11	12	91.6
pod	0	4	0.0
total	89	109	81.6

package Filter::HereDocIndent;
use strict;
use Filter::Util::Call;
# use Debug::ShowStuff ':all';
use re 'taint';
use vars qw($VERSION $debug);

# documentation at end of file


# version
$VERSION = '0.91';

# constants
use constant REG => 1;
use constant HEREDOC => 2;
use constant POD => 3; # reserved for later improvement


#------------------------------------------------------------------
# new
#
sub new {
	my ($class, %opts) = @_;
	my $self = bless({}, $class);

	# default INDENT_CONTENT
	defined($opts{'INDENT_CONTENT'}) or $opts{'INDENT_CONTENT'} = 1;
	$self->{'INDENT_CONTENT'} = $opts{'INDENT_CONTENT'};

	# default state
	$self->{'state'} = REG;

	# return object
	return $self;
}
#
# new
#------------------------------------------------------------------


#------------------------------------------------------------------
# import routine: creates filter object and adds it
# to the filters array
#
sub import {
	my ($class, %opts) = @_;

	# add filter if set to do so
	if ( defined($opts{'filter_add'}) ? $opts{'filter_add'} : 1 ) {
		filter_add($class->new(%opts));
	}
}
#
# import routine
#------------------------------------------------------------------


#------------------------------------------------------------------
# filter: this sub is run for every line in the calling script
#
sub filter {
	my $self = shift;
	my $status = filter_read() ;
	my $line = $_;

	($status, $line) = $self->process_line($status, $line);

	# set line and return value
	$_= $line;
	$status;
}
#
# filter
#------------------------------------------------------------------



#------------------------------------------------------------------
# filter_block
#
sub filter_block {
	my ($self, $block) = @_;
	my (@lines, $status);

	# parse block into lines
	@lines = split("\n", $block);

	# loop through lines
	LINE_LOOP:
	foreach my $line (@lines) {
		($status, $line) = $self->process_line(1, "$line\n");
	}

	# return
	return join('', @lines);
}
#
# filter_block
#------------------------------------------------------------------



#------------------------------------------------------------------
# process_line
#
sub process_line {
	my ($self, $status, $line) = @_;

	# if we're at the end of the file
	if (! $status) {
		# for debugging this module
		if ($debug)
			{print STDERR "\n--------------------------\n"}
	}

	# if in here doc
	elsif ($self->{'state'} == HEREDOC) {
		# if this is the end of the heredoc
		if ($line =~ m|^(\s*)$self->{'del_regex'}\s*$|) {
			my $len = length($1);

			if ($self->{'INDENT_CONTENT'}) {
				foreach my $el (@{$self->{'lines'}}) {
					$el =~ s|^\s{$len}|| or $el =~ s|^\s+||;
					$el eq '' and $el = "\n";
				}
			}

			$line = join('', @{$self->{'lines'}}, $self->{'del'}, "\n");
			$self->{'state'} = REG;
		}

		# else add to lines array
		else {
			push @{$self->{'lines'}}, $line;
			$line = '';
		}
	}

	# else in regular code
	else {
		# if this line starts a heredoc
		if ($line =~ m/
			^              # start of line
			[^#]*          # anything except a comment marker
			<<
			\s*

			(
				'[^']+'
				|
				"[^"]+"
				|
				\w+
			)

			[^'"]*
			;
			\s*

			/sx
			) {

			$self->{'del'} = $1;
			$self->{'del'} =~ s|^'(.*)'$|$1| or $self->{'del'} =~ s|^"(.*)"$|$1|;
			$self->{'del_regex'} = quotemeta($self->{'del'});

			$self->{'lines'} = [];
			$self->{'state'} = HEREDOC;
		}
	}

	# for debugging this module
	print STDERR $line if $debug;

	return ($status, $line);
}
#
# process_line
#------------------------------------------------------------------



# return true
1;

__END__