#!/usr/bin/perl -w
#
# Walk through a perl script and reformat perl comments
# using Text::Autoformat.
#
# usage:
# perlcomment -l72 myfile.pl >myfile.new
#
# where -l specifies the maximum comment line length.
#
# You will be given an opportunity to accept or reject each proposed
# change.
#
# This file demonstrates using Perl::Tidy to walk through a perl file
# and find all of its comments. It offers to reformat each group of
# consecutive full-line comments with Text::Autoformat.
#
# This may or may not be useful, depending on your coding style.
# Change it to suit your own purposes; see sub get_line().
#
# Uses: Text::Autoformat
# Perl::Tidy
#
# Steve Hancock, March 2003
# Based on a suggestion by Tim Maher
#
# TODO: (just ideas that probably won't get done)
# -Handle lines of stars, dashes, etc better
# -Need flag to limit changes to lines greater than some minimum length
# -reformat side and hanging side comments
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, # callback object
'source' => $fh,
'argv' => "-npro -se", # dont need .perltidyrc
# errors to STDOUT
);
if ($err) {
die "Error calling perltidy\n";
}
$fh->close();
}
#####################################################################
#
# The CommentFormatter object has a write_line() method which receives
# tokenized lines from perltidy
#
#####################################################################
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 {
# This is called from perltidy line-by-line
# Comments will be treated specially (reformatted)
# Other lines go to stdout immediately
my $self = shift;
my $line_of_tokens = shift;
my $line_type = $line_of_tokens->{_line_type};
## my $input_line_number = $line_of_tokens->{_line_number};
my $input_line = $line_of_tokens->{_line_text}; # the original line
my $rtoken_type = $line_of_tokens->{_rtoken_type}; # type of tokens
my $rtokens = $line_of_tokens->{_rtokens}; # text of tokens
# Just print non-code, non-comment lines
if (
$line_type ne 'CODE' # if it's not code,
|| !@$rtokens # or is a blank line
|| $$rtoken_type[-1] ne '#' # or the last token isn't a comment
)
{
$self->print($input_line);
$self->{_in_hanging_side_comment} = 0;
return;
}
# Now we either have:
# - a line with a side comment (@$rtokens >1), or
# - a full line comment (@$rtokens==1)
# Output a line with a side comment, but remember it
if (@$rtokens > 1) {
$self->print($input_line);
$self->{_in_hanging_side_comment} = 1;
return;
}
# A hanging side comment is a full-line comment immediately
# following a side comment or another hanging side comment.
# Output a hanging side comment directly
if ($self->{_in_hanging_side_comment}) {
$self->print($input_line);
return;
}
# Now we know we have a full-line, non-hanging, comment
# Decide what to do --
# output comment without any words directly, since these don't get
# handled well by autoformat yet. For example, a box of stars.
# TODO: we could truncate obvious separator lines to the desired
# line length
if ( $$rtokens[-1] !~ /\w/ ) {
$self->print($input_line);
}
# otherwise, append this comment to the group we are collecting
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;
# we will just reformat lines longer than the desired length for now
# TODO: this can be changed
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;
}
}
# called once after the last line of a file
sub finish_formatting {
my $self = shift;
$self->flush_comments();
}
|