Unindent.pm
#!/usr/bin/perl -w
use strict;
# ==============================================================================
# Heredoc::Unindent
# ==============================================================================
# A source filter that allows "here documents" to be indented consistent with
# The rest of your code, instead of being distractingly left-aligned.
# ------------------------------------------------------------------------------
# Author: Jeremy Holland
# ------------------------------------------------------------------------------
# Usage: call from your perl source code:
# use Heredoc::Unindent;
# You can now use here documents without left-aligning them:
#
# if ($print_usage) {
# print << END_OF_USAGE;
# line 1
# line 2
# line 3
# END_OF_USAGE
# }
# ------------------------------------------------------------------------------
# Rev History
# 2012-06-09 - J. Holland - Initial release
# 2012-08-01 - J.Holland - Added support for quoted here documents
#
# Known Bugs
# - Does not support "stacked" here documents (Camel p. 67)
# ------------------------------------------------------------------------------
package Heredoc::Unindent;
use Filter::Util::Call;
sub import {
# create and install the filter
filter_add(
bless {
line => 0,
heredoc_name => undef,
heredoc_indent => undef,
heredoc_body_indent => undef,
first_line => undef,
}
);
}
my $RGXCAP_plain_heredoc_start = qr/
^ # Start of line
([ \t]*) # CAPTURE $1: left-aligned spaces or tabs
.*? # other stuff
<< # Start of heredoc name (literal)
(\w+) # CAPTURE $2: heredoc name
[ \t]* # optional spaces or tabs
; # semicolon (end of statement)
# there can be more on the line but it doesn't matter here
/x;
my $RGXCAP_quoted_heredoc_start = qr/
^ # Start of line
([ \t]*) # CAPTURE $1: left-aligned spaces or tabs
.*? # other stuff
<< # Start of heredoc name (literal)
[ \t]* # optional spaces or tabs
(['"`]) # CAPTURE $2: open quote
(\w+) # CAPTURE $3: heredoc name
\2 # close quote (must match open quote)
[ \t]* # optional spaces or tabs
; # semicolon (end of statement)
# there can be more on the line but it doesn't matter here
/x;
sub filter {
my ($self) = @_;
# get the next line of code and make sure there was not an error
++$self->{line};
my $status = filter_read();
return $status if $status <= 0;
my $code = $_;
# check if this line begins an unquoted heredoc
if ($code =~ $RGXCAP_plain_heredoc_start) {
# check that we aren't already in a heredoc
if (defined $self->{heredoc_name}) {
die "Heredoc defined inside heredoc, line $self->{line}\n";
}
# record heredoc name and indent level; no source modification
$self->{heredoc_indent} = ($1 or "");
$self->{heredoc_name} = $2;
$self->{first_line} = 1;
}
# check if this line begins a quoted heredoc
elsif ($code =~ $RGXCAP_quoted_heredoc_start) {
# check that we aren't already in a heredoc
if (defined $self->{heredoc_name}) {
die "Heredoc defined inside heredoc, line $self->{line}\n";
}
# record heredoc name and indent level; no source modification
$self->{heredoc_indent} = ($1 or "");
$self->{heredoc_name} = $3;
$self->{first_line} = 1;
}
else { # this line does not look like the start of a heredoc
# check to see if we are inside a heredoc
if (defined $self->{heredoc_name}) {
# yes: check to see if this line ends the heredoc
if ($code =~ m/^([ \t]*)\Q$self->{heredoc_name}\E[ \t]*$/) {
# yes: un-indent heredoc EOF label
$code =~ s/^\s*//;
undef $self->{heredoc_name};
}
else {
# no - it's heredoc body text: un-indent heredoc text
if ($self->{first_line}) {
# if this is the first line of the heredoc body, see how much
# extra indentation there is so we can remove that much from
# every line of the heredoc.
$code =~ s/^$self->{heredoc_indent}([ \t]*)//;
$self->{heredoc_body_indent} = ($1 or "");
}
else {
# This is not the first line of the heredoc body, so remove the
# heredoc indentation and the body indentation
$code =~ s/^$self->{heredoc_indent}$self->{heredoc_body_indent}//;
}
}
undef $self->{first_line}; # not the first line of the heredoc anymore
}
# else we are not inside a heredoc - nothing to do
}
# return the (possibly modified) line of code
$_ = $code;
return $status;
}
1;