Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Indent Perl

by dr.p (Initiate)
on Jan 17, 2005 at 07:33 UTC ( [id://422686]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Dr.P <coder@neeley.org>
Description: Takes messy perl code and makes it beautiful. Doesn't matter if former indentation existed, or was done with spaces or tabs. Indent character is a space and indent size is set to 2 by default. These are easy to change near the top of the script. WARNING: Don't use on anything other than Perl code. Unawanted results will most likely occur.
#!/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]);
}
Replies are listed 'Best First'.
Re: Indent Perl
by dbwiz (Curate) on Jan 17, 2005 at 07:47 UTC
      No, actually, I hadn't. Thanks.
        PerlTidy's -fws and -fnl opts don't seem to work on Windows with the latest ActivePerl. That script I pasted does nothing more than indent the code, leaving quoted text that spans multiple lines as-is.
Re: Indent Perl
by zentara (Archbishop) on Jan 17, 2005 at 12:55 UTC
    This is what I use after cut'n'pasting code, to tidy it up. It will leave a *.ERR file if there are syntax errors.
    #!/usr/bin/perl -w use strict; my $infile = shift; my $outfile = "$infile.tmp"; open my $infh, '<', $infile or die "Cannot open $infile: $!\n"; open my $outfh, '>>', $outfile or die "Cannot open $outfile: $!\n"; while (<$infh>) { s/^\s+//g; s/\s+$//g; print $outfh $_, "\n" or die "Cannot write to $outfile: $!\n"; } close $outfh or die "Cannot close $outfile: $!\n"; close $infh or die "Cannot close $infile: $!\n"; system('perltidy', $outfile) == 0 or die "Perltidy failed\n"; rename "$outfile.tdy", $infile or die "Cannot rename $outfile.tdy: $!\ +n"; unlink $outfile or die "Cannot unlink $outfile: $!\n"; chmod 0755, $infile or die "Cannot chmod $infile: $!\n";

    I'm not really a human, but I play one on earth. flash japh
Re: Indent Perl
by Mago (Parson) on Jan 22, 2005 at 07:03 UTC

    * 4-column indent.
    * Opening curly on same line as keyword, if possible, otherwise line up.
    * Space before the opening curly of a multi-line BLOCK.
    * One-line BLOCK may be put on one line, including curlies.
    * No space before the semicolon.
    * Semicolon omitted in "short" one-line BLOCK.
    * Space around most operators.
    * Space around a "complex" subscript (inside brackets).
    * Blank lines between chunks that do different things.
    * Uncuddled elses.
    * No space between function name and its opening parenthesis.
    * Space after each comma.
    * Long lines broken after an operator (except "and" and "or").
    * Space after last parenthesis matching on current line.
    * Line up corresponding items vertically.
    * Omit redundant punctuation as long as clarity doesn't suffer.


    Mago
    mago@rio.pm.org


Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://422686]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (4)
As of 2024-03-29 06:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found