3 # Walk through a perl script and reformat perl comments
4 # using Text::Autoformat.
7 # perlcomment -l72 myfile.pl >myfile.new
9 # where -l specifies the maximum comment line length.
11 # You will be given an opportunity to accept or reject each proposed
14 # This file demonstrates using Perl::Tidy to walk through a perl file
15 # and find all of its comments. It offers to reformat each group of
16 # consecutive full-line comments with Text::Autoformat.
18 # This may or may not be useful, depending on your coding style.
19 # Change it to suit your own purposes; see sub get_line().
21 # Uses: Text::Autoformat
24 # Steve Hancock, March 2003
25 # Based on a suggestion by Tim Maher
27 # TODO: (just ideas that probably won't get done)
28 # -Handle lines of stars, dashes, etc better
29 # -Need flag to limit changes to lines greater than some minimum length
30 # -reformat side and hanging side comments
35 use vars qw($opt_l $opt_h);
38 usage: perlcomment [ -ln ] filename >outfile
39 where n=line length (default 72)
42 getopts('hl:') or die "$usage";
43 if ($opt_h) {die $usage}
44 if ( !defined $opt_l ) {
48 $opt_l =~ /^\d+$/ or die "$usage";
51 unless ( @ARGV == 1 ) { die $usage }
53 autoformat_file( $file, $opt_l );
56 my ( $file, $line_length ) = @_;
59 my $fh = IO::File->new( $file, 'r' );
60 unless ($fh) { die "cannot open '$file': $!\n" }
61 my $formatter = CommentFormatter->new($line_length);
64 'formatter' => $formatter, # callback object
66 'argv' => "-npro -se", # dont need .perltidyrc
70 die "Error calling perltidy\n";
75 #####################################################################
77 # The CommentFormatter object has a write_line() method which receives
78 # tokenized lines from perltidy
80 #####################################################################
82 package CommentFormatter;
85 my ( $class, $line_length ) = @_;
86 my $comment_block = "";
88 _rcomment_block => \$comment_block,
89 _maximum_comment_length => 0,
90 _line_length => $line_length,
91 _in_hanging_side_comment => 0,
98 # This is called from perltidy line-by-line
99 # Comments will be treated specially (reformatted)
100 # Other lines go to stdout immediately
102 my $line_of_tokens = shift;
103 my $line_type = $line_of_tokens->{_line_type};
104 ## my $input_line_number = $line_of_tokens->{_line_number};
105 my $input_line = $line_of_tokens->{_line_text}; # the original line
106 my $rtoken_type = $line_of_tokens->{_rtoken_type}; # type of tokens
107 my $rtokens = $line_of_tokens->{_rtokens}; # text of tokens
109 # Just print non-code, non-comment lines
111 $line_type ne 'CODE' # if it's not code,
112 || !@$rtokens # or is a blank line
113 || $$rtoken_type[-1] ne '#' # or the last token isn't a comment
116 $self->print($input_line);
117 $self->{_in_hanging_side_comment} = 0;
121 # Now we either have:
122 # - a line with a side comment (@$rtokens >1), or
123 # - a full line comment (@$rtokens==1)
125 # Output a line with a side comment, but remember it
127 $self->print($input_line);
128 $self->{_in_hanging_side_comment} = 1;
132 # A hanging side comment is a full-line comment immediately
133 # following a side comment or another hanging side comment.
134 # Output a hanging side comment directly
135 if ($self->{_in_hanging_side_comment}) {
136 $self->print($input_line);
140 # Now we know we have a full-line, non-hanging, comment
141 # Decide what to do --
143 # output comment without any words directly, since these don't get
144 # handled well by autoformat yet. For example, a box of stars.
145 # TODO: we could truncate obvious separator lines to the desired
147 if ( $$rtokens[-1] !~ /\w/ ) {
148 $self->print($input_line);
151 # otherwise, append this comment to the group we are collecting
153 $self->append_comment($input_line);
159 my ( $self, $input_line ) = @_;
160 $self->flush_comments();
165 my ( $self, $input_line ) = @_;
166 my $rcomment_block = $self->{_rcomment_block};
167 my $maximum_comment_length = $self->{_maximum_comment_length};
168 $$rcomment_block .= $input_line;
169 if (length($input_line) > $maximum_comment_length) {
170 $self->{_maximum_comment_length}=length($input_line);
175 my ( $separator1, $separator2, $separator3 );
178 $separator1 = '-' x 2 . ' Original ' . '-' x 60 . "\n";
179 $separator2 = '-' x 2 . ' Modified ' . '-' x 60 . "\n";
180 $separator3 = '-' x 72 . "\n";
186 my $rcomment_block = $self->{_rcomment_block};
187 my $line_length = $self->{_line_length};
188 my $maximum_comment_length = $self->{_maximum_comment_length};
189 if ($$rcomment_block) {
190 my $comments = $$rcomment_block;
192 # we will just reformat lines longer than the desired length for now
193 # TODO: this can be changed
194 if ( $maximum_comment_length > $line_length ) {
195 my $formatted_comments =
196 Text::Autoformat::autoformat( $comments,
197 { right => $line_length, all => 1 } );
199 if ( $formatted_comments ne $comments ) {
200 print STDERR $separator1;
201 print STDERR $$rcomment_block;
202 print STDERR $separator2;
203 print STDERR $formatted_comments;
204 print STDERR $separator3;
205 if ( ifyes("Accept Changes? [Y/N]") ) {
206 $comments = $formatted_comments;
211 $$rcomment_block = "";
212 $self->{_maximum_comment_length}=0;
232 my $ans = queryu(@_);
233 if ( $ans =~ /^Y/ ) { return 1 }
234 elsif ( $ans =~ /^N/ ) { return 0 }
237 if ( $count > 6 ) { die "error count exceeded in ifyes\n" }
238 print STDERR "Please answer 'Y' or 'N'\n";
243 # called once after the last line of a file
244 sub finish_formatting {
246 $self->flush_comments();