#!/usr/bin/perl -w
use strict;
#
my $SCRIPT_FILE = "indent-perl.pl";
my $SCRIPT_NAME = "Indent-Perl";
my $VERSION     = "1.1";
#
# Indent-Perl -- A script to make beautiful any messy perl script.
#
# Created by Dr.P <coder@neeley.org>.
# Birthed of necessity on 01.16.2005.
# Last scrutinized heavily on 02.16.2005.
#
# USAGE: perl indent-perl.pl file_name(s) [-a]
#
# "-a" option makes the program indent empty lines.  Use "-h" for usel
+ess help.
#
# Appends ".indented" to file names.  This script is meant only to be 
+used on 
# scripts written in Perl.  Using it on any other language will most l
+ikely 
# cause unexpected results.
#
# Next version is planned to included modularized handling for the scr
+ipt 
# parsing and checking.  Should be cool  ;)
#
# ~ dr.p

my @files = ();

my $new_fext = ".indented";
my $indent_size = 2;
my $indent_char = ' '; 

my %OPTS = (
  'help' => 0,
  'indent-all' => 0,
  'show_fn' => 1,
);
foreach my $fn (@ARGV) {
  if ($fn ne '') {
    if ($fn eq '-h' || $fn eq '--help') {
      $OPTS{'help'} = 1;
    }
    elsif ($fn eq '-a' || $fn eq '--idnent-all') {
      $OPTS{'indent-all'} = 1;
    }
    elsif (-f $fn) {
      push @files, $fn;
    }
  }
}

if ($OPTS{'help'}) {
  print "\n$SCRIPT_NAME $VERSION by Patrick Neeley 2005 <coder\@neeley
+.org>\n";
}

if ($OPTS{'help'} == 1) {
  print "\nUSAGE: perl $SCRIPT_NAME [-h|file names] [-a]\n\n".
        "-a  --indent-all    output all lines (even empty ones) with i
+ndent\n".
        "-h  --help          print this help stuff\n".
        "\n";
  exit(1);
}

if ($#files == -1) {
  print "\nNo valid files passed.\nDone.\n";
  exit(1);
}

print "\nProcessing files...\n\n";

