use strict;
use Getopt::Std;
use Text::Autoformat;
$| = 1;
use vars qw($opt_l $opt_h);
my $usage = <<EOM;
usage: perlcomment [ -ln ] filename >outfile
where n=line length (default 72)
EOM
getopts('hl:') or die "$usage";
if ($opt_h) {die $usage}
if ( !defined $opt_l ) {
$opt_l = 72;
}
else {
$opt_l =~ /^\d+$/ or die "$usage";
}
unless ( @ARGV == 1 ) { die $usage }
my $file = $ARGV[0];
autoformat_file( $file, $opt_l );
sub autoformat_file {
my ( $file, $line_length ) = @_;
use Perl::Tidy;
use IO::File;
my $fh = IO::File->new( $file, 'r' );
unless ($fh) { die "cannot open '$file': $!\n" }
my $formatter = CommentFormatter->new($line_length);
my $err=perltidy(
'formatter' => $formatter, 'source' => $fh,
'argv' => "-npro -se", );
if ($err) {
die "Error calling perltidy\n";
}
$fh->close();
}
package CommentFormatter;
sub new {
my ( $class, $line_length ) = @_;
my $comment_block = "";
bless {
_rcomment_block => \$comment_block,
_maximum_comment_length => 0,
_line_length => $line_length,
_in_hanging_side_comment => 0,
},
$class;
}
sub write_line {
my $self = shift;
my $line_of_tokens = shift;
my $line_type = $line_of_tokens->{_line_type};
my $input_line = $line_of_tokens->{_line_text}; my $rtoken_type = $line_of_tokens->{_rtoken_type}; my $rtokens = $line_of_tokens->{_rtokens};
if (
$line_type ne 'CODE' || !@$rtokens || $$rtoken_type[-1] ne '#' )
{
$self->print($input_line);
$self->{_in_hanging_side_comment} = 0;
return;
}
if (@$rtokens > 1) {
$self->print($input_line);
$self->{_in_hanging_side_comment} = 1;
return;
}
if ($self->{_in_hanging_side_comment}) {
$self->print($input_line);
return;
}
if ( $$rtokens[-1] !~ /\w/ ) {
$self->print($input_line);
}
else {
$self->append_comment($input_line);
}
return;
}
sub print {
my ( $self, $input_line ) = @_;
$self->flush_comments();
print $input_line;
}
sub append_comment {
my ( $self, $input_line ) = @_;
my $rcomment_block = $self->{_rcomment_block};
my $maximum_comment_length = $self->{_maximum_comment_length};
$$rcomment_block .= $input_line;
if (length($input_line) > $maximum_comment_length) {
$self->{_maximum_comment_length}=length($input_line);
}
}
{
my ( $separator1, $separator2, $separator3 );
BEGIN {
$separator1 = '-' x 2 . ' Original ' . '-' x 60 . "\n";
$separator2 = '-' x 2 . ' Modified ' . '-' x 60 . "\n";
$separator3 = '-' x 72 . "\n";
}
sub flush_comments {
my ($self) = @_;
my $rcomment_block = $self->{_rcomment_block};
my $line_length = $self->{_line_length};
my $maximum_comment_length = $self->{_maximum_comment_length};
if ($$rcomment_block) {
my $comments = $$rcomment_block;
if ( $maximum_comment_length > $line_length ) {
my $formatted_comments =
Text::Autoformat::autoformat( $comments,
{ right => $line_length, all => 1 } );
if ( $formatted_comments ne $comments ) {
print STDERR $separator1;
print STDERR $$rcomment_block;
print STDERR $separator2;
print STDERR $formatted_comments;
print STDERR $separator3;
if ( ifyes("Accept Changes? [Y/N]") ) {
$comments = $formatted_comments;
}
}
}
print $comments;
$$rcomment_block = "";
$self->{_maximum_comment_length}=0;
}
}
}
sub query {
my ($msg) = @_;
print STDERR $msg;
my $ans = <STDIN>;
chomp $ans;
return $ans;
}
sub queryu {
return uc query(@_);
}
sub ifyes {
my $count = 0;
ASK:
my $ans = queryu(@_);
if ( $ans =~ /^Y/ ) { return 1 }
elsif ( $ans =~ /^N/ ) { return 0 }
else {
$count++;
if ( $count > 6 ) { die "error count exceeded in ifyes\n" }
print STDERR "Please answer 'Y' or 'N'\n";
goto ASK;
}
}
sub finish_formatting {
my $self = shift;
$self->flush_comments();
}