#!/usr/bin/perl

use warnings;
use strict;
use Fcntl ':flock';
use File::Copy;
use Tie::File;

############################################################
# Author: jpfarmer @ Perlmonks                             #
# http://www.perlmonks.org/index.pl?node_id=126392         #
#                                                          #
# This program takes one argument, the name of the source  #
# to clean up.  It copies that file to <filename>.bak      #
# and then operates on the original.  It creates formatted #
# comments when they are properly marked.  Example:        #
#                                                          #
#   #/*                                                    #
#   # This subroutine ...                                  #
#   #*/                                                    #
#                                                          #
# becomes                                                  #
#                                                          #
#  #######################                                 #
#  # This subroutine ... #                                 #
#  #######################                                 #
#                                                          #
############################################################

####################
# Global Variables #
####################
our $fn = shift @ARGV;
our $fn_bak = "$fn.bak";
our $border_char = '#';
our @program;

####################
# Begin Program    #
####################

# Backup program
copy($fn, $fn_bak);

# Tie the file to an array so we can manipulate it easily.
tie @program, 'Tie::File', $fn;

# Begin iterating over the file and converting comments.
# If the comments are improperly formed, then we do not
# do anything.  Better to do nothing then to blow something
# up.

my $slurp_start;
my $slurp_end;
my @slurp_lines;

for (my $i = 0; $i < $#program; $i++){
    my $line = $program[$i];
    if (! defined $slurp_start){
	# Skip to the next line if this isn't a comment
	next unless ($line =~ m{^#});
				
	# If we end up with a comment, we need to figure out if
        # it is telling us to start slurping
	next unless ($line =~ m{^#/\*});
	
	# If we get to this point, we need to start slurping.
	# So, we mark the beginning index and next.
	$slurp_start = $i;
	print STDERR "Found a block starting at line $i.\n";
	next;
    } else{
	# We need to see if we've come across either an uncommented
	# or a block end.  A block end means we need to set $slurp_end
	# and make our changes.  If it's uncommened, we'll undef slurp_start 
	# and slurp_end and empty slurp_lines.  If it's just a commented
	# line, chomp it and store it.
	if ($line =~ m/^[^#]/){
	    $slurp_start = undef;
	    $slurp_end = undef;
            @slurp_lines = ();
	    next;	   
	} elsif ($line =~ m{^#\*/}){
	    $slurp_end = $i;
            print STDERR "Block ended at line $i.\n";		    
	    &create_block;
	    next;
	} else {
	    chomp $line;
	    push(@slurp_lines, $line);
            print STDERR "$line\n";				
	}
    }
 	       
}

########################################################################
# This takes no arguments, and operates on global variables.  It takes #
# a discovered block comment, and processes it commiting the changes   #
# to the file.                                                         #
########################################################################
sub create_block {
    # First, we need to calculate the length of the longest line, then 
    # add 2 to it (for a trailing space and the boundry marker) to find
    # our box width.
    my $box_width = &max(map {length($_) + 2} @slurp_lines);

    # Now, replace the first and last lines with solid bars
    # $border_char
    $program[$slurp_start] = $program[$slurp_end] = $border_char x $box_width;
    
    # Finally, stick the remaining lines in between border_chars
    for (my $i = ($slurp_start + 1); $i < $slurp_end; $i++){
	$program[$i] = sprintf("%-" . ($box_width - 2) . "s #", $program[$i]);
    }

    # Clear out the globals, and we're done.
    $slurp_start = undef;
    $slurp_end = undef;
    @slurp_lines = ();
}

####################################################################
# This takes one argument, an array, and returns the maximum value #
# The code is swiped from the perlsub page.                        #
####################################################################
sub max(@list) {
    my $max = shift(@_);
    foreach my $foo (@_) {
	$max = $foo if $max < $foo;
    }
    return $max;
}