for (my $i = 0; $i <= $#files; $i++) {
  my $fn = $files[$i];
  if ($OPTS{'show_fn'}) {
    print "$fn\n";
  }
  if (!(-f $fn)) {
    print "File does not exist. Skipping.\n";
  }
  elsif (!open(NEWFH, ">$fn".$new_fext)) {
    print "Could not open file: $!\n";
  }
  elsif (!open(OLDFH, $fn)) {
    print "Could not open file: $!\n";
    close(NEWFH);
  } else {
    my $indent = 0;
    my @bracket_stack = ();
    my $in_quotes = 0;
    my $in_text = 0;
    my $text_marker = "";
    my @stdregexs = ("\\{[^\\{\\}]*\\}", "\\([^\\(\\)]*\\)");
    while (my $orig_line = <OLDFH>)
    {
      $orig_line =~ s/[\n\r]+//g;

      my $line = $orig_line;

      # prep the line by removing all unwanted enclosures
      # note that the order of the following lines are important, so d
+on't change it
      $line =~ s/[\s\t]+//;       # no more whitespace, at all
      $line =~ s/\\.//g;          # no escaped characters
      $line =~ s/\"[^\"]*\"//g;   # nothing in double quotes
      $line =~ s/\'[^\']*\'//g;   # single quotes
      $line =~ s/\`[^\`]*\`//g;   # or back-ticks
      $line =~ s/(q[qwxr]?)\{[^\}]*\}//g;   # or generic quotes or bra
+ced enclosures
      $line =~ s/(q[qwxr]?)\([^\)]*\)//g;   # no gq with parens or par
+en enclosures
      $line =~ s/(q[qwxr]?)\/[^\/]*\///g;   # no gq with slahses or sl
+ashed enclosures
      $line =~ s/(q[qwxr]?)\#[^\#]*\#//g;   # no gq with pounds or pou
+nd enclosures
      $line =~ s/(q[qwxr]?)\|[^\|]*\|//g;   # no gq with pipes or pipe
+d enclosures
      $line =~ s/(s|m|tr)\/[^\/]*\/[^\/]*\/[gimosx]*//g;
      $line =~ s/(s|m|tr)\#[^\#]*\#[^\#]*\#[gimosx]*//g;
      $line =~ s/(s|m|tr)\,[^\,]*\,[^\,]*\,[gimosx]*//g;
      foreach my $regexp (@stdregexs) {
        while ($line =~ /$regexp/) {
          $line =~ s/$regexp//g;
        }
      }
      $line =~ s/\/[^\/]*\///g;        # lastly, no comments
      $line =~ s/\#.*$//g;        # lastly, no comments

      my $do_indent = 1;
      my $skip_processing = 0;

      # if we're in a large textual print out ("print <<YADA"), we don
+'t want
      # to touch the original lines at all until we're out of it
      if ($in_text) {
        if ($orig_line eq $text_marker) {
          $in_text = 0;
          $text_marker = "";
        }
        $do_indent = 0;
        $skip_processing = 1;
      }

      # similarly, we don't want indentation if we're in quoted text t
+hat takes
      # up multiple lines
      if (!$in_quotes && ($orig_line =~ /print .*?<< *(\"[^\"]+\"|\'[^
+\']+\'|[^\"\';]+);$/)) {
        $text_marker = $1;
        $text_marker =~ s/[\"\']//g;
        $in_text = 1;
        $skip_processing = 1;
      }

      if ($in_quotes) {
        $do_indent = 0;
      }

      # if we aren't dealing with quoted text of any kind, so we need 
+to check
      # to see if the line starts off with an ending bracket so that w
+e can 
      # decrease the indent immediately.
      my $did_lbc_undent = 0;
      if (!$skip_processing && $#bracket_stack > -1) {
        my $lbc = $bracket_stack[-1];
        if ($line =~ /^\Q$lbc\E/) {
          --$indent;
          $did_lbc_undent = 1;
          $in_quotes = 0;
          $skip_processing = 0;
        }
      }

      # check the indent all command line option
      if ($orig_line eq '' && !$OPTS{'indent-all'}) {
        $do_indent = 0;
      }

      # set the current indent string
      my $cur_indent = $do_indent ? ($indent_char x ($indent_size * $i
+ndent)): "";

      if ($do_indent) {
        $orig_line =~ s/^[\t\s]*//;
      }

      # print the original line with current indentation
      print NEWFH $cur_indent.$orig_line."\n";

      # if you want to see the mutilated line:
      #print NEWFH $cur_indent.$line."\n";

      # nothing to do if the mutilated line is empty or $skip_processi
+ng is set
      if ($skip_processing || $line eq '') {
        next;
      }

      # this is where I'll stop commenting for now :)
      my $pushed = 0;
      my $popped = 0;
      my @chars = split(//,$line);
      for (my $n = 0; $n <= $#chars; $n++) {
        my $c = $chars[$n];
        if ($c eq '') {
          next;
        }
        if ($#bracket_stack > -1 && $c eq $bracket_stack[-1]) {
          pop(@bracket_stack);
          $popped = 1;
          $in_quotes = 0;
          next;
        }
        if ($n > 1) {
          my $c3 = join('', @chars[int($n-2)..int($n)]);
          if ($c3 =~ /((qq|qx|qw|qr|tr)[\{\(\|])/) {
            push @bracket_stack, &determine_ec($c);
            $pushed = 1;
            $in_quotes = 1;
            next;
          }
        }
        if ($n > 0) {
          my $c2 = join('', @chars[int($n-1)..int($n)]);
          if ($c2 =~ /((m|s|q)[\{\(\|])/) {
            push @bracket_stack, &determine_ec($c);
            $pushed = 1;
            $in_quotes = 1;
            next;
          }
        }
        # now check $c if we got this far
        if ($c =~ /[\{\(\"\']/) {
          push @bracket_stack, &determine_ec($c);
          $pushed = 1;
          if ($c =~ /[\"\']/) {
            $in_quotes = 1;
          }
          next;
        }
      }
      if ($popped && !$did_lbc_undent) {
        --$indent;
      }
      if ($pushed) {
        ++$indent;
      }
    } # end while
    close(OLDFH);
    close(NEWFH);
    if ($#bracket_stack > -1) {
      my $en = ($#bracket_stack + 1);
      print "  ERROR -- ".$en." unmatched entr".(($en==1)?"y":"ies")."
+: ".join(', ',@bracket_stack)."\n";
    }
  }
}

print "\nFile list exhausted. Done.\n\n";

exit(1);


sub determine_ec (\$) {
  return ($_[0] eq '{')? '}': (($_[0] eq '(')? ')': $_[0]);
}