#!/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;