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
72 #####################################################################
74 # The CommentFormatter object has a write_line() method which receives
75 # tokenized lines from perltidy
77 #####################################################################
79 package CommentFormatter;
82 my ( $class, $line_length ) = @_;
83 my $comment_block = "";
85 _rcomment_block => \$comment_block,
86 _maximum_comment_length => 0,
87 _line_length => $line_length,
88 _in_hanging_side_comment => 0,
95 # This is called from perltidy line-by-line
96 # Comments will be treated specially (reformatted)
97 # Other lines go to stdout immediately
99 my $line_of_tokens = shift;
100 my $line_type = $line_of_tokens->{_line_type};
101 ## my $input_line_number = $line_of_tokens->{_line_number};
102 my $input_line = $line_of_tokens->{_line_text}; # the orignal line
103 my $rtoken_type = $line_of_tokens->{_rtoken_type}; # type of tokens
104 my $rtokens = $line_of_tokens->{_rtokens}; # text of tokens
106 # Just print non-code, non-comment lines
108 $line_type ne 'CODE' # if it's not code,
109 || !@$rtokens # or is a blank line
110 || $$rtoken_type[-1] ne '#' # or the last token isn't a comment
113 $self->print($input_line);
114 $self->{_in_hanging_side_comment} = 0;
118 # Now we either have:
119 # - a line with a side comment (@$rtokens >1), or
120 # - a full line comment (@$rtokens==1)
122 # Output a line with a side comment, but remember it
124 $self->print($input_line);
125 $self->{_in_hanging_side_comment} = 1;
129 # A hanging side comment is a full-line comment immediately
130 # following a side comment or another hanging side comment.
131 # Output a hanging side comment directly
132 if ($self->{_in_hanging_side_comment}) {
133 $self->print($input_line);
137 # Now we know we have a full-line, non-hanging, comment
138 # Decide what to do --
140 # output comment without any words directly, since these don't get
141 # handled well by autoformat yet. For example, a box of stars.
142 # TODO: we could truncate obvious separator lines to the desired
144 if ( $$rtokens[-1] !~ /\w/ ) {
145 $self->print($input_line);
148 # otherwise, append this comment to the group we are collecting
150 $self->append_comment($input_line);
156 my ( $self, $input_line ) = @_;
157 $self->flush_comments();
162 my ( $self, $input_line ) = @_;
163 my $rcomment_block = $self->{_rcomment_block};
164 my $maximum_comment_length = $self->{_maximum_comment_length};
165 $$rcomment_block .= $input_line;
166 if (length($input_line) > $maximum_comment_length) {
167 $self->{_maximum_comment_length}=length($input_line);
172 my ( $separator1, $separator2, $separator3 );
175 $separator1 = '-' x 2 . ' Original ' . '-' x 60 . "\n";
176 $separator2 = '-' x 2 . ' Modified ' . '-' x 60 . "\n";
177 $separator3 = '-' x 72 . "\n";
183 my $rcomment_block = $self->{_rcomment_block};
184 my $line_length = $self->{_line_length};
185 my $maximum_comment_length = $self->{_maximum_comment_length};
186 if ($$rcomment_block) {
187 my $comments = $$rcomment_block;
189 # we will just reformat lines longer than the desired length for now
190 # TODO: this can be changed
191 if ( $maximum_comment_length > $line_length ) {
192 my $formatted_comments =
193 Text::Autoformat::autoformat( $comments,
194 { right => $line_length, all => 1 } );
196 if ( $formatted_comments ne $comments ) {
197 print STDERR $separator1;
198 print STDERR $$rcomment_block;
199 print STDERR $separator2;
200 print STDERR $formatted_comments;
201 print STDERR $separator3;
202 if ( ifyes("Accept Changes? [Y/N]") ) {
203 $comments = $formatted_comments;
208 $$rcomment_block = "";
209 $self->{_maximum_comment_length}=0;
229 my $ans = queryu(@_);
230 if ( $ans =~ /^Y/ ) { return 1 }
231 elsif ( $ans =~ /^N/ ) { return 0 }
234 if ( $count > 6 ) { die "error count exceeded in ifyes\n" }
235 print STDERR "Please answer 'Y' or 'N'\n";
240 # called once after the last line of a file
241 sub finish_formatting {
243 $self->flush_comments();