From: don Date: Fri, 13 Jul 2012 22:13:15 +0000 (+0000) Subject: * New upstream release X-Git-Tag: debian/20170521-1~26 X-Git-Url: https://git.donarmstrong.com/?p=perltidy.git;a=commitdiff_plain;h=736e5d55044509ce0deaaf0e7299a98f4d4b8d15 * New upstream release + Don't munge contents of __DATA__ even when they look like POD (closes: #614288) --- diff --git a/BUGS b/BUGS index f43ea14..d43b28e 100644 --- a/BUGS +++ b/BUGS @@ -1,4 +1,4 @@ -Perltidy open BUGS +Perltidy open BUGS and LIMITATIONS You can help perltidy evolve into a better program. If you think you have hit a bug or weird behavior, or have a suggested improvement, please send a note to perltidy at users.sourceforge.net. @@ -6,26 +6,40 @@ Perltidy open BUGS This file only lists open bugs. For bugs which have been fixed, see the ChangeLog. - The --extrude option can produce code with syntax errors + The --extrude and --mangle options can produce code with syntax errors The --extrude tries to put as many newlines in the formatted code as - possible. This option is very useful for testing perltidy but not for - actual formatting. Occasionally it will produce code which Perl - considers to have a syntax error. These problems usually involve code - where Perl is having to guess the tokenization based on whitespace. - Since the --extrude option is typically only used for testing perltidy, - this type of error should not normally occur in practice. - - In some rare instances the formatting can oscillate between two states - The following example was sent by Denis Moskowitz, Oct 29 2010: - - grep { $_->foo ne 'bar' } # asdfa asdf asdf asdf asdf asdf asdf asdf - asdf asdf asdf @baz; - - With standard parameters this oscillates between the above and: - - grep { $_->foo ne 'bar' } # asdfa asdf asdf asdf asdf asdf asdf asdf - asdf asdf asdf @baz; - - A workaround here would be to make a slight change to the side comment - length. + possible. The --mangle tries to remove as many newlines as possible. + These options are very useful for stress testing perltidy (and Perl) but + not so much for normal formatting. Occasionally they will produce code + which Perl considers to have a syntax error. These problems often + involve code where Perl is having to guess the tokenization based on + whitespace. The given/when and switch/case statements are also + particularly vulnerable to unusual line breaks and whitespace. This type + of error should not normally occur in practice, but if it does it should + be easy to fix the problem by rerunning perltidy with more normal + parameters or by manually changing whitespace or newlines. + + The Pod:Html module has some bugs + For the most part Pod::Html works very well and is very convenient + because it part of the standard Perl distribution. But for example the + following line + + =item B<< = Session->new_cflt_deck; >> + + which uses double brackets to contain single brackets does not render + correctly. + + Perltidy does not handle UTF-8 encoded files + Two iterations are sometimes needed + Usually the code produced by perltidy on the first pass does not change + if it is run again, but sometimes a second pass will produce some small + additional change. This mainly happens if a major style change is made, + particularly when perltidy is untangling complex ternary statements. Use + the iteration parameter -it=2 if it is important that the results be + unchanged on subsequent passes, but note that this doubles the run time. + + Latest Bug and Wishlist at CPAN: + For the latest list of bugs and feature requests at CPAN see: + + https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy diff --git a/CHANGES b/CHANGES index 1d8905b..80ad1d7 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,195 @@ Perltidy Change Log + 2012 07 01 + - Corrected problem introduced by using a chomp on scalar references, RT #77978 + + - Added support for Perl 5.14 package block syntax, RT #78114. + + - A convergence test is made if three or more iterations are requested with + the -it=n parameter to avoid wasting computer time. Several hundred Mb of + code gleaned from the internet were searched with the results that: + - It is unusual for two iterations to be required unless a major + style change is being made. + - Only one case has been found where three iterations were required. + - No cases requiring four iterations have been found with this version. + For the previous version several cases where found the results could + oscillate between two semi-stable states. This version corrects this. + + So if it is important that the code be converged it is okay to set -it=4 + with this version and it will probably stop after the second iteration. + + - Improved ability to identify and retain good line break points in the + input stream, such as at commas and equals. You can always tell + perltidy to ignore old breakpoints with -iob. + + - Fixed glitch in which a terminal closing hash brace followed by semicolon + was not outdented back to the leading line depth like other closing + tokens. Thanks to Keith Neargarder for noting this. + + OLD: + my ( $pre, $post ) = @{ + { + "pp_anonlist" => [ "[", "]" ], + "pp_anonhash" => [ "{", "}" ] + }->{ $kid->ppaddr } + }; # terminal brace + + NEW: + my ( $pre, $post ) = @{ + { + "pp_anonlist" => [ "[", "]" ], + "pp_anonhash" => [ "{", "}" ] + }->{ $kid->ppaddr } + }; # terminal brace + + - Removed extra indentation given to trailing 'if' and 'unless' clauses + without parentheses because this occasionally produced undesirable + results. This only applies where parens are not used after the if or + unless. + + OLD: + return undef + unless my ( $who, $actions ) = + $clause =~ /^($who_re)((?:$action_re)+)$/o; + + NEW: + return undef + unless my ( $who, $actions ) = + $clause =~ /^($who_re)((?:$action_re)+)$/o; + + 2012 06 19 + - Updated perltidy to handle all quote modifiers defined for perl 5 version 16. + + - Side comment text in perltidyrc configuration files must now begin with + at least one space before the #. Thus: + + OK: + -l=78 # Max line width is 78 cols + BAD: + -l=78# Max line width is 78 cols + + This is probably true of almost all existing perltidyrc files, + but if you get an error message about bad parameters + involving a '#' the first time you run this version, please check the side + comments in your perltidyrc file, and add a space before the # if necessary. + You can quickly see the contents your perltidyrc file, if any, with the + command: + + perltidy -dpro + + The reason for this change is that some parameters naturally involve + the # symbol, and this can get interpreted as a side comment unless the + parameter is quoted. For example, to define -sphb=# it used to be necessary + to write + -sbcp='#' + to keep the # from becomming part of a comment. This was causing + trouble for new users. Now it can also be written without quotes: + -sbcp=# + + - Fixed bug in processing some .perltidyrc files containing parameters with + an opening brace character, '{'. For example the following was + incorrectly processed: + --static-block-comment-prefix="^#{2,}[^\s#]" + Thanks to pdagosto. + + - Added flag -boa (--break-at-old-attribute-breakpoints) which retains + any existing line breaks at attribute separation ':'. This is now the + default, use -nboa to deactivate. Thanks to Daphne Phister for the patch. + For example, given the following code, the line breaks at the ':'s will be + retained: + + my @field + : field + : Default(1) + : Get('Name' => 'foo') : Set('Name'); + + whereas the previous version would have output a single line. If + the attributes are on a single line then they will remain on a single line. + + - Added new flags --blank-lines-before-subs=n (-blbs=n) and + --blank-lines-before-packages=n (-blbp=n) to put n blank lines before + subs and packages. The old flag -bbs is now equivalent to -blbs=1 -blbp=1. + and -nbbs is equivalent to -blbs=0 -blbp=0. Requested by M. Schwern and + several others. + + - Added feature -nsak='*' meaning no space between any keyword and opening + paren. This avoids listing entering a long list of keywords. Requested + by M. Schwern. + + - Added option to delete a backup of original file with in-place-modify (-b) + if there were no errors. This can be requested with the flag -bext='/'. + See documentation for details. Requested by M. Schwern and others. + + - Fixed bug where the module postfilter parameter was not applied when -b + flag was used. This was discovered during testing. + + - Fixed in-place-modify (-b) to work with symbolic links to source files. + Thanks to Ted Johnson. + + - Fixed bug where the Perl::Tidy module did not allow -b to be used + in some cases. + + - No extra blank line is added before a comment which follows + a short line ending in an opening token, for example like this: + OLD: + if ( + + # unless we follow a blank or comment line + $last_line_leading_type !~ /^[#b]$/ + ... + + NEW: + if ( + # unless we follow a blank or comment line + $last_line_leading_type !~ /^[#b]$/ + ... + + The blank is not needed for readability in these cases because there + already is already space above the comment. If a blank already + exists there it will not be removed, so this change should not + change code which has previously been formatted with perltidy. + Thanks to R.W.Stauner. + + - Likewise, no extra blank line is added above a comment consisting of a + single #, since nothing is gained in readability. + + - Fixed error in which a blank line was removed after a #>>> directive. + Thanks to Ricky Morse. + + - Unnecessary semicolons after given/when/default blocks are now removed. + + - Fixed bug where an unwanted blank line could be added before + pod text in __DATA__ or __END__ section. Thanks to jidani. + + - Changed exit flags from 1 to 0 to indicate success for -help, -version, + and all -dump commands. Also added -? as another way to dump the help. + Requested by Keith Neargarder. + + - Fixed bug where .ERR and .LOG files were not written except for -it=2 or more + + - Fixed bug where trailing blank lines at the end of a file were dropped when + -it>1. + + - Fixed bug where a line occasionally ended with an extra space. This reduces + rhe number of instances where a second iteration gives a result different + from the first. + + - Updated documentation to note that the Tidy.pm module parameter may + not be a reference to SCALAR or ARRAY; it must be a file. + + - Syntax check with perl now work when the Tidy.pm module is processing + references to arrays and strings. Thanks to Charles Alderman. + + - Zero-length files are no longer processed due to concerns for data loss + due to side effects in some scenarios. + + - block labels, if any, are now included in closing side comment text + when the -csc flag is used. Suggested by Aaron. For example, + the label L102 in the following block is now included in the -csc text: + + L102: for my $i ( 1 .. 10 ) { + ... + } ## end L102: for my $i ( 1 .. 10 ) + 2010 12 17 - added new flag -it=n or --iterations=n This flag causes perltidy to do n complete iterations. @@ -62,21 +253,21 @@ Perltidy Change Log limit is exceeded, then the comment text must be truncated. Previous versions of perltidy terminate with three dots, and this can still be achieved with -ncscb: - - perltidy -csc -ncscb + + perltidy -csc -ncscb } ## end foreach my $foo (sort { $b cmp $a ... - - However this causes a problem with older editors which cannot recognize + + However this causes a problem with older editors which cannot recognize comments or are not configured to doso because they cannot "bounce" around in the text correctly. The B<-cscb> flag tries to help them by appending appropriate terminal balancing structure: - - perltidy -csc -cscb + + perltidy -csc -cscb } ## end foreach my $foo (sort { $b cmp $a ... }) - - Since there is much to be gained and little to be lost by doing this, + + Since there is much to be gained and little to be lost by doing this, the default is B<-cscb>. Use B<-ncscb> if you do not want this. Thanks to Daniel Becker for suggesting this option. @@ -194,8 +385,8 @@ Perltidy Change Log dbmclose(%verb_delim); undef %verb_delim; dbmclose(%expanded); undef %expanded; dbmclose(%global); undef %global; - - -Improved formatting of complex ternary statements, with indentation + + -Improved formatting of complex ternary statements, with indentation of nested statements. OLD: return defined( $cw->{Selected} ) @@ -240,8 +431,8 @@ Perltidy Change Log -Fixed problem of a warning issued for multiple subs for BEGIN subs and other control subs. Thanks to Heiko Eissfeldt. - - -Fixed problem where no space was introduced between a keyword or + + -Fixed problem where no space was introduced between a keyword or bareword and a colon, such as: ( ref($result) eq 'HASH' && !%$result ) ? undef: $result; @@ -535,8 +726,8 @@ Perltidy Change Log ); This is backwards compatible with -icp. See revised manual for details. Suggested by Mike Pennington. - - -Added flag '--preserve-line-endings' or '-ple' to cause the output + + -Added flag '--preserve-line-endings' or '-ple' to cause the output line ending to be the same as in the input file, for unix, dos, or mac line endings. Only works under unix. Suggested by Rainer Hochschild. @@ -572,8 +763,8 @@ Perltidy Change Log -Fixed bug where an __END__ statement would be mistaken for a label if it is immediately followed by a line with a leading colon. Thanks to John Bayes. - - -Implemented guessing logic for brace types when it is ambiguous. This + + -Implemented guessing logic for brace types when it is ambiguous. This has been on the TODO list a long time. Thanks to Boris Zentner for an example. @@ -800,8 +991,8 @@ Perltidy Change Log -Outdenting labels (-ola) has been made the default, in order to follow the perlstyle guidelines better. It's probably a good idea in general, but if you do not want this, use -nola in your .perltidyrc file. - - -Updated rules for padding logical expressions to include more cases. + + -Updated rules for padding logical expressions to include more cases. Thanks to Wolfgang Weisselberg for helpful discussions. -Added new flag -osbc (--outdent-static-block-comments) which will @@ -924,8 +1115,8 @@ Perltidy Change Log -Pod file 'perltidy.pod' has been appended to the script 'perltidy', and Tidy.pod has been append to the module 'Tidy.pm'. Older MakeMaker's were having trouble. - - -A new flag -isbc has been added for more control on comments. This flag + + -A new flag -isbc has been added for more control on comments. This flag has the effect that if there is no leading space on the line, then the comment will not be indented, and otherwise it may be. If both -ibc and -isbc are set, then -isbc takes priority. Thanks to Frank Steinhauer @@ -1072,8 +1263,8 @@ Perltidy Change Log but not otherwise: : print "Hello World\n"; - - Also, perltidy will now mark a first line with leading ':' followed by + + Also, perltidy will now mark a first line with leading ':' followed by '#' as type SYSTEM (just as a #! line), not to be formatted. -List formatting improved for certain lists with special @@ -1158,8 +1349,8 @@ Perltidy Change Log and this has solved a lot of robustness problems. These systems cannot reliably handle backtick operators. See man page for details. - - -Merged VMS filename handling patch sent by Michael Cartmell. (Invalid + + -Merged VMS filename handling patch sent by Michael Cartmell. (Invalid output filenames were being created in some cases). -Numerous minor improvements have been made for -lp style indentation. @@ -1276,8 +1467,8 @@ Perltidy Change Log Note how the closing ');' is lined up with the first line, even though it closes a paren in the 'pack' line. That seems wrong. - - NEW: + + NEW: $mw->Button( -text => "New Document", -command => \&new_document @@ -1288,8 +1479,8 @@ Perltidy Change Log This seems nicer: you can up-arrow with an editor and arrive at the opening 'pack' line. - - -corrected minor glitch in which cuddled else (-ce) did not get applied + + -corrected minor glitch in which cuddled else (-ce) did not get applied to an 'unless' block, which should look like this: unless ($test) { @@ -1301,8 +1492,8 @@ Perltidy Change Log Thanks to Jeremy Mates for reporting this. -The man page has been reorganized to parameters easier to find. - - -Added check for multiple definitions of same subroutine. It is easy + + -Added check for multiple definitions of same subroutine. It is easy to introduce this problem when cutting and pasting. Perl does not complain about it, but it can lead to disaster. @@ -1315,8 +1506,8 @@ Perltidy Change Log -Side comment alignment has been improved somewhat across frequent level changes, as in short if/else blocks. Thanks to Wolfgang Weisselberg for pointing out this problem. For example: - - OLD: + + OLD: if ( ref $self ) { # Called as a method $format = shift; } @@ -1423,8 +1614,8 @@ Perltidy Change Log ); The structure is clearer with the added indentation: - - NEW: + + NEW: %{ $self->{COMPONENTS} } = ( fname => { type => 'name', adj => 'yes', font => 'Helvetica', 'index' => 0 }, @@ -1550,8 +1741,8 @@ Perltidy Change Log -Corrected tokenization error for the following (highly non-recommended) construct: $user = @vars[1] / 100; - - -Resolved cause of a difference between perltidy under perl v5.6.1 and + + -Resolved cause of a difference between perltidy under perl v5.6.1 and 5.005_03; the problem was different behavior of \G regex position marker(!) @@ -1568,8 +1759,8 @@ Perltidy Change Log The formatter mistakenly thought that it had found the following one-line block: - - eval {#open Socket to Dispatcher$sock = &OpenSocket; }; + + eval {#open Socket to Dispatcher$sock = &OpenSocket; }; The patch fixes this. Many thanks to Henry Story for reporting this bug. @@ -1596,20 +1787,20 @@ Perltidy Change Log -Fixed tokenization error in which a method call of the form Module::->new(); - - got a space before the '::' like this: + + got a space before the '::' like this: Module ::->new(); Thanks to David Holden for reporting this. - - -Added -html control over pod text, using a new abbreviation 'pd'. See + + -Added -html control over pod text, using a new abbreviation 'pd'. See updated perl2web man page. The default is to use the color of a comment, but italicized. Old .css style sheets will need a new line for .pd to use this. The old color was the color of a string, and there was no control. - - -.css lines are now printed in sorted order. + + -.css lines are now printed in sorted order. -Fixed interpolation problem where html files had '$input_file' as title instead of actual input file name. Thanks to Simon Perreault for finding @@ -1663,8 +1854,8 @@ Perltidy Change Log : $opts{"s"} ? 'subject' : $opts{"a"} ? 'author' : 'title'; - - You can use -wba=':' to recover the previous default which placed ':' + + You can use -wba=':' to recover the previous default which placed ':' at the end of a line. Thanks to Michael Cartmell for helpful discussions and examples. @@ -1730,11 +1921,11 @@ Perltidy Change Log nevertheless broken in the input file at a 'good' location (see below), perltidy will try to retain a break. For example, the following line will be formatted as: - - open SUM, "<$file" + + open SUM, "<$file" or die "Cannot open $file ($!)"; - - if it was broken in the input file, and like this if not: + + if it was broken in the input file, and like this if not: open SUM, "<$file" or die "Cannot open $file ($!)"; @@ -1813,8 +2004,8 @@ Perltidy Change Log print "Bye, bye baby!\n"; unlink $0; } - - The new version will not let that happen. + + The new version will not let that happen. -I am contemplating (but have not yet implemented) making '-lp' the default indentation, because it is stable now and may be closer to how @@ -1849,8 +2040,8 @@ Perltidy Change Log -Improved syntax checking and corrected tokenization of functions such as rand, srand, sqrt, ... These can accept either an operator or a term to their right. This has been corrected. - - -Corrected tokenization of semicolon: testing of the previous update showed + + -Corrected tokenization of semicolon: testing of the previous update showed that the semicolon in the following statement was being mis-tokenized. That did no harm, other than adding an extra blank space, but has been corrected. @@ -1926,8 +2117,8 @@ Perltidy Change Log $biblionumber, $constraint, $bibitems ); - - The updated version doesn't do this unless the space is really needed: + + The updated version doesn't do this unless the space is really needed: new: my $fee = CalcReserveFee( $env, $borrnum, @@ -1981,8 +2172,8 @@ Perltidy Change Log lastName => undef, hireDay => $hireDay }; - - new: my $hireDay = new Date; + + new: my $hireDay = new Date; my $self = { firstName => undef, lastName => undef, @@ -2155,8 +2346,8 @@ Perltidy Change Log $^W =1 to BEGIN {$^W=1} to use warnings in compile phase, and corrected several unnecessary 'my' declarations. Many thanks to Wolfgang Weisselberg, 2001-06-12, for catching these errors. - - -A '-bar' flag has been added to require braces to always be on the + + -A '-bar' flag has been added to require braces to always be on the right, even for multi-line if and foreach statements. For example, the default formatting of a long if statement would be: @@ -2186,8 +2377,8 @@ Perltidy Change Log calls. This will also cause full indentation ('-i=n, default n= 4) of continued parameter list lines rather than just the number of spaces given with -ci=n, default n=2. - - -Added support for hanging side comments. Perltidy identifies a hanging + + -Added support for hanging side comments. Perltidy identifies a hanging side comment as a comment immediately following a line with a side comment or another hanging side comment. This should work in most cases. It can be deactivated with --no-hanging-side-comments (-nhsc). @@ -2255,8 +2446,8 @@ Perltidy Change Log $mw->Label( -text => "perltidy", -relief => 'ridge')->pack; - - the current default is: + + the current default is: $mw->Label( -text => "perltidy", @@ -2288,8 +2479,8 @@ Perltidy Change Log -fixed another cuddled-else formatting bug (Reported by Craig Bourne) -added several diagnostic --dump routines - - -added token-level whitespace controls (suggested by Hans Ecke) + + -added token-level whitespace controls (suggested by Hans Ecke) 2001 03 23: -added support for special variables of the form ${^WANT_BITS} diff --git a/META.yml b/META.yml index 54aac27..f67adda 100644 --- a/META.yml +++ b/META.yml @@ -1,13 +1,21 @@ --- #YAML:1.0 -name: Perl-Tidy -version: 20101217 -abstract: indent and reformat perl scripts -license: ~ -author: +name: Perl-Tidy +version: 20120701 +abstract: indent and reformat perl scripts +author: - Steve Hancock -generated_by: ExtUtils::MakeMaker version 6.42 -distribution_type: module -requires: +license: unknown +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: {} +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.3.html - version: 1.3 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/README b/README index 157bd45..be16c84 100644 --- a/README +++ b/README @@ -6,14 +6,8 @@ Welcome to Perltidy! -- please see the included file "COPYING" for details. PREREQUISITES - An effort has been made to keep "perltidy" compatable with versions of - Perl as old as 5.004. This release was tested on Perl version - 5.004_04 under linux. (You can find your version with "perl -v"). - However, some systems this old may have problems with installation - scripts. If you run into installation difficulties, don't give up, - try the alternative installation method described in the INSTALL file. - - The following modules are not required, but perltidy may use them if + "perltidy" should work with most standard Perl installations. The + following modules are not required, but perltidy may use them if detected: HTML::Entities will be used to encode HTML entities if detected @@ -53,15 +47,9 @@ WHAT NEXT Reading the brief tutorial should help you use perltidy effectively. - Perltidy is still being developed, so please check sourceforge - occasionally for updates. New releases are announced on freshmeat.net. - FEEDBACK / BUG REPORTS Bug reports, comments and suggestions are welcome. Attach the smallest - piece of code which demonstrates the bug or issue. Your efforts are - greatly appreciated! - - Thank You + piece of code which demonstrates the bug or issue. Steve Hancock perltidy at users.sourceforge.net diff --git a/TODO b/TODO index bb1f874..4c33354 100644 --- a/TODO +++ b/TODO @@ -1,31 +1,17 @@ Perltidy TODO List - This is a partial "wish-list" of features to add and things to do. + This is a partial "wish-list" of features to add and things to do. - -b does not work through the Tidy module - The use of -b in the following does not work: - - use Perl::Tidy (); - use File::Spec; - - my $file = File::Spec->catfile( $dir, - $filename ); - - Perl::Tidy::perltidy( - source => $file, - argv => '-b', - perltidyrc => $perltidyrc, - ); - - A temporary workaround is: - - Perl::Tidy::perltidy( - argv => "-b $file", - perltidyrc => $perltidyrc, - ); + Provide an option to ignore side comments when checking line length. + That is, side comments would be allowed to be arbitrarily long without + influencing line breaks. Improved Vertical Alignment There are still many opportunities for improving vertical alignment. + Minimize the instances in which formatting changes on a second iteration. + + Add a convergence test when -it=n is used + Documentation A FAQ is needed to explain some of the more subtle formatting issues, and to give examples of different styles. @@ -44,3 +30,7 @@ Things which have been suggested but will not be done A -r flag might be nice, but this is best handled by an exterior shell script. + Make perltidy support the syntax of some module XXX. + This generally won't be done unless the module is part of the core perl + distribution. But in some cases it might be possible to use the prefilter + and postfilter capabilities of the Tidy.pm module to help. diff --git a/bin/perltidy b/bin/perltidy index b39c71f..7a01c08 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -6,13 +6,14 @@ use Perl::Tidy; my $arg_string = undef; # give Macs a chance to provide command line parameters -if ($^O =~ /Mac/) { - $arg_string = - MacPerl::Ask( 'Please enter @ARGV (-h for help)', - defined $ARGV[0] ? "\"$ARGV[0]\"" : "" ); +if ( $^O =~ /Mac/ ) { + $arg_string = MacPerl::Ask( + 'Please enter @ARGV (-h for help)', + defined $ARGV[0] ? "\"$ARGV[0]\"" : "" + ); } -Perl::Tidy::perltidy(argv => $arg_string); +Perl::Tidy::perltidy( argv => $arg_string ); __END__ @@ -57,7 +58,7 @@ formatter which is described in L<"HTML OPTIONS">. This will produce a file F containing the script reformatted using the default options, which approximate the style suggested in -perlstyle(1). Perltidy never changes the input file. +perlstyle(1). The source file F is unchanged. perltidy *.pl @@ -226,16 +227,39 @@ or if it is being specified explicitly with the B<-o=s> parameter. =item B<-b>, B<--backup-and-modify-in-place> Modify the input file or files in-place and save the original with the -extension F<.bak>. Any existing F<.bak> file will be deleted. See next item -for changing the default backup extension. +extension F<.bak>. Any existing F<.bak> file will be deleted. See next +item for changing the default backup extension, and for eliminating the +backup file altogether. A B<-b> flag will be ignored if input is from standard input, or if the B<-html> flag is set. =item B<-bext>=ext, B<--backup-file-extension>=ext -Change the extension of the backup file to be something other than the -default F<.bak>. See L. +This parameter serves two purposes: (1) to change the extension of the backup +file to be something other than the default F<.bak>, and (2) to indicate +that no backup file should be saved. + +To change the default extension to something other than F<.bak> see +L. + +A backup file of the source is always written, but you can request that it +be deleted at the end of processing if there were no errors. This is risky +unless the source code is being maintained with a source code control +system. + +To indicate that the backup should be deleted include one forward slash, +B, in the extension. If any text remains after the slash is removed +it will be used to define the backup file extension (which is always +created and only deleted if there were no errors). + +Here are some examples: + + Parameter Extension Backup File Treatment + <-bext=bak> F<.bak> Keep (same as the default behavior) + <-bext='/'> F<.bak> Delete if no errors + <-bext='/backup'> F<.backup> Delete if no errors + <-bext='original/'> F<.original> Delete if no errors =item B<-w>, B<--warning-output> @@ -394,7 +418,7 @@ opinion". If perl reports errors in the input file, they will not be reported in the error output unless the B<--warning-output> flag is given. -The default is B to do this type of syntax checking (although +The default is B to do this type of syntax checking (although perltidy will still do as much self-checking as possible). The reason is that it causes all code in BEGIN blocks to be executed, for all modules being used, and this opens the door to security issues and @@ -451,13 +475,16 @@ revert to the default behavior of using the line ending of the host system. =item B<-it=n>, B<--iterations=n> This flag causes perltidy to do B complete iterations. The reason for this -flag is that code beautification is a somewhat iterative process and in some +flag is that code beautification is an iterative process and in some cases the output from perltidy can be different if it is applied a second time. For most purposes the default of B should be satisfactory. However B can be useful when a major style change is being made, or when code is being -beautified on check-in to a source code control system. The run time will be -approximately proportional to B, and it should seldom be necessary to use a -value greater than B. This flag has no effect when perltidy is used to generate html. +beautified on check-in to a source code control system. It has been found to +be extremely rare for the output to change after 2 iterations. If a value +B is greater than 2 is input then a convergence test will be used to stop +the iterations as soon as possible, almost always after 2 iterations. + +This flag has no effect when perltidy is used to generate html. =back @@ -490,8 +517,19 @@ spaces assigned to a full indentation level on the B<-i=n> command. By default, perltidy examines the input file and tries to determine the starting indentation level. While it is often zero, it may not be -zero for a code snippet being sent from an editing session. If the -default method does not work correctly, or you want to change the +zero for a code snippet being sent from an editing session. + +To guess the starting indentation level perltidy simply assumes that +indentation scheme used to create the code snippet is the same as is being used +for the current perltidy process. This is the only sensible guess that can be +made. It should be correct if this is true, but otherwise it probably won't. +For example, if the input script was written with -i=2 and the current peltidy +flags have -i=4, the wrong initial indentation will be guessed for a code +snippet which has non-zero initial indentation. Likewise, if an entabbing +scheme is used in the input script and not in the current process then the +guessed indentation will be wrong. + +If the default method does not work correctly, or you want to change the starting level, use B<-sil=n>, to force the starting level to be n. =item List indentation using B<-lp>, B<--line-up-parentheses> @@ -835,6 +873,13 @@ where B is a list of keywords (in quotes if necessary). For example, my ( $a, $b, $c ) = @_; # default my( $a, $b, $c ) = @_; # -nsak="my local our" +The abbreviation B<-nsak='*'> is equivalent to including all of the +keywords in the above list. + +When both B<-nsak=s> and B<-sak=s> commands are included, the B<-nsak=s> +command is executed first. For example, to have space after only the +keywords (my, local, our) you could use B<-nsak="*" -sak="my local our">. + To put a space after all keywords, see the next item. =item Space between all keywords and opening parens @@ -1997,6 +2042,22 @@ By default, if a conditional (ternary) operator is broken at a C<:>, then it will remain broken. To prevent this, and thereby form longer lines, use B<-nbot>. +=item B<-boa>, B<--break-at-old-attribute-breakpoints> + +By default, if an attribute list is broken at a C<:> in the source file, then +it will remain broken. For example, given the following code, the line breaks +at the ':'s will be retained: + + my @field + : field + : Default(1) + : Get('Name' => 'foo') : Set('Name'); + +If the attributes are on a single line in the source code then they will remain +on a single line if possible. + +To prevent this, and thereby always form longer lines, use B<-nboa>. + =item B<-iob>, B<--ignore-old-breakpoints> Use this flag to tell perltidy to ignore existing line breaks to the @@ -2055,14 +2116,46 @@ A blank line will be introduced before a full-line comment. This is the default. Use B<-nbbc> or B<--noblanks-before-comments> to prevent such blank lines from being introduced. +=item B<-blbs=n>, B<--blank-lines-before-subs=n> + +The parameter B<-blbs=n> requests that least B blank lines precede a sub +definition which does not follow a comment and which is more than one-line +long. The default is <-blbs=1>. B and B blocks are included. + +The requested number of blanks statement will be inserted regardless of of the +value of B<--maximum-consecutive-blank-lines=n> (B<-mbl=n>) with the exception +that if B<-mbl=0> then no blanks will be output. + +This parameter interacts with the value B of the parameter B<--maximum-consecutive-blank-lines=k> (B<-mbl=k>) as follows: + +1. If B<-mbl=0> then no blanks will be output. This allows all blanks to be suppressed with a single parameter. Otherwise, + +2. If the number of old blank lines in the script is less than B then +additional blanks will be inserted to make the total B regardless of the +value of B<-mbl=k>. + +3. If the number of old blank lines in the script equals or exceeds B then +this parameter has no effect, however the total will not exceed +value specified on the B<-mbl=k> flag. + + +=item B<-blbp=n>, B<--blank-lines-before-packages=n> + +The parameter B<-blbp=n> requests that least B blank lines precede a package +which does not follow a comment. The default is <-blbp=1>. + +This parameter interacts with the value B of the parameter +B<--maximum-consecutive-blank-lines=k> (B<-mbl=k>) in the same way as described +for the previous item B<-blbs=n>. + + =item B<-bbs>, B<--blanks-before-subs> -A blank line will be introduced before a B definition, unless it is a -one-liner or preceded by a comment. A blank line will also be introduced -before a B statement and a B and B block. This is the -default. The intention is to help display the structure of a program by -setting off certain key sections of code. This is negated with B<-nbbs> or -B<--noblanks-before-subs>. +For compatability with previous versions, B<-bbs> or B<--blanks-before-subs> +is equivalent to F<-blbp=1> and F<-blbs=1>. + +Likewise, B<-nbbs> or B<--noblanks-before-subs> +is equivalent to F<-blbp=0> and F<-blbs=0>. =item B<-bbb>, B<--blanks-before-blocks> @@ -2099,13 +2192,12 @@ a value of B<0> is equivalent to entering a very large number. =item B<-mbl=n> B<--maximum-consecutive-blank-lines=n> -This parameter specifies the maximum number of consecutive -blank lines which will be output within code sections of a -script. The default is n=1. If the input file has more -than n consecutive blank lines, the number will be reduced -to n. If B then no blank lines will be output (unless -all old blank lines are retained with the B<-kbl=2> flag of -the next section). +This parameter specifies the maximum number of consecutive blank lines which +will be output within code sections of a script. The default is n=1. If the +input file has more than n consecutive blank lines, the number will be reduced +to n except as noted above for the B<-blbp> and B<-blbs> parameters. If B +then no blank lines will be output (unless all old blank lines are retained +with the B<-kbl=2> flag of the next section). This flag obviously does not apply to pod sections, here-documents, and quotes. @@ -2241,8 +2333,9 @@ Ex. PERLTIDY=C:\Documents and Settings\perltidy.ini The configuation file is free format, and simply a list of parameters, just as they would be entered on a command line. Any number of lines may be used, with any number of parameters per line, although it may be easiest to read with one -parameter per line. Blank lines are ignored, and text after a '#' is ignored -to the end of a line. +parameter per line. Comment text begins with a #, and there must +also be a space before the # for side comments. It is a good idea to +put complex parameters in either single or double quotes. Here is an example of a F<.perltidyrc> file: @@ -2819,7 +2912,7 @@ perlstyle(1), Perl::Tidy(3) =head1 VERSION -This man page documents perltidy version 20101217. +This man page documents perltidy version 20120701. =head1 CREDITS diff --git a/debian/changelog b/debian/changelog index ca384b5..e3ecf72 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,9 +1,10 @@ -perltidy (20101217-2) UNRELEASED; urgency=low +perltidy (20120701-1) unstable; urgency=low - * Don't munge contents of __DATA__ even when they look like POD (closes: - #614288) + * New upstream release + + Don't munge contents of __DATA__ even when they + look like POD (closes: #614288) - -- Don Armstrong Sun, 20 Feb 2011 19:06:20 -0800 + -- Don Armstrong Fri, 13 Jul 2012 15:00:16 -0700 perltidy (20101217-1) unstable; urgency=low diff --git a/docs/perltidy.1 b/docs/perltidy.1 index fe868c4..746af72 100644 --- a/docs/perltidy.1 +++ b/docs/perltidy.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pod::Man 2.1801 (Pod::Simple 3.05) +.\" Automatically generated by Pod::Man 2.22 (Pod::Simple 3.07) .\" .\" Standard preamble: .\" ======================================================================== @@ -124,7 +124,7 @@ .\" ======================================================================== .\" .IX Title "PERLTIDY 1" -.TH PERLTIDY 1 "2010-12-13" "perl v5.10.0" "User Contributed Perl Documentation" +.TH PERLTIDY 1 "2012-06-29" "perl v5.10.1" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -170,7 +170,7 @@ formatter which is described in \*(L"\s-1HTML\s0 \s-1OPTIONS\s0\*(R". .PP This will produce a file \fIsomefile.pl.tdy\fR containing the script reformatted using the default options, which approximate the style suggested in -\&\fIperlstyle\fR\|(1). Perltidy never changes the input file. +\&\fIperlstyle\fR\|(1). The source file \fIsomefile.pl\fR is unchanged. .PP .Vb 1 \& perltidy *.pl @@ -354,15 +354,40 @@ or if it is being specified explicitly with the \fB\-o=s\fR parameter. .IP "\fB\-b\fR, \fB\-\-backup\-and\-modify\-in\-place\fR" 4 .IX Item "-b, --backup-and-modify-in-place" Modify the input file or files in-place and save the original with the -extension \fI.bak\fR. Any existing \fI.bak\fR file will be deleted. See next item -for changing the default backup extension. +extension \fI.bak\fR. Any existing \fI.bak\fR file will be deleted. See next +item for changing the default backup extension, and for eliminating the +backup file altogether. .Sp A \fB\-b\fR flag will be ignored if input is from standard input, or if the \fB\-html\fR flag is set. .IP "\fB\-bext\fR=ext, \fB\-\-backup\-file\-extension\fR=ext" 4 .IX Item "-bext=ext, --backup-file-extension=ext" -Change the extension of the backup file to be something other than the -default \fI.bak\fR. See \*(L"Specifying File Extensions\*(R". +This parameter serves two purposes: (1) to change the extension of the backup +file to be something other than the default \fI.bak\fR, and (2) to indicate +that no backup file should be saved. +.Sp +To change the default extension to something other than \fI.bak\fR see +\&\*(L"Specifying File Extensions\*(R". +.Sp +A backup file of the source is always written, but you can request that it +be deleted at the end of processing if there were no errors. This is risky +unless the source code is being maintained with a source code control +system. +.Sp +To indicate that the backup should be deleted include one forward slash, +\&\fB/\fR, in the extension. If any text remains after the slash is removed +it will be used to define the backup file extension (which is always +created and only deleted if there were no errors). +.Sp +Here are some examples: +.Sp +.Vb 5 +\& Parameter Extension Backup File Treatment +\& <\-bext=bak> F<.bak> Keep (same as the default behavior) +\& <\-bext=\*(Aq/\*(Aq> F<.bak> Delete if no errors +\& <\-bext=\*(Aq/backup\*(Aq> F<.backup> Delete if no errors +\& <\-bext=\*(Aqoriginal/\*(Aq> F<.original> Delete if no errors +.Ve .IP "\fB\-w\fR, \fB\-\-warning\-output\fR" 4 .IX Item "-w, --warning-output" Setting \fB\-w\fR causes any non-critical warning @@ -506,7 +531,7 @@ opinion\*(R". If perl reports errors in the input file, they will not be reported in the error output unless the \fB\-\-warning\-output\fR flag is given. .Sp -The default is \fBnot\fR to do this type of syntax checking (although +The default is \fB\s-1NOT\s0\fR to do this type of syntax checking (although perltidy will still do as much self-checking as possible). The reason is that it causes all code in \s-1BEGIN\s0 blocks to be executed, for all modules being used, and this opens the door to security issues and @@ -558,13 +583,16 @@ revert to the default behavior of using the line ending of the host system. .IP "\fB\-it=n\fR, \fB\-\-iterations=n\fR" 4 .IX Item "-it=n, --iterations=n" This flag causes perltidy to do \fBn\fR complete iterations. The reason for this -flag is that code beautification is a somewhat iterative process and in some +flag is that code beautification is an iterative process and in some cases the output from perltidy can be different if it is applied a second time. For most purposes the default of \fBn=1\fR should be satisfactory. However \fBn=2\fR can be useful when a major style change is being made, or when code is being -beautified on check-in to a source code control system. The run time will be -approximately proportional to \fBn\fR, and it should seldom be necessary to use a -value greater than \fBn=2\fR. This flag has no effect when perltidy is used to generate html. +beautified on check-in to a source code control system. It has been found to +be extremely rare for the output to change after 2 iterations. If a value +\&\fBn\fR is greater than 2 is input then a convergence test will be used to stop +the iterations as soon as possible, almost always after 2 iterations. +.Sp +This flag has no effect when perltidy is used to generate html. .SS "Code Indentation Control" .IX Subsection "Code Indentation Control" .IP "\fB\-ci=n\fR, \fB\-\-continuation\-indentation=n\fR" 4 @@ -595,8 +623,19 @@ spaces assigned to a full indentation level on the \fB\-i=n\fR command. .IX Item "-sil=n --starting-indentation-level=n" By default, perltidy examines the input file and tries to determine the starting indentation level. While it is often zero, it may not be -zero for a code snippet being sent from an editing session. If the -default method does not work correctly, or you want to change the +zero for a code snippet being sent from an editing session. +.Sp +To guess the starting indentation level perltidy simply assumes that +indentation scheme used to create the code snippet is the same as is being used +for the current perltidy process. This is the only sensible guess that can be +made. It should be correct if this is true, but otherwise it probably won't. +For example, if the input script was written with \-i=2 and the current peltidy +flags have \-i=4, the wrong initial indentation will be guessed for a code +snippet which has non-zero initial indentation. Likewise, if an entabbing +scheme is used in the input script and not in the current process then the +guessed indentation will be wrong. +.Sp +If the default method does not work correctly, or you want to change the starting level, use \fB\-sil=n\fR, to force the starting level to be n. .IP "List indentation using \fB\-lp\fR, \fB\-\-line\-up\-parentheses\fR" 4 .IX Item "List indentation using -lp, --line-up-parentheses" @@ -954,6 +993,13 @@ where \fBs\fR is a list of keywords (in quotes if necessary). For example, \& my( $a, $b, $c ) = @_; # \-nsak="my local our" .Ve .Sp +The abbreviation \fB\-nsak='*'\fR is equivalent to including all of the +keywords in the above list. +.Sp +When both \fB\-nsak=s\fR and \fB\-sak=s\fR commands are included, the \fB\-nsak=s\fR +command is executed first. For example, to have space after only the +keywords (my, local, our) you could use \fB\-nsak=\*(L"*\*(R" \-sak=\*(L"my local our\*(R"\fR. +.Sp To put a space after all keywords, see the next item. .IP "Space between all keywords and opening parens" 4 .IX Item "Space between all keywords and opening parens" @@ -2114,6 +2160,23 @@ retaining these breakpoints. By default, if a conditional (ternary) operator is broken at a \f(CW\*(C`:\*(C'\fR, then it will remain broken. To prevent this, and thereby form longer lines, use \fB\-nbot\fR. +.IP "\fB\-boa\fR, \fB\-\-break\-at\-old\-attribute\-breakpoints\fR" 4 +.IX Item "-boa, --break-at-old-attribute-breakpoints" +By default, if an attribute list is broken at a \f(CW\*(C`:\*(C'\fR in the source file, then +it will remain broken. For example, given the following code, the line breaks +at the ':'s will be retained: +.Sp +.Vb 4 +\& my @field +\& : field +\& : Default(1) +\& : Get(\*(AqName\*(Aq => \*(Aqfoo\*(Aq) : Set(\*(AqName\*(Aq); +.Ve +.Sp +If the attributes are on a single line in the source code then they will remain +on a single line if possible. +.Sp +To prevent this, and thereby always form longer lines, use \fB\-nboa\fR. .IP "\fB\-iob\fR, \fB\-\-ignore\-old\-breakpoints\fR" 4 .IX Item "-iob, --ignore-old-breakpoints" Use this flag to tell perltidy to ignore existing line breaks to the @@ -2169,14 +2232,42 @@ is equivalent to setting \fB\-mbl=0\fR and \fB\-kbl=2\fR). A blank line will be introduced before a full-line comment. This is the default. Use \fB\-nbbc\fR or \fB\-\-noblanks\-before\-comments\fR to prevent such blank lines from being introduced. +.IP "\fB\-blbs=n\fR, \fB\-\-blank\-lines\-before\-subs=n\fR" 4 +.IX Item "-blbs=n, --blank-lines-before-subs=n" +The parameter \fB\-blbs=n\fR requests that least \fBn\fR blank lines precede a sub +definition which does not follow a comment and which is more than one-line +long. The default is <\-blbs=1>. \fB\s-1BEGIN\s0\fR and \fB\s-1END\s0\fR blocks are included. +.Sp +The requested number of blanks statement will be inserted regardless of of the +value of \fB\-\-maximum\-consecutive\-blank\-lines=n\fR (\fB\-mbl=n\fR) with the exception +that if \fB\-mbl=0\fR then no blanks will be output. +.Sp +This parameter interacts with the value \fBk\fR of the parameter \fB\-\-maximum\-consecutive\-blank\-lines=k\fR (\fB\-mbl=k\fR) as follows: +.Sp +1. If \fB\-mbl=0\fR then no blanks will be output. This allows all blanks to be suppressed with a single parameter. Otherwise, +.Sp +2. If the number of old blank lines in the script is less than \fBn\fR then +additional blanks will be inserted to make the total \fBn\fR regardless of the +value of \fB\-mbl=k\fR. +.Sp +3. If the number of old blank lines in the script equals or exceeds \fBn\fR then +this parameter has no effect, however the total will not exceed +value specified on the \fB\-mbl=k\fR flag. +.IP "\fB\-blbp=n\fR, \fB\-\-blank\-lines\-before\-packages=n\fR" 4 +.IX Item "-blbp=n, --blank-lines-before-packages=n" +The parameter \fB\-blbp=n\fR requests that least \fBn\fR blank lines precede a package +which does not follow a comment. The default is <\-blbp=1>. +.Sp +This parameter interacts with the value \fBk\fR of the parameter +\&\fB\-\-maximum\-consecutive\-blank\-lines=k\fR (\fB\-mbl=k\fR) in the same way as described +for the previous item \fB\-blbs=n\fR. .IP "\fB\-bbs\fR, \fB\-\-blanks\-before\-subs\fR" 4 .IX Item "-bbs, --blanks-before-subs" -A blank line will be introduced before a \fBsub\fR definition, unless it is a -one-liner or preceded by a comment. A blank line will also be introduced -before a \fBpackage\fR statement and a \fB\s-1BEGIN\s0\fR and \fB\s-1END\s0\fR block. This is the -default. The intention is to help display the structure of a program by -setting off certain key sections of code. This is negated with \fB\-nbbs\fR or -\&\fB\-\-noblanks\-before\-subs\fR. +For compatability with previous versions, \fB\-bbs\fR or \fB\-\-blanks\-before\-subs\fR +is equivalent to \fI\-blbp=1\fR and \fI\-blbs=1\fR. +.Sp +Likewise, \fB\-nbbs\fR or \fB\-\-noblanks\-before\-subs\fR +is equivalent to \fI\-blbp=0\fR and \fI\-blbs=0\fR. .IP "\fB\-bbb\fR, \fB\-\-blanks\-before\-blocks\fR" 4 .IX Item "-bbb, --blanks-before-blocks" A blank line will be introduced before blocks of coding delimited by @@ -2204,13 +2295,12 @@ certain block types (see previous section). The default is 8. Entering a value of \fB0\fR is equivalent to entering a very large number. .IP "\fB\-mbl=n\fR \fB\-\-maximum\-consecutive\-blank\-lines=n\fR" 4 .IX Item "-mbl=n --maximum-consecutive-blank-lines=n" -This parameter specifies the maximum number of consecutive -blank lines which will be output within code sections of a -script. The default is n=1. If the input file has more -than n consecutive blank lines, the number will be reduced -to n. If \fBn=0\fR then no blank lines will be output (unless -all old blank lines are retained with the \fB\-kbl=2\fR flag of -the next section). +This parameter specifies the maximum number of consecutive blank lines which +will be output within code sections of a script. The default is n=1. If the +input file has more than n consecutive blank lines, the number will be reduced +to n except as noted above for the \fB\-blbp\fR and \fB\-blbs\fR parameters. If \fBn=0\fR +then no blank lines will be output (unless all old blank lines are retained +with the \fB\-kbl=2\fR flag of the next section). .Sp This flag obviously does not apply to pod sections, here-documents, and quotes. @@ -2335,8 +2425,9 @@ Ex. PERLTIDY=C:\eDocuments and Settings\eperltidy.ini The configuation file is free format, and simply a list of parameters, just as they would be entered on a command line. Any number of lines may be used, with any number of parameters per line, although it may be easiest to read with one -parameter per line. Blank lines are ignored, and text after a '#' is ignored -to the end of a line. +parameter per line. Comment text begins with a #, and there must +also be a space before the # for side comments. It is a good idea to +put complex parameters in either single or double quotes. .Sp Here is an example of a \fI.perltidyrc\fR file: .Sp @@ -2902,7 +2993,7 @@ purpose of this rule is to prevent generating confusing filenames such as \&\fIperlstyle\fR\|(1), \fIPerl::Tidy\fR\|(3) .SH "VERSION" .IX Header "VERSION" -This man page documents perltidy version 20101217. +This man page documents perltidy version 20120701. .SH "CREDITS" .IX Header "CREDITS" Michael Cartmell supplied code for adaptation to \s-1VMS\s0 and helped with diff --git a/examples/filter_example.in b/examples/filter_example.in index 70172e5..72f2666 100644 --- a/examples/filter_example.in +++ b/examples/filter_example.in @@ -1,16 +1,16 @@ # input file for testing filter_example.pl use Method::Signatures::Simple; - method foo { $self->bar } + method foo1 { $self->bar } # with signature - method foo($bar, %opts) { $self->bar(reverse $bar) if $opts{rev}; + method foo2($bar, %opts) { $self->bar(reverse $bar) if $opts{rev}; } # attributes - method foo : lvalue { $self->{foo} + method foo3 : lvalue { $self->{foo} } # change invocant name method -foo ($class: $bar) { $class->bar($bar) } +foo4 ($class: $bar) { $class->bar($bar) } diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 2534df3..64e72d5 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3,7 +3,7 @@ # # perltidy - a perl script indenter and formatter # -# Copyright (c) 2000-2009 by Steve Hancock +# Copyright (c) 2000-2012 by Steve Hancock # Distributed under the GPL license agreement; see file COPYING # # This program is free software; you can redistribute it and/or modify @@ -74,9 +74,10 @@ use vars qw{ use Cwd; use IO::File; use File::Basename; +use File::Copy; BEGIN { - ( $VERSION = q($Id: Tidy.pm,v 1.74 2010/12/17 13:56:49 perltidy Exp $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker + ( $VERSION = q($Id: Tidy.pm,v 1.74 2012/07/01 13:56:49 perltidy Exp $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker } sub streamhandle { @@ -236,15 +237,14 @@ sub catfile { sub make_temporary_filename { # Make a temporary filename. + # FIXME: return both a name and opened filehandle # - # The POSIX tmpnam() function tends to be unreliable for non-unix - # systems (at least for the win32 systems that I've tested), so use - # a pre-defined name. A slight disadvantage of this is that two - # perltidy runs in the same working directory may conflict. - # However, the chance of that is small and managable by the user. - # An alternative would be to check for the file's existance and use, - # say .TMP0, .TMP1, etc, but that scheme has its own problems. So, - # keep it simple. + # The POSIX tmpnam() function tends to be unreliable for non-unix systems + # (at least for the win32 systems that I've tested), so use a pre-defined + # name for them. A disadvantage of this is that two perltidy + # runs in the same working directory may conflict. However, the chance of + # that is small and managable by the user, especially on systems for which + # the POSIX tmpnam function doesn't work. my $name = "perltidy.TMP"; if ( $^O =~ /win32|dos/i || $^O eq 'VMS' || $^O eq 'MacOs' ) { return $name; @@ -254,7 +254,7 @@ sub make_temporary_filename { use IO::File; # just make a couple of tries before giving up and using the default - for ( 0 .. 1 ) { + for ( 0 .. 3 ) { my $tmpname = tmpnam(); my $fh = IO::File->new( $tmpname, O_RDWR | O_CREAT | O_EXCL ); if ($fh) { @@ -470,6 +470,16 @@ EOM # redirect STDERR if requested if ($stderr_stream) { + my $ref_type = ref($stderr_stream); + if ( $ref_type eq 'SCALAR' or $ref_type eq 'ARRAY' ) { + croak <{'dump-options'} ) { print STDOUT $readable_options; - exit 1; + exit 0; } + #--------------------------------------------------------------- + # check parameters and their interactions + #--------------------------------------------------------------- check_options( $rOpts, $is_Windows, $Windows_type, $rpending_complaint ); @@ -592,6 +611,29 @@ EOM make_extension( $rOpts->{'output-file-extension'}, $default_file_extension{ $rOpts->{'format'} }, $dot ); + # If the backup extension contains a / character then the backup should + # be deleted when the -b option is used. On older versions of + # perltidy this will generate an error message due to an illegal + # file name. + # + # A backup file will still be generated but will be deleted + # at the end. If -bext='/' then this extension will be + # the default 'bak'. Otherwise it will be whatever characters + # remains after all '/' characters are removed. For example: + # -bext extension slashes + # '/' bak 1 + # '/delete' delete 1 + # 'delete/' delete 1 + # '/dev/null' devnull 2 (Currently not allowed) + my $bext = $rOpts->{'backup-file-extension'}; + my $delete_backup = ( $rOpts->{'backup-file-extension'} =~ s/\///g ); + + # At present only one forward slash is allowed. In the future multiple + # slashes may be allowed to allow for other options + if ( $delete_backup > 1 ) { + die "-bext=$bext contains more than one '/'\n"; + } + my $backup_extension = make_extension( $rOpts->{'backup-file-extension'}, 'bak', $dot ); @@ -602,11 +644,9 @@ EOM make_extension( $rOpts->{'html-src-extension'}, 'src', $dot ); # check for -b option; + # silently ignore unless beautify mode my $in_place_modify = $rOpts->{'backup-and-modify-in-place'} - && $rOpts->{'format'} eq 'tidy' # silently ignore unless beautify mode - && @ARGV > 0; # silently ignore if standard input; - # this allows -b to be in a .perltidyrc file - # without error messages when running from an editor + && $rOpts->{'format'} eq 'tidy'; # turn off -b with warnings in case of conflicts with other options if ($in_place_modify) { @@ -616,10 +656,10 @@ EOM } if ($destination_stream) { warn -"Ignoring -b; you may not specify a destination array and -b together\n"; +"Ignoring -b; you may not specify a destination stream and -b together\n"; $in_place_modify = 0; } - if ($source_stream) { + if ( ref($source_stream) ) { warn "Ignoring -b; you may not specify a source array and -b together\n"; $in_place_modify = 0; @@ -678,7 +718,10 @@ EOM unshift( @ARGV, '-' ) unless @ARGV; } - # loop to process all files in argument list + #--------------------------------------------------------------- + # Ready to go... + # main loop to process all files in argument list + #--------------------------------------------------------------- my $number_of_files = @ARGV; my $formatter = undef; $tokenizer = undef; @@ -687,7 +730,7 @@ EOM my $input_file_permissions; #--------------------------------------------------------------- - # determine the input file name + # prepare this input stream #--------------------------------------------------------------- if ($source_stream) { $fileroot = "perltidy"; @@ -728,6 +771,15 @@ EOM next; } + # As a safety precaution, skip zero length files. + # If for example a source file got clobberred somehow, + # the old .tdy or .bak files might still exist so we + # shouldn't overwrite them with zero length files. + unless ( -s $input_file ) { + print "skipping file: $input_file: Zero size\n"; + next; + } + unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) { print "skipping file: $input_file: Non-text (override with -f)\n"; @@ -803,7 +855,7 @@ EOM if $diagnostics_object; #--------------------------------------------------------------- - # determine the output file name + # prepare the output stream #--------------------------------------------------------------- my $output_file = undef; my $actual_output_extension; @@ -937,38 +989,56 @@ EOM Perl::Tidy::Debugger->new( $fileroot . $dot . "DEBUG" ); } - # loop over iterations - my $max_iterations = $rOpts->{'iterations'}; - my $sink_object_final = $sink_object; - for ( my $iter = 1 ; $iter <= $max_iterations ; $iter++ ) { - my $temp_buffer; + #--------------------------------------------------------------- + # loop over iterations for one source stream + #--------------------------------------------------------------- - # local copies of some debugging objects which get deleted - # after first iteration, but will reappear after this loop - my $debugger_object = $debugger_object; - my $logger_object = $logger_object; - my $diagnostics_object = $diagnostics_object; + # We will do a convergence test if 3 or more iterations are allowed. + # It would be pointless for fewer because we have to make at least + # two passes before we can see if we are converged, and the test + # would just slow things down. + my $max_iterations = $rOpts->{'iterations'}; + my $convergence_log_message; + my %saw_md5; + my $do_convergence_test = $max_iterations > 2; + if ($do_convergence_test) { + eval "use Digest::MD5 qw(md5_hex)"; + $do_convergence_test = !$@; + } + + # save objects to allow redirecting output during iterations + my $sink_object_final = $sink_object; + my $debugger_object_final = $debugger_object; + my $logger_object_final = $logger_object; + + for ( my $iter = 1 ; $iter <= $max_iterations ; $iter++ ) { - # output to temp buffer until last iteration + # send output stream to temp buffers until last iteration + my $sink_buffer; if ( $iter < $max_iterations ) { $sink_object = - Perl::Tidy::LineSink->new( \$temp_buffer, $tee_file, + Perl::Tidy::LineSink->new( \$sink_buffer, $tee_file, $line_separator, $rOpts, $rpending_logfile_message, $binmode ); } else { $sink_object = $sink_object_final; + } - # terminate some debugging output after first pass - # to avoid needless output. - $debugger_object = undef; - $logger_object = undef; - $diagnostics_object = undef; + # Save logger, debugger output only on pass 1 because: + # (1) line number references must be to the starting + # source, not an intermediate result, and + # (2) we need to know if there are errors so we can stop the + # iterations early if necessary. + if ( $iter > 1 ) { + $debugger_object = undef; + $logger_object = undef; } - #--------------------------------------------------------------- - # create a formatter for this file : html writer or pretty printer - #--------------------------------------------------------------- + #------------------------------------------------------------ + # create a formatter for this file : html writer or + # pretty printer + #------------------------------------------------------------ # we have to delete any old formatter because, for safety, # the formatter will check to see that there is only one. @@ -1029,18 +1099,100 @@ EOM $source_object->close_input_file(); # line source for next iteration (if any) comes from the current - # temporary buffer + # temporary output buffer if ( $iter < $max_iterations ) { + + $sink_object->close_output_file(); $source_object = - Perl::Tidy::LineSource->new( \$temp_buffer, $rOpts, + Perl::Tidy::LineSource->new( \$sink_buffer, $rOpts, $rpending_logfile_message ); - } - } # end loop over iterations + # stop iterations if errors or converged + my $stop_now = $logger_object->{_warning_count}; + if ($stop_now) { + $convergence_log_message = <write_diagnostics( + $convergence_log_message) + if $diagnostics_object; + } + else { + $convergence_log_message = <write_diagnostics( + $convergence_log_message) + if $diagnostics_object && $iterm > 2; + } + } + } ## end if ($do_convergence_test) + + if ($stop_now) { + + # we are stopping the iterations early; + # copy the output stream to its final destination + $sink_object = $sink_object_final; + while ( my $line = $source_object->get_line() ) { + $sink_object->write_line($line); + } + $source_object->close_input_file(); + last; + } + } ## end if ( $iter < $max_iterations) + } # end loop over iterations for one source file + + # restore objects which have been temporarily undefined + # for second and higher iterations + $debugger_object = $debugger_object_final; + $logger_object = $logger_object_final; - # get file names to use for syntax check - my $ifname = $source_object->get_input_file_copy_name(); - my $ofname = $sink_object->get_output_file_copy(); + $logger_object->write_logfile_entry($convergence_log_message) + if $convergence_log_message; + + #--------------------------------------------------------------- + # Perform any postfilter operation + #--------------------------------------------------------------- + if ($postfilter) { + $sink_object->close_output_file(); + $sink_object = + Perl::Tidy::LineSink->new( $output_file, $tee_file, + $line_separator, $rOpts, $rpending_logfile_message, + $binmode ); + my $buf = $postfilter->($postfilter_buffer); + $source_object = + Perl::Tidy::LineSource->new( \$buf, $rOpts, + $rpending_logfile_message ); + ##chomp $buf; + ##foreach my $line ( split( "\n", $buf , -1) ) { + while ( my $line = $source_object->get_line() ) { + $sink_object->write_line($line); + } + $source_object->close_input_file(); + } + + # Save names of the input and output files for syntax check + my $ifname = $input_file; + my $ofname = $output_file; #--------------------------------------------------------------- # handle the -b option (backup and modify in-place) @@ -1050,7 +1202,7 @@ EOM # oh, oh, no real file to backup .. # shouldn't happen because of numerous preliminary checks - die print + die "problem with -b backing up input file '$input_file': not a file\n"; } my $backup_name = $input_file . $backup_extension; @@ -1059,17 +1211,31 @@ EOM or die "unable to remove previous '$backup_name' for -b option; check permissions: $!\n"; } - rename( $input_file, $backup_name ) - or die + + # backup the input file + # we use copy for symlinks, move for regular files + if ( -l $input_file ) { + File::Copy::copy( $input_file, $backup_name ) + or die "File::Copy failed trying to backup source: $!"; + } + else { + rename( $input_file, $backup_name ) + or die "problem renaming $input_file to $backup_name for -b option: $!\n"; + } $ifname = $backup_name; + # copy the output to the original input file + # NOTE: it would be nice to just close $output_file and use + # File::Copy::copy here, but in this case $output_file is the + # handle of an open nameless temporary file so we would lose + # everything if we closed it. seek( $output_file, 0, 0 ) - or die "unable to rewind tmp file for -b option: $!\n"; - + or die + "unable to rewind a temporary file for -b option: $!\n"; my $fout = IO::File->new("> $input_file") or die -"problem opening $input_file for write for -b option; check directory permissions: $!\n"; +"problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n"; binmode $fout; my $line; while ( $line = $output_file->getline() ) { @@ -1086,20 +1252,8 @@ EOM $sink_object->close_output_file() if $sink_object; $debugger_object->close_debug_file() if $debugger_object; - if ($postfilter) { - my $new_sink = - Perl::Tidy::LineSink->new( $output_file, $tee_file, - $line_separator, $rOpts, $rpending_logfile_message, - $binmode ); - my $buf = $postfilter->($postfilter_buffer); - foreach my $line ( split( "\n", $buf ) ) { - $new_sink->write_line($line); - } - } - - my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes - if ($output_file) { - + # set output file permissions + if ( $output_file && -f $output_file && !-l $output_file ) { if ($input_file_permissions) { # give output script same permissions as input script, but @@ -1110,18 +1264,101 @@ EOM } # else use default permissions for html and any other format + } + } + + #--------------------------------------------------------------- + # Do syntax check if requested and possible + #--------------------------------------------------------------- + my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes + if ( $logger_object + && $rOpts->{'check-syntax'} + && $ifname + && $ofname ) + { + $infile_syntax_ok = + check_syntax( $ifname, $ofname, $logger_object, $rOpts ); + } + #--------------------------------------------------------------- + # remove the original file for in-place modify as follows: + # $delete_backup=0 never + # $delete_backup=1 only if no errors + # $delete_backup>1 always : CURRENTLY NOT ALLOWED, see above + #--------------------------------------------------------------- + if ( $in_place_modify + && $delete_backup + && -f $ifname + && ( $delete_backup > 1 || !$logger_object->{_warning_count} ) ) + { + + # As an added safety precaution, do not delete the source file + # if its size has dropped from positive to zero, since this + # could indicate a disaster of some kind, including a hardware + # failure. Actually, this could happen if you had a file of + # all comments (or pod) and deleted everything with -dac (-dap) + # for some reason. + if ( !-s $output_file && -s $ifname && $delete_backup == 1 ) { + warn( +"output file '$output_file' missing or zero length; original '$ifname' not deleted\n" + ); } - if ( $logger_object && $rOpts->{'check-syntax'} ) { - $infile_syntax_ok = - check_syntax( $ifname, $ofname, $logger_object, $rOpts ); + else { + unlink($ifname) + or die +"unable to remove previous '$ifname' for -b option; check permissions: $!\n"; } } $logger_object->finish( $infile_syntax_ok, $formatter ) if $logger_object; - } # end of loop to process all files - } # end of main program + } # end of main loop to process all files + } # end of main program perltidy +} + +sub get_stream_as_named_file { + + # Return the name of a file containing a stream of data, creating + # a temporary file if necessary. + # Given: + # $stream - the name of a file or stream + # Returns: + # $fname = name of file if possible, or undef + # $if_tmpfile = true if temp file, undef if not temp file + # + # This routine is needed for passing actual files to Perl for + # a syntax check. + my ($stream) = @_; + my $is_tmpfile; + my $fname; + if ($stream) { + if ( ref($stream) ) { + my ( $fh_stream, $fh_name ) = + Perl::Tidy::streamhandle( $stream, 'r' ); + if ($fh_stream) { + my ( $fout, $tmpnam ); + + # FIXME: fix the tmpnam routine to return an open filehandle + $tmpnam = Perl::Tidy::make_temporary_filename(); + $fout = IO::File->new( $tmpnam, 'w' ); + + if ($fout) { + $fname = $tmpnam; + $is_tmpfile = 1; + binmode $fout; + while ( my $line = $fh_stream->getline() ) { + $fout->print($line); + } + $fout->close(); + } + $fh_stream->close(); + } + } + elsif ( $stream ne '-' && -f $stream ) { + $fname = $stream; + } + } + return ( $fname, $is_tmpfile ); } sub fileglob_to_re { @@ -1459,20 +1696,22 @@ sub generate_options { ######################################## $category = 7; # Retaining or ignoring existing line breaks ######################################## - $add_option->( 'break-at-old-keyword-breakpoints', 'bok', '!' ); - $add_option->( 'break-at-old-logical-breakpoints', 'bol', '!' ); - $add_option->( 'break-at-old-ternary-breakpoints', 'bot', '!' ); - $add_option->( 'ignore-old-breakpoints', 'iob', '!' ); + $add_option->( 'break-at-old-keyword-breakpoints', 'bok', '!' ); + $add_option->( 'break-at-old-logical-breakpoints', 'bol', '!' ); + $add_option->( 'break-at-old-ternary-breakpoints', 'bot', '!' ); + $add_option->( 'break-at-old-attribute-breakpoints', 'boa', '!' ); + $add_option->( 'ignore-old-breakpoints', 'iob', '!' ); ######################################## $category = 8; # Blank line control ######################################## - $add_option->( 'blanks-before-blocks', 'bbb', '!' ); - $add_option->( 'blanks-before-comments', 'bbc', '!' ); - $add_option->( 'blanks-before-subs', 'bbs', '!' ); - $add_option->( 'long-block-line-count', 'lbl', '=i' ); - $add_option->( 'maximum-consecutive-blank-lines', 'mbl', '=i' ); - $add_option->( 'keep-old-blank-lines', 'kbl', '=i' ); + $add_option->( 'blanks-before-blocks', 'bbb', '!' ); + $add_option->( 'blanks-before-comments', 'bbc', '!' ); + $add_option->( 'blank-lines-before-subs', 'blbs', '=i' ); + $add_option->( 'blank-lines-before-packages', 'blbp', '=i' ); + $add_option->( 'long-block-line-count', 'lbl', '=i' ); + $add_option->( 'maximum-consecutive-blank-lines', 'mbl', '=i' ); + $add_option->( 'keep-old-blank-lines', 'kbl', '=i' ); ######################################## $category = 9; # Other controls @@ -1589,7 +1828,8 @@ sub generate_options { add-whitespace blanks-before-blocks blanks-before-comments - blanks-before-subs + blank-lines-before-subs=1 + blank-lines-before-packages=1 block-brace-tightness=0 block-brace-vertical-tightness=0 brace-tightness=1 @@ -1597,6 +1837,7 @@ sub generate_options { brace-vertical-tightness=0 break-at-old-logical-breakpoints break-at-old-ternary-breakpoints + break-at-old-attribute-breakpoints break-at-old-keyword-breakpoints comma-arrow-breakpoints=1 nocheck-syntax @@ -1707,6 +1948,11 @@ sub generate_options { 'baa' => [qw(cab=0)], 'nbaa' => [qw(cab=1)], + 'blanks-before-subs' => [qw(blbs=1 blbp=1)], + 'bbs' => [qw(blbs=1 blbp=1)], + 'noblanks-before-subs' => [qw(blbs=0 blbp=0)], + 'nbbs' => [qw(blbs=0 blbp=0)], + 'break-at-old-trinary-breakpoints' => [qw(bot)], 'cti=0' => [qw(cpi=0 cbi=0 csbi=0)], @@ -1775,7 +2021,8 @@ sub generate_options { noadd-semicolons noadd-whitespace noblanks-before-blocks - noblanks-before-subs + blank-lines-before-subs=0 + blank-lines-before-packages=0 notabs ) ], @@ -1802,7 +2049,8 @@ sub generate_options { noadd-semicolons noadd-whitespace noblanks-before-blocks - noblanks-before-subs + blank-lines-before-subs=0 + blank-lines-before-packages=0 nofuzzy-line-length notabs norecombine @@ -1939,29 +2187,29 @@ sub process_command_line { elsif ( $i =~ /^-extrude$/ ) { $saw_extrude = 1; } - elsif ( $i =~ /^-(help|h|HELP|H)$/ ) { + elsif ( $i =~ /^-(help|h|HELP|H|\?)$/ ) { usage(); - exit 1; + exit 0; } elsif ( $i =~ /^-(version|v)$/ ) { show_version(); - exit 1; + exit 0; } elsif ( $i =~ /^-(dump-defaults|ddf)$/ ) { dump_defaults(@$rdefaults); - exit 1; + exit 0; } elsif ( $i =~ /^-(dump-long-names|dln)$/ ) { dump_long_names(@$roption_string); - exit 1; + exit 0; } elsif ( $i =~ /^-(dump-short-names|dsn)$/ ) { dump_short_names($rexpansion); - exit 1; + exit 0; } elsif ( $i =~ /^-(dump-token-types|dtt)$/ ) { Perl::Tidy::Tokenizer->dump_token_types(*STDOUT); - exit 1; + exit 0; } } @@ -2012,11 +2260,8 @@ EOM } if ($saw_dump_profile) { - if ($saw_dump_profile) { - dump_config_file( $fh_config, $config_file, - $rconfig_file_chatter ); - exit 1; - } + dump_config_file( $fh_config, $config_file, $rconfig_file_chatter ); + exit 0; } if ($fh_config) { @@ -2173,18 +2418,41 @@ sub check_options { # check iteration count and quietly fix if necessary: # - iterations option only applies to code beautification mode - # - it shouldn't be nessary to use more than about 2 iterations + # - the convergence check should stop most runs on iteration 2, and + # virtually all on iteration 3. But we'll allow up to 6. if ( $rOpts->{'format'} ne 'tidy' ) { $rOpts->{'iterations'} = 1; } elsif ( defined( $rOpts->{'iterations'} ) ) { if ( $rOpts->{'iterations'} <= 0 ) { $rOpts->{'iterations'} = 1 } - elsif ( $rOpts->{'iterations'} > 5 ) { $rOpts->{'iterations'} = 5 } + elsif ( $rOpts->{'iterations'} > 6 ) { $rOpts->{'iterations'} = 6 } } else { $rOpts->{'iterations'} = 1; } + # check for reasonable number of blank lines and fix to avoid problems + if ( $rOpts->{'blank-lines-before-subs'} ) { + if ( $rOpts->{'blank-lines-before-subs'} < 0 ) { + $rOpts->{'blank-lines-before-subs'} = 0; + warn "negative value of -blbs, setting 0\n"; + } + if ( $rOpts->{'blank-lines-before-subs'} > 100 ) { + warn "unreasonably large value of -blbs, reducing\n"; + $rOpts->{'blank-lines-before-subs'} = 100; + } + } + if ( $rOpts->{'blank-lines-before-packages'} ) { + if ( $rOpts->{'blank-lines-before-packages'} < 0 ) { + warn "negative value of -blbp, setting 0\n"; + $rOpts->{'blank-lines-before-packages'} = 0; + } + if ( $rOpts->{'blank-lines-before-packages'} > 100 ) { + warn "unreasonably large value of -blbp, reducing\n"; + $rOpts->{'blank-lines-before-packages'} = 100; + } + } + # see if user set a non-negative logfile-gap if ( defined( $rOpts->{'logfile-gap'} ) && $rOpts->{'logfile-gap'} >= 0 ) { @@ -2688,10 +2956,10 @@ sub read_config_file { while ( my $line = $fh->getline() ) { $line_no++; chomp $line; - next if $line =~ /^\s*#/; # skip full-line comment ( $line, $death_message ) = strip_comment( $line, $config_file, $line_no ); last if ($death_message); + next unless $line; $line =~ s/^\s*(.*?)\s*$/$1/; # trim both ends next unless $line; @@ -2700,8 +2968,12 @@ sub read_config_file { # or just # body - if ( $line =~ /^((\w+)\s*\{)?([^}]*)(\})?$/ ) { - my ( $newname, $body, $curly ) = ( $2, $3, $4 ); + my $body = $line; + my ($newname); + if ( $line =~ /^((\w+)\s*\{)(.*)\}$/ ) { + ( $newname, $body ) = ( $2, $3, ); + } + if ($body) { # handle a new alias definition if ($newname) { @@ -2746,15 +3018,6 @@ EOM push( @config_list, @$rbody_parts ); } } - - if ($curly) { - unless ($name) { - $death_message = -"Unexpected '}' seen in config file $config_file line $.\n"; - last; - } - $name = undef; - } } } eval { $fh->close() }; @@ -2763,17 +3026,29 @@ EOM sub strip_comment { + # Strip any comment from a command line my ( $instr, $config_file, $line_no ) = @_; my $msg = ""; + # check for full-line comment + if ( $instr =~ /^\s*#/ ) { + return ( "", $msg ); + } + # nothing to do if no comments if ( $instr !~ /#/ ) { return ( $instr, $msg ); } - # use simple method of no quotes + # handle case of no quotes elsif ( $instr !~ /['"]/ ) { - $instr =~ s/\s*\#.*$//; # simple trim + + # We now require a space before the # of a side comment + # this allows something like: + # -sbcp=# + # Otherwise, it would have to be quoted: + # -sbcp='#' + $instr =~ s/\s+\#.*$//; return ( $instr, $msg ); } @@ -2810,6 +3085,9 @@ EOM $outstr .= $1; $quote_char = $1; } + + # Note: not yet enforcing the space-before-hash rule for side + # comments if the parameter is quoted. elsif ( $instr =~ /\G#/gc ) { last; } @@ -2959,7 +3237,7 @@ sub show_version { print <<"EOM"; This is perltidy, v$VERSION -Copyright 2000-2010, Steve Hancock +Copyright 2000-2012, Steve Hancock Perltidy is free software and may be copied under the terms of the GNU General Public License, which is included in the distribution files. @@ -3075,6 +3353,7 @@ Following Old Breakpoints -bol break at old logical breakpoints: or, and, ||, && (default) -bok break at old list keyword breakpoints such as map, sort (default) -bot break at old conditional (ternary ?:) operator breakpoints (default) + -boa break at old attribute breakpoints -cab=n break at commas after a comma-arrow (=>): n=0 break at all commas after => n=1 stable: break unless this breaks an existing one-line container @@ -3182,7 +3461,7 @@ sub check_syntax { # Use 'perl -c' to make sure that we did not create bad syntax # This is a very good independent check for programming errors # - # Given names of the input and output files, ($ifname, $ofname), + # Given names of the input and output files, ($istream, $ostream), # we do the following: # - check syntax of the input file # - if bad, all done (could be an incomplete code snippet) @@ -3190,7 +3469,7 @@ sub check_syntax { # - if outfile syntax bad, issue warning; this implies a code bug! # - set and return flag "infile_syntax_ok" : =-1 bad 0 unknown 1 good - my ( $ifname, $ofname, $logger_object, $rOpts ) = @_; + my ( $istream, $ostream, $logger_object, $rOpts ) = @_; my $infile_syntax_ok = 0; my $line_of_dashes = '-' x 42 . "\n"; @@ -3209,7 +3488,7 @@ sub check_syntax { } # this shouldn't happen unless a termporary file couldn't be made - if ( $ifname eq '-' ) { + if ( $istream eq '-' ) { $logger_object->write_logfile_entry( "Cannot run perl -c on STDIN and STDOUT\n"); return $infile_syntax_ok; @@ -3217,13 +3496,16 @@ sub check_syntax { $logger_object->write_logfile_entry( "checking input file syntax with perl $flags\n"); - $logger_object->write_logfile_entry($line_of_dashes); # Not all operating systems/shells support redirection of the standard # error output. my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1'; - my $perl_output = do_syntax_check( $ifname, $flags, $error_redirection ); + my ( $istream_filename, $perl_output ) = + do_syntax_check( $istream, $flags, $error_redirection ); + $logger_object->write_logfile_entry( + "Input stream passed to Perl as file $istream_filename\n"); + $logger_object->write_logfile_entry($line_of_dashes); $logger_object->write_logfile_entry("$perl_output\n"); if ( $perl_output =~ /syntax\s*OK/ ) { @@ -3231,19 +3513,21 @@ sub check_syntax { $logger_object->write_logfile_entry($line_of_dashes); $logger_object->write_logfile_entry( "checking output file syntax with perl $flags ...\n"); + my ( $ostream_filename, $perl_output ) = + do_syntax_check( $ostream, $flags, $error_redirection ); + $logger_object->write_logfile_entry( + "Output stream passed to Perl as file $ostream_filename\n"); $logger_object->write_logfile_entry($line_of_dashes); - - my $perl_output = - do_syntax_check( $ofname, $flags, $error_redirection ); $logger_object->write_logfile_entry("$perl_output\n"); unless ( $perl_output =~ /syntax\s*OK/ ) { $logger_object->write_logfile_entry($line_of_dashes); $logger_object->warning( -"The output file has a syntax error when tested with perl $flags $ofname !\n" +"The output file has a syntax error when tested with perl $flags $ostream !\n" ); $logger_object->warning( - "This implies an error in perltidy; the file $ofname is bad\n"); + "This implies an error in perltidy; the file $ostream is bad\n" + ); $logger_object->report_definite_bug(); # the perl version number will be helpful for diagnosing the problem @@ -3256,7 +3540,9 @@ sub check_syntax { # Only warn of perl -c syntax errors. Other messages, # such as missing modules, are too common. They can be # seen by running with perltidy -w - $logger_object->complain("A syntax check using perl $flags gives: \n"); + $logger_object->complain("A syntax check using perl $flags\n"); + $logger_object->complain( + "for the output in file $istream_filename gives:\n"); $logger_object->complain($line_of_dashes); $logger_object->complain("$perl_output\n"); $logger_object->complain($line_of_dashes); @@ -3270,11 +3556,18 @@ sub check_syntax { } sub do_syntax_check { - my ( $fname, $flags, $error_redirection ) = @_; + my ( $stream, $flags, $error_redirection ) = @_; + + # We need a named input file for executing perl + my ( $stream_filename, $is_tmpfile ) = get_stream_as_named_file($stream); + + # TODO: Need to add name of file to log somewhere + # otherwise Perl output is hard to read + if ( !$stream_filename ) { return $stream_filename, "" } # We have to quote the filename in case it has unusual characters # or spaces. Example: this filename #CM11.pm# gives trouble. - $fname = '"' . $fname . '"'; + my $quoted_stream_filename = '"' . $stream_filename . '"'; # Under VMS something like -T will become -t (and an error) so we # will put quotes around the flags. Double quotes seem to work on @@ -3285,7 +3578,10 @@ sub do_syntax_check { $flags = '"' . $flags . '"'; # now wish for luck... - return qx/perl $flags $fname $error_redirection/; + my $msg = qx/perl $flags $quoted_stream_filename $error_redirection/; + + unlink $stream_filename if ($is_tmpfile); + return $stream_filename, $msg; } ##################################################################### @@ -3318,7 +3614,16 @@ EOM # Convert a scalar to an array. # This avoids looking for "\n" on each call to getline - my @array = map { $_ .= "\n" } split /\n/, ${$rscalar}; + # + # NOTES: The -1 count is needed to avoid loss of trailing blank lines + # (which might be important in a DATA section). + my @array; + if ( $rscalar && ${$rscalar} ) { + @array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1; + + # remove possible extra blank line introduced with split + if ( @array && $array[-1] eq "\n" ) { pop @array } + } my $i_next = 0; return bless [ \@array, $mode, $i_next ], $package; } @@ -3342,7 +3647,6 @@ getline call requires mode = 'r' but mode = ($mode); trace follows: EOM } my $i = $self->[2]++; - ##my $line = $self->[0]->[$i]; return $self->[0]->[$i]; } @@ -3443,8 +3747,6 @@ package Perl::Tidy::LineSource; sub new { my ( $class, $input_file, $rOpts, $rpending_logfile_message ) = @_; - my $input_file_copy = undef; - my $fh_copy; my $input_line_ending; if ( $rOpts->{'preserve-line-endings'} ) { @@ -3463,7 +3765,6 @@ sub new { # The reason is that temporary files cause problems on # on many systems. $rOpts->{'check-syntax'} = 0; - $input_file_copy = '-'; $$rpending_logfile_message .= < $fh, - _fh_copy => $fh_copy, _filename => $input_file, - _input_file_copy => $input_file_copy, _input_line_ending => $input_line_ending, _rinput_buffer => [], _started => 0, }, $class; } -sub get_input_file_copy_name { - my $self = shift; - my $ifname = $self->{_input_file_copy}; - unless ($ifname) { - $ifname = $self->{_filename}; - } - return $ifname; -} - sub close_input_file { my $self = shift; eval { $self->{_fh}->close() }; - eval { $self->{_fh_copy}->close() } if $self->{_fh_copy}; } sub get_line { my $self = shift; my $line = undef; my $fh = $self->{_fh}; - my $fh_copy = $self->{_fh_copy}; my $rinput_buffer = $self->{_rinput_buffer}; if ( scalar(@$rinput_buffer) ) { @@ -3523,7 +3811,6 @@ sub get_line { $self->{_started}++; } } - if ( $line && $fh_copy ) { $fh_copy->print($line); } return $line; } @@ -3541,10 +3828,9 @@ sub new { my ( $class, $output_file, $tee_file, $line_separator, $rOpts, $rpending_logfile_message, $binmode ) = @_; - my $fh = undef; - my $fh_copy = undef; - my $fh_tee = undef; - my $output_file_copy = ""; + my $fh = undef; + my $fh_tee = undef; + my $output_file_open = 0; if ( $rOpts->{'format'} eq 'tidy' ) { @@ -3568,7 +3854,6 @@ sub new { # The reason is that temporary files cause problems on # on many systems. $rOpts->{'check-syntax'} = 0; - $output_file_copy = '-'; $$rpending_logfile_message .= < $fh, - _fh_copy => $fh_copy, _fh_tee => $fh_tee, _output_file => $output_file, _output_file_open => $output_file_open, - _output_file_copy => $output_file_copy, _tee_flag => 0, _tee_file => $tee_file, _tee_file_opened => 0, @@ -3593,16 +3876,14 @@ EOM sub write_line { - my $self = shift; - my $fh = $self->{_fh}; - my $fh_copy = $self->{_fh_copy}; + my $self = shift; + my $fh = $self->{_fh}; my $output_file_open = $self->{_output_file_open}; chomp $_[0]; $_[0] .= $self->{_line_separator}; $fh->print( $_[0] ) if ( $self->{_output_file_open} ); - print $fh_copy $_[0] if ( $fh_copy && $self->{_output_file_copy} ); if ( $self->{_tee_flag} ) { unless ( $self->{_tee_file_opened} ) { $self->really_open_tee_file() } @@ -3611,15 +3892,6 @@ sub write_line { } } -sub get_output_file_copy { - my $self = shift; - my $ofname = $self->{_output_file_copy}; - unless ($ofname) { - $ofname = $self->{_output_file}; - } - return $ofname; -} - sub tee_on { my $self = shift; $self->{_tee_flag} = 1; @@ -3643,8 +3915,7 @@ sub really_open_tee_file { sub close_output_file { my $self = shift; - eval { $self->{_fh}->close() } if $self->{_output_file_open}; - eval { $self->{_fh_copy}->close() } if ( $self->{_output_file_copy} ); + eval { $self->{_fh}->close() } if $self->{_output_file_open}; $self->close_tee_file(); } @@ -3729,7 +4000,6 @@ sub new { bless { _log_file => $log_file, - _fh_warnings => undef, _rOpts => $rOpts, _fh_warnings => undef, _last_input_line_written => 0, @@ -4006,7 +4276,7 @@ sub warning { ( $fh_warnings, my $filename ) = Perl::Tidy::streamhandle( $warning_file, 'w' ); $fh_warnings or die("couldn't open $filename $!\n"); - warn "## Please see file $filename\n"; + warn "## Please see file $filename\n" unless ref($warning_file); } $self->{_fh_warnings} = $fh_warnings; } @@ -4652,7 +4922,7 @@ sub check_options { # write style sheet to STDOUT and die if requested if ( defined( $rOpts->{'stylesheet'} ) ) { write_style_sheet_file('-'); - exit 1; + exit 0; } # make sure user gives a file name after -css @@ -5591,6 +5861,7 @@ use vars qw{ $last_indentation_written $last_unadjusted_indentation $last_leading_token + $last_output_short_opening_token $saw_VERSION_in_this_file $saw_END_or_DATA_ @@ -5670,6 +5941,8 @@ use vars qw{ %block_leading_text %block_opening_line_number $csc_new_statement_ok + $csc_last_label + %csc_block_label $accumulating_text_for_block $leading_block_text $rleading_block_if_elsif_text @@ -5730,6 +6003,7 @@ use vars qw{ %opening_vertical_tightness %closing_vertical_tightness %closing_token_indentation + $some_closing_token_indentation %opening_token_right %stack_opening_token @@ -5747,6 +6021,7 @@ use vars qw{ $rOpts_break_at_old_comma_breakpoints $rOpts_break_at_old_logical_breakpoints $rOpts_break_at_old_ternary_breakpoints + $rOpts_break_at_old_attribute_breakpoints $rOpts_closing_side_comment_else_flag $rOpts_closing_side_comment_maximum_text $rOpts_continuation_indentation @@ -5857,7 +6132,7 @@ BEGIN { # We can remove semicolons after blocks preceded by these keywords @_ = qw(BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else - unless while until for foreach); + unless while until for foreach given when default); @is_block_without_semicolon{@_} = (1) x scalar(@_); # 'L' is token for opening { at hash key @@ -6012,11 +6287,12 @@ sub new { $max_gnu_stack_index = 0; $max_gnu_item_index = -1; $gnu_stack[0] = new_lp_indentation_item( 0, -1, -1, 0, 0 ); - @gnu_item_list = (); - $last_output_indentation = 0; - $last_indentation_written = 0; - $last_unadjusted_indentation = 0; - $last_leading_token = ""; + @gnu_item_list = (); + $last_output_indentation = 0; + $last_indentation_written = 0; + $last_unadjusted_indentation = 0; + $last_leading_token = ""; + $last_output_short_opening_token = 0; $saw_VERSION_in_this_file = !$rOpts->{'pass-version-line'}; $saw_END_or_DATA_ = 0; @@ -6080,6 +6356,7 @@ sub new { %block_leading_text = (); %block_opening_line_number = (); $csc_new_statement_ok = 1; + %csc_block_label = (); %saved_opening_indentation = (); $in_format_skipping_section = 0; @@ -6203,14 +6480,9 @@ sub write_line { my $tee_line = 0; if ( $line_type =~ /^POD/ ) { - # Pod docs should have a preceding blank line. But be - # very careful in __END__ and __DATA__ sections, because: - # 1. the user may be using this section for any purpose whatsoever - # 2. the blank counters are not active there - # It should be safe to request a blank line between an - # __END__ or __DATA__ and an immediately following '=head' - # type line, (types END_START and DATA_START), but not for - # any other lines of type END or DATA. + # Pod docs should have a preceding blank line. But stay + # out of __END__ and __DATA__ sections, because + # the user may be using this section for any purpose whatsoever if ( $rOpts->{'delete-pod'} ) { $skip_line = 1; } if ( $rOpts->{'tee-pod'} ) { $tee_line = 1; } if ( !$skip_line @@ -6218,7 +6490,7 @@ sub write_line { # If the previous line is a __DATA__ line (or data # contents, it's not valid to change it at all, no # matter what is in the data - && $last_line_type !~ /^(END|DATA(?:_START)?)$/ ) + && !$saw_END_or_DATA_ ) { want_blank_line(); } @@ -7156,12 +7428,12 @@ EOM } if ( $rOpts->{'dump-want-left-space'} ) { dump_want_left_space(*STDOUT); - exit 1; + exit 0; } if ( $rOpts->{'dump-want-right-space'} ) { dump_want_right_space(*STDOUT); - exit 1; + exit 0; } # default keywords for which space is introduced before an opening paren @@ -7170,15 +7442,19 @@ EOM unless while for foreach return switch case given when); @space_after_keyword{@_} = (1) x scalar(@_); - # allow user to modify these defaults - if ( @_ = split_words( $rOpts->{'space-after-keyword'} ) ) { - @space_after_keyword{@_} = (1) x scalar(@_); - } - + # first remove any or all of these if desired if ( @_ = split_words( $rOpts->{'nospace-after-keyword'} ) ) { + + # -nsak='*' selects all the above keywords + if ( @_ == 1 && $_[0] eq '*' ) { @_ = keys(%space_after_keyword) } @space_after_keyword{@_} = (0) x scalar(@_); } + # then allow user to add to these defaults + if ( @_ = split_words( $rOpts->{'space-after-keyword'} ) ) { + @space_after_keyword{@_} = (1) x scalar(@_); + } + # implement user break preferences my @all_operators = qw(% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x= @@ -7334,6 +7610,8 @@ EOM $rOpts_comma_arrow_breakpoints = $rOpts->{'comma-arrow-breakpoints'}; $rOpts_break_at_old_ternary_breakpoints = $rOpts->{'break-at-old-ternary-breakpoints'}; + $rOpts_break_at_old_attribute_breakpoints = + $rOpts->{'break-at-old-attribute-breakpoints'}; $rOpts_break_at_old_comma_breakpoints = $rOpts->{'break-at-old-comma-breakpoints'}; $rOpts_break_at_old_keyword_breakpoints = @@ -7390,6 +7668,13 @@ EOM '>' => $rOpts->{'closing-paren-indentation'}, ); + # flag indicating if any closing tokens are indented + $some_closing_token_indentation = + $rOpts->{'closing-paren-indentation'} + || $rOpts->{'closing-brace-indentation'} + || $rOpts->{'closing-square-bracket-indentation'} + || $rOpts->{'indent-closing-brace'}; + %opening_token_right = ( '(' => $rOpts->{'opening-paren-right'}, '{' => $rOpts->{'opening-hash-brace-right'}, @@ -7758,7 +8043,7 @@ EOM $tokenl eq 'my' # /^(for|foreach)$/ - && $is_for_foreach{$tokenll} + && $is_for_foreach{$tokenll} && $tokenr =~ /^\$/ ) @@ -8543,6 +8828,7 @@ sub set_white_space_flag { { $in_format_skipping_section = 0; write_logfile_entry("Exiting formatting skip section\n"); + $file_writer_object->reset_consecutive_blank_lines(); } return; } @@ -8616,7 +8902,9 @@ sub set_white_space_flag { && $last_line_had_side_comment # last line had side comment && $input_line =~ /^\s/ # there is some leading space && !$is_static_block_comment # do not make static comment hanging - && $rOpts->{'hanging-side-comments'} # user is allowing this + && $rOpts->{'hanging-side-comments'} # user is allowing + # hanging side comments + # like this ) { @@ -8655,19 +8943,32 @@ sub set_white_space_flag { # output a blank line before block comments if ( - $last_line_leading_type !~ /^[#b]$/ - && $rOpts->{'blanks-before-comments'} # only if allowed - && ! - $is_static_block_comment # never before static block comments + # unless we follow a blank or comment line + $last_line_leading_type !~ /^[#b]$/ + + # only if allowed + && $rOpts->{'blanks-before-comments'} + + # not if this is an empty comment line + && $$rtokens[0] ne '#' + + # not after a short line ending in an opening token + # because we already have space above this comment. + # Note that the first comment in this if block, after + # the 'if (', does not get a blank line because of this. + && !$last_output_short_opening_token + + # never before static block comments + && !$is_static_block_comment ) { - flush(); # switching to new output stream + flush(); # switching to new output stream $file_writer_object->write_blank_code_line(); $last_line_leading_type = 'b'; } # TRIM COMMENTS -- This could be turned off as a option - $$rtokens[0] =~ s/\s*$//; # trim right end + $$rtokens[0] =~ s/\s*$//; # trim right end if ( $rOpts->{'indent-block-comments'} @@ -8868,6 +9169,16 @@ sub set_white_space_flag { } if ( $token =~ /^sub/ ) { $token =~ s/\s+/ /g } + + # trim identifiers of trailing blanks which can occur + # under some unusual circumstances, such as if the + # identifier 'witch' has trailing blanks on input here: + # + # sub + # witch + # () # prototype may be on new line ... + # ... + if ( $type eq 'i' ) { $token =~ s/\s+$//g } } # change 'LABEL :' to 'LABEL:' @@ -9490,8 +9801,9 @@ sub output_line_to_go { # anything left to write? if ( $imin <= $imax ) { - # add a blank line before certain key types - if ( $last_line_leading_type !~ /^[#b]/ ) { + # add a blank line before certain key types but not after a comment + ##if ( $last_line_leading_type !~ /^[#b]/ ) { + if ( $last_line_leading_type !~ /^[#]/ ) { my $want_blank = 0; my $leading_token = $tokens_to_go[$imin]; my $leading_type = $types_to_go[$imin]; @@ -9499,8 +9811,8 @@ sub output_line_to_go { # blank lines before subs except declarations and one-liners # MCONVERSION LOCATION - for sub tokenization change if ( $leading_token =~ /^(sub\s)/ && $leading_type eq 'i' ) { - $want_blank = ( $rOpts->{'blanks-before-subs'} ) - && ( + $want_blank = $rOpts->{'blank-lines-before-subs'} + if ( terminal_type( \@types_to_go, \@block_type_to_go, $imin, $imax ) !~ /^[\;\}]$/ ); @@ -9511,13 +9823,13 @@ sub output_line_to_go { elsif ($leading_token =~ /^(package\s)/ && $leading_type eq 'i' ) { - $want_blank = ( $rOpts->{'blanks-before-subs'} ); + $want_blank = $rOpts->{'blank-lines-before-packages'}; } # break before certain key blocks except one-liners if ( $leading_token =~ /^(BEGIN|END)$/ && $leading_type eq 'k' ) { - $want_blank = ( $rOpts->{'blanks-before-subs'} ) - && ( + $want_blank = $rOpts->{'blank-lines-before-subs'} + if ( terminal_type( \@types_to_go, \@block_type_to_go, $imin, $imax ) ne '}' ); @@ -9526,8 +9838,9 @@ sub output_line_to_go { # Break before certain block types if we haven't had a # break at this level for a while. This is the # difficult decision.. - elsif ($leading_token =~ /^(unless|if|while|until|for|foreach)$/ - && $leading_type eq 'k' ) + elsif ($leading_type eq 'k' + && $last_line_leading_type ne 'b' + && $leading_token =~ /^(unless|if|while|until|for|foreach)$/ ) { my $lc = $nonblank_lines_at_depth[$last_line_leading_level]; if ( !defined($lc) ) { $lc = 0 } @@ -9547,7 +9860,7 @@ sub output_line_to_go { # future: send blank line down normal path to VerticalAligner Perl::Tidy::VerticalAligner::flush(); - $file_writer_object->write_blank_code_line(); + $file_writer_object->require_blank_code_lines($want_blank); } } @@ -9812,14 +10125,50 @@ sub starting_one_line_block { my $i_nonblank = ( $$rtoken_type[ $i + 1 ] eq 'b' ) ? $i + 2 : $i + 1; - if ( $$rtoken_type[$i_nonblank] eq '#' ) { + # Patch for one-line sort/map/grep/eval blocks with side comments: + # We will ignore the side comment length for sort/map/grep/eval + # because this can lead to statements which change every time + # perltidy is run. Here is an example from Denis Moskowitz which + # oscillates between these two states without this patch: + +## -------- +## grep { $_->foo ne 'bar' } # asdfa asdf asdf asdf asdf asdf asdf asdf asdf asdf asdf +## @baz; +## +## grep { +## $_->foo ne 'bar' +## } # asdfa asdf asdf asdf asdf asdf asdf asdf asdf asdf asdf +## @baz; +## -------- + + # When the first line is input it gets broken apart by the main + # line break logic in sub print_line_of_tokens. + # When the second line is input it gets recombined by + # print_line_of_tokens and passed to the output routines. The + # output routines (set_continuation_breaks) do not break it apart + # because the bond strengths are set to the highest possible value + # for grep/map/eval/sort blocks, so the first version gets output. + # It would be possible to fix this by changing bond strengths, + # but they are high to prevent errors in older versions of perl. + + if ( $$rtoken_type[$i_nonblank] eq '#' + && !$is_sort_map_grep{$block_type} ) + { + + ## POSSIBLE FUTURE PATCH FOR IGNORING SIDE COMMENT LENGTHS + ## WHEN CHECKING FOR ONE-LINE BLOCKS: + ## if (flag set) then (just add 1 to pos) $pos += length( $$rtokens[$i_nonblank] ); if ( $i_nonblank > $i + 1 ) { - $pos += length( $$rtokens[ $i + 1 ] ); + + # source whitespace could be anything, assume + # at least one space before the hash on output + if ( $$rtoken_type[ $i + 1 ] eq 'b' ) { $pos += 1 } + else { $pos += length( $$rtokens[ $i + 1 ] ) } } - if ( $pos > $rOpts_maximum_line_length ) { + if ( $pos >= $rOpts_maximum_line_length ) { return 0; } } @@ -10218,6 +10567,25 @@ sub set_logical_padding { last unless $ipad; } + # We cannot pad a leading token at the lowest level because + # it could cause a bug in which the starting indentation + # level is guessed incorrectly each time the code is run + # though perltidy, thus causing the code to march off to + # the right. For example, the following snippet would have + # this problem: + +## ov_method mycan( $package, '(""' ), $package +## or ov_method mycan( $package, '(0+' ), $package +## or ov_method mycan( $package, '(bool' ), $package +## or ov_method mycan( $package, '(nomethod' ), $package; + + # If this snippet is within a block this won't happen + # unless the user just processes the snippet alone within + # an editor. In that case either the user will see and + # fix the problem or it will be corrected next time the + # entire file is processed with perltidy. + next if ( $ipad == 0 && $levels_to_go[$ipad] == 0 ); + # next line must not be at greater depth my $iend_next = $$ri_last[ $line + 1 ]; next @@ -10690,7 +11058,9 @@ sub set_block_text_accumulator { # this will contain the column number of the last character # of the closing side comment + ##$csc_last_label="" unless $csc_last_label; $leading_block_text_line_length = + length($csc_last_label) + length($accumulating_text_for_block) + length( $rOpts->{'closing-side-comment-prefix'} ) + $leading_block_text_level * $rOpts_indent_columns + 3; @@ -10792,6 +11162,12 @@ sub accumulate_block_text { my $i_terminal = 0; # index of last nonblank token my $terminal_block_type = ""; + # update most recent statement label + $csc_last_label = "" unless ($csc_last_label); + if ( $types_to_go[0] eq 'J' ) { $csc_last_label = $tokens_to_go[0] } + my $block_label = $csc_last_label; + + # Loop over all tokens of this batch for my $i ( 0 .. $max_index_to_go ) { my $type = $types_to_go[$i]; my $block_type = $block_type_to_go[$i]; @@ -10819,6 +11195,11 @@ sub accumulate_block_text { $rblock_leading_if_elsif_text; } + if ( defined( $csc_block_label{$type_sequence} ) ) { + $block_label = $csc_block_label{$type_sequence}; + delete $csc_block_label{$type_sequence}; + } + # if we run into a '}' then we probably started accumulating # at something like a trailing 'if' clause..no harm done. if ( $accumulating_text_for_block @@ -10851,6 +11232,13 @@ sub accumulate_block_text { $vertical_aligner_object->get_output_line_number(); $block_opening_line_number{$type_sequence} = $line_number; + # set a label for this block, except for + # a bare block which already has the label + # A label can only be used on the next { + if ( $block_type =~ /:$/ ) { $csc_last_label = "" } + $csc_block_label{$type_sequence} = $csc_last_label; + $csc_last_label = ""; + if ( $accumulating_text_for_block && $levels_to_go[$i] == $leading_block_text_level ) { @@ -10913,8 +11301,14 @@ sub accumulate_block_text { $block_leading_text, $rblock_leading_if_elsif_text ); } + # if this line ends in a label then remember it for the next pass + $csc_last_label = ""; + if ( $terminal_type eq 'J' ) { + $csc_last_label = $tokens_to_go[$i_terminal]; + } + return ( $terminal_type, $i_terminal, $i_block_leading_text, - $block_leading_text, $block_line_count ); + $block_leading_text, $block_line_count, $block_label ); } } @@ -11058,7 +11452,7 @@ sub add_closing_side_comment { #--------------------------------------------------------------- my ( $terminal_type, $i_terminal, $i_block_leading_text, - $block_leading_text, $block_line_count ) + $block_leading_text, $block_line_count, $block_label ) = accumulate_csc_text(); #--------------------------------------------------------------- @@ -11111,8 +11505,9 @@ sub add_closing_side_comment { { # then make the closing side comment text + if ($block_label) { $block_label .= " " } my $token = -"$rOpts->{'closing-side-comment-prefix'} $block_type_to_go[$i_terminal]"; +"$rOpts->{'closing-side-comment-prefix'} $block_label$block_type_to_go[$i_terminal]"; # append any extra descriptive text collected above if ( $i_block_leading_text == $i_terminal ) { @@ -11296,10 +11691,18 @@ sub send_lines_to_vertical_aligner { my ( $rtokens, $rfields, $rpatterns ) = make_alignment_patterns( $ibeg, $iend ); + # Set flag to show how much level changes between this line + # and the next line, if we have it. + my $ljump = 0; + if ( $n < $n_last_line ) { + my $ibegp = $$ri_first[ $n + 1 ]; + $ljump = $levels_to_go[$ibegp] - $levels_to_go[$iend]; + } + my ( $indentation, $lev, $level_end, $terminal_type, $is_semicolon_terminated, $is_outdented_line ) = set_adjusted_indentation( $ibeg, $iend, $rfields, $rpatterns, - $ri_first, $ri_last, $rindentation_list ); + $ri_first, $ri_last, $rindentation_list, $ljump ); # we will allow outdenting of long lines.. my $outdent_long_lines = ( @@ -11363,6 +11766,39 @@ sub send_lines_to_vertical_aligner { $do_not_pad = 0; + # Set flag indicating if this line ends in an opening + # token and is very short, so that a blank line is not + # needed if the subsequent line is a comment. + # Examples of what we are looking for: + # { + # && ( + # BEGIN { + # default { + # sub { + $last_output_short_opening_token + + # line ends in opening token + = $types_to_go[$iend] =~ /^[\{\(\[L]$/ + + # and either + && ( + # line has either single opening token + $iend == $ibeg + + # or is a single token followed by opening token. + # Note that sub identifiers have blanks like 'sub doit' + || ( $iend - $ibeg <= 2 && $tokens_to_go[$ibeg] !~ /\s+/ ) + ) + + # and limit total to 10 character widths + && token_sequence_length( $ibeg, $iend ) <= 10; + +## $last_output_short_opening_token = +## $types_to_go[$iend] =~ /^[\{\(\[L]$/ +## && $iend - $ibeg <= 2 +## && $tokens_to_go[$ibeg] !~ /^sub/ +## && token_sequence_length( $ibeg, $iend ) <= 10; + } # end of loop to output each line # remember indentation of lines containing opening containers for @@ -11873,7 +12309,7 @@ sub lookup_opening_indentation { # outdenting. my ( $ibeg, $iend, $rfields, $rpatterns, $ri_first, $ri_last, - $rindentation_list ) + $rindentation_list, $level_jump ) = @_; # we need to know the last token of this line @@ -11906,7 +12342,7 @@ sub lookup_opening_indentation { ); # if we are at a closing token of some type.. - if ( $types_to_go[$ibeg] =~ /^[\)\}\]]$/ ) { + if ( $types_to_go[$ibeg] =~ /^[\)\}\]R]$/ ) { # get the indentation of the line containing the corresponding # opening token @@ -11918,9 +12354,10 @@ sub lookup_opening_indentation { $rindentation_list ); # First set the default behavior: - # default behavior is to outdent closing lines - # of the form: "); }; ]; )->xxx;" if ( + + # default behavior is to outdent closing lines + # of the form: "); }; ]; )->xxx;" $is_semicolon_terminated # and 'cuddled parens' of the form: ")->pack(" @@ -11930,12 +12367,19 @@ sub lookup_opening_indentation { && ( $nesting_depth_to_go[$iend] + 1 == $nesting_depth_to_go[$ibeg] ) ) + + # and when the next line is at a lower indentation level + # PATCH: and only if the style allows undoing continuation + # for all closing token types. We should really wait until + # the indentation of the next line is known and then make + # a decision, but that would require another pass. + || ( $level_jump < 0 && !$some_closing_token_indentation ) ) { $adjust_indentation = 1; } - # TESTING: outdent something like '),' + # outdent something like '),' if ( $terminal_type eq ',' @@ -12220,7 +12664,8 @@ sub lookup_opening_indentation { my $is_isolated_block_brace = $block_type_to_go[$ibeg] && ( $iend == $ibeg || $is_if_elsif_else_unless_while_until_for_foreach{ - $block_type_to_go[$ibeg] } ); + $block_type_to_go[$ibeg] + } ); # only do this for a ':; which is aligned with its leading '?' my $is_unaligned_colon = $types_to_go[$ibeg] eq ':' && !$is_leading; @@ -12709,7 +13154,7 @@ sub get_seqno { if ( $token eq '(' && $vert_last_nonblank_type eq 'k' ) { $alignment_type = "" unless $vert_last_nonblank_token =~ - /^(if|unless|elsif)$/; + /^(if|unless|elsif)$/; } # be sure the alignment tokens are unique @@ -13167,8 +13612,7 @@ sub terminal_type { # adjust bond strength bias #----------------------------------------------------------------- - # TESTING: add any bias set by sub scan_list at old comma - # break points. + # add any bias set by sub scan_list at old comma break points. elsif ( $type eq ',' ) { $bond_str += $bond_strength_to_go[$i]; } @@ -13780,10 +14224,12 @@ sub pad_array_to_go { # won't work very well. However, the user can always # prevent following the old breakpoints with the # -iob flag. - my $dd = shift; - my $bias = -.01; + my $dd = shift; + my $bias = -.01; + my $old_comma_break_count = 0; foreach my $ii ( @{ $comma_index[$dd] } ) { if ( $old_breakpoint_to_go[$ii] ) { + $old_comma_break_count++; $bond_strength_to_go[$ii] = $bias; # reduce bias magnitude to force breaks in order @@ -13794,6 +14240,7 @@ sub pad_array_to_go { # Also put a break before the first comma if # (1) there was a break there in the input, and # (2) that was exactly one previous break in the input + # (3) there are multiple old comma breaks # # For example, we will follow the user and break after # 'print' in this snippet: @@ -13802,6 +14249,12 @@ sub pad_array_to_go { # "\t", $have, " is ", text_unit($hu), "\n", # "\t", $want, " is ", text_unit($wu), "\n", # ; + # But we will not force a break after the first comma here + # (causes a blinker): + # $heap->{stream}->set_output_filter( + # poe::filter::reference->new('myotherfreezer') ), + # ; + # my $i_first_comma = $comma_index[$dd]->[0]; if ( $old_breakpoint_to_go[$i_first_comma] ) { my $level_comma = $levels_to_go[$i_first_comma]; @@ -13815,7 +14268,8 @@ sub pad_array_to_go { if ( $levels_to_go[$ii] == $level_comma ); } } - if ( $ibreak >= 0 && $obp_count == 1 ) { + if ( $ibreak >= 0 && $obp_count == 1 && $old_comma_break_count > 1 ) + { set_forced_breakpoint($ibreak); } } @@ -13841,7 +14295,6 @@ sub pad_array_to_go { $item_count_stack[$dd] == 0 && $is_logical_container{ $container_type[$dd] } - # TESTING: || $has_old_logical_breakpoints[$dd] ) { @@ -13961,6 +14414,13 @@ sub pad_array_to_go { $want_previous_breakpoint = $i; } } + + # Break before attributes if user broke there + if ($rOpts_break_at_old_attribute_breakpoints) { + if ( $next_nonblank_type eq 'A' ) { + $want_previous_breakpoint = $i; + } + } } next if ( $type eq 'b' ); $depth = $nesting_depth_to_go[ $i + 1 ]; @@ -14074,7 +14534,7 @@ sub pad_array_to_go { if ( $type eq ':' ) { $last_colon_sequence_number = $type_sequence; - # TESTING: retain break at a ':' line break + # retain break at a ':' line break if ( ( $i == $i_line_start || $i == $i_line_end ) && $rOpts_break_at_old_ternary_breakpoints ) { @@ -16183,6 +16643,13 @@ sub undo_forced_breakpoint_stack { # if '=' at end of line ... elsif ( $is_assignment{ $types_to_go[$iend_1] } ) { + # keep break after = if it was in input stream + # this helps prevent 'blinkers' + next if $old_breakpoint_to_go[$iend_1] + + # don't strand an isolated '=' + && $iend_1 != $ibeg_1; + my $is_short_quote = ( $types_to_go[$ibeg_2] eq 'Q' && $ibeg_2 == $iend_2 @@ -16425,8 +16892,8 @@ sub undo_forced_breakpoint_stack { foreach my $ii ( $ibeg_0, $ibeg_1, $ibeg_3, $ibeg_4 ) { $local_count++ if $ii >= 0 - && $types_to_go[$ii] eq ':' - && $levels_to_go[$ii] == $lev; + && $types_to_go[$ii] eq ':' + && $levels_to_go[$ii] == $lev; } next unless ( $local_count > 1 ); } @@ -16626,7 +17093,7 @@ sub undo_forced_breakpoint_stack { # handle line with leading = or similar elsif ( $is_assignment{ $types_to_go[$ibeg_2] } ) { - next unless $n == 1; + next unless ( $n == 1 || $n == $nmax ); next unless ( @@ -16638,7 +17105,11 @@ sub undo_forced_breakpoint_stack { # or the next line ends with a here doc || $types_to_go[$iend_2] eq 'h' + + # or this is a short line ending in ; + || ( $n == $nmax && $this_line_is_semicolon_terminated ) ); + $forced_breakpoint_to_go[$iend_1] = 0; } #---------------------------------------------------------- @@ -16652,8 +17123,25 @@ sub undo_forced_breakpoint_stack { my $bs = $bond_strength_to_go[$iend_1] + $bs_tweak; # combined line cannot be too long + my $excess = excess_line_length( $ibeg_1, $iend_2 ); + next if ( $excess > 0 ); + + # Require a few extra spaces before recombining lines if we are + # at an old breakpoint unless this is a simple list or terminal + # line. The goal is to avoid oscillating between two + # quasi-stable end states. For example this snippet caused + # problems: +## my $this = +## bless { +## TText => "[" . ( join ',', map { "\"$_\"" } split "\n", $_ ) . "]" +## }, +## $type; next - if excess_line_length( $ibeg_1, $iend_2 ) > 0; + if ( $old_breakpoint_to_go[$iend_1] + && !$this_line_is_semicolon_terminated + && $n < $nmax + && $excess + 4 > 0 + && $types_to_go[$iend_2] ne ',' ); # do not recombine if we would skip in indentation levels if ( $n < $nmax ) { @@ -17124,9 +17612,43 @@ sub set_continuation_breaks { my $next_nonblank_token = $tokens_to_go[$i_next_nonblank]; my $next_nonblank_block_type = $block_type_to_go[$i_next_nonblank]; my $strength = $bond_strength_to_go[$i_test]; - my $must_break = 0; - # FIXME: TESTING: Might want to be able to break after these + # use old breaks as a tie-breaker. For example to + # prevent blinkers with -pbp in this code: + +##@keywords{ +## qw/ARG OUTPUT PROTO CONSTRUCTOR RETURNS DESC PARAMS SEEALSO EXAMPLE/} +## = (); + + # At the same time try to prevent a leading * in this code + # with the default formatting: + # +## return +## factorial( $a + $b - 1 ) / factorial( $a - 1 ) / factorial( $b - 1 ) +## * ( $x**( $a - 1 ) ) +## * ( ( 1 - $x )**( $b - 1 ) ); + + # reduce strength a bit to break ties at an old breakpoint ... + $strength -= $tiny_bias + if $old_breakpoint_to_go[$i_test] + + # which is a 'good' breakpoint, meaning ... + # we don't want to break before it + && !$want_break_before{$type} + + # and either we want to break before the next token + # or the next token is not short (i.e. not a '*', '/' etc.) + && $i_next_nonblank <= $imax + && ( + $want_break_before{$next_nonblank_type} + || ( $lengths_to_go[ $i_next_nonblank + 1 ] - + $lengths_to_go[$i_next_nonblank] > 2 ) + || $next_nonblank_type =~ /^[\(\[\{L]$/ + ); + + my $must_break = 0; + + # FIXME: Might want to be able to break after these # force an immediate break at certain operators # with lower level than the start of the line if ( @@ -17191,6 +17713,8 @@ sub set_continuation_breaks { # Avoid a break which would strand a single punctuation # token. For example, we do not want to strand a leading # '.' which is followed by a long quoted string. + # But note that we do want to do this with -extrude (l=1) + # so please test any changes to this code on -extrude. if ( !$must_break && ( $i_test == $i_begin ) @@ -17201,7 +17725,7 @@ sub set_continuation_breaks { $leading_spaces + $lengths_to_go[ $i_test + 1 ] - $starting_sum - ) <= $rOpts_maximum_line_length + ) < $rOpts_maximum_line_length ) ) { @@ -17518,6 +18042,9 @@ sub insert_additional_breaks { $i_l = $$ri_last[$line_number]; } + # Do not leave a blank at the end of a line; back up if necessary + if ( $types_to_go[$i_break_left] eq 'b' ) { $i_break_left-- } + my $i_break_right = $i_break_left + 1; if ( $types_to_go[$i_break_right] eq 'b' ) { $i_break_right++ } @@ -20408,7 +20935,6 @@ sub entab_and_output { } else { - # REMOVE AFTER TESTING # shouldn't happen - program error counting whitespace # we'll skip entabbing warning( @@ -20438,7 +20964,6 @@ sub entab_and_output { } else { - # REMOVE AFTER TESTING # shouldn't happen - program error counting whitespace # we'll skip entabbing warning( @@ -20612,6 +21137,21 @@ sub want_blank_line { } } +sub require_blank_code_lines { + + # write out the requested number of blanks regardless of the value of -mbl + # unless -mbl=0. This allows extra blank lines to be written for subs and + # packages even with the default -mbl=1 + my $self = shift; + my $count = shift; + my $need = $count - $self->{_consecutive_blank_lines}; + my $rOpts = $self->{_rOpts}; + my $forced = $rOpts->{'maximum-consecutive-blank-lines'} > 0; + for ( my $i = 0 ; $i < $need ; $i++ ) { + $self->write_blank_code_line($forced); + } +} + sub write_blank_code_line { my $self = shift; my $forced = shift; @@ -20983,13 +21523,13 @@ use vars qw{ @paren_structural_type @brace_type @brace_structural_type - @brace_statement_type @brace_context @brace_package @square_bracket_type @square_bracket_structural_type @depth_array @nested_ternary_flag + @nested_statement_type @starting_line_of_current_depth }; @@ -22050,7 +22590,6 @@ sub prepare_for_a_new_file { $paren_structural_type[$brace_depth] = ''; $brace_type[$brace_depth] = ';'; # identify opening brace as code block $brace_structural_type[$brace_depth] = ''; - $brace_statement_type[$brace_depth] = ""; $brace_context[$brace_depth] = UNKNOWN_CONTEXT; $brace_package[$paren_depth] = $current_package; $square_bracket_type[$square_bracket_depth] = ''; @@ -22311,24 +22850,24 @@ sub prepare_for_a_new_file { # localize all package variables local ( - $tokenizer_self, $last_nonblank_token, - $last_nonblank_type, $last_nonblank_block_type, - $statement_type, $in_attribute_list, - $current_package, $context, - %is_constant, %is_user_function, - %user_function_prototype, %is_block_function, - %is_block_list_function, %saw_function_definition, - $brace_depth, $paren_depth, - $square_bracket_depth, @current_depth, - @total_depth, $total_depth, - @nesting_sequence_number, @current_sequence_number, - @paren_type, @paren_semicolon_count, - @paren_structural_type, @brace_type, - @brace_structural_type, @brace_statement_type, - @brace_context, @brace_package, - @square_bracket_type, @square_bracket_structural_type, - @depth_array, @starting_line_of_current_depth, - @nested_ternary_flag, + $tokenizer_self, $last_nonblank_token, + $last_nonblank_type, $last_nonblank_block_type, + $statement_type, $in_attribute_list, + $current_package, $context, + %is_constant, %is_user_function, + %user_function_prototype, %is_block_function, + %is_block_list_function, %saw_function_definition, + $brace_depth, $paren_depth, + $square_bracket_depth, @current_depth, + @total_depth, $total_depth, + @nesting_sequence_number, @current_sequence_number, + @paren_type, @paren_semicolon_count, + @paren_structural_type, @brace_type, + @brace_structural_type, @brace_context, + @brace_package, @square_bracket_type, + @square_bracket_structural_type, @depth_array, + @starting_line_of_current_depth, @nested_ternary_flag, + @nested_statement_type, ); # save all lexical variables @@ -22730,7 +23269,7 @@ sub prepare_for_a_new_file { if ($is_pattern) { $in_quote = 1; $type = 'Q'; - $allowed_quote_modifiers = '[cgimosxp]'; + $allowed_quote_modifiers = '[msixpodualgc]'; } else { # not a pattern; check for a /= token @@ -22856,13 +23395,12 @@ sub prepare_for_a_new_file { } } } - $brace_type[ ++$brace_depth ] = $block_type; - $brace_package[$brace_depth] = $current_package; - ( $type_sequence, $indent_flag ) = - increase_nesting_depth( BRACE, $$rtoken_map[$i_tok] ); + $brace_type[ ++$brace_depth ] = $block_type; + $brace_package[$brace_depth] = $current_package; $brace_structural_type[$brace_depth] = $type; $brace_context[$brace_depth] = $context; - $brace_statement_type[$brace_depth] = $statement_type; + ( $type_sequence, $indent_flag ) = + increase_nesting_depth( BRACE, $$rtoken_map[$i_tok] ); }, '}' => sub { $block_type = $brace_type[$brace_depth]; @@ -22888,8 +23426,7 @@ sub prepare_for_a_new_file { $tok = $brace_type[$brace_depth]; } - $context = $brace_context[$brace_depth]; - $statement_type = $brace_statement_type[$brace_depth]; + $context = $brace_context[$brace_depth]; if ( $brace_depth > 0 ) { $brace_depth--; } }, '&' => sub { # maybe sub call? start looking @@ -22899,7 +23436,14 @@ sub prepare_for_a_new_file { # got mistaken as a q operator in an early version: # print BODY &q(<<'EOT'); if ( $expecting != OPERATOR ) { - scan_identifier(); + + # But only look for a sub call if we are expecting a term or + # if there is no existing space after the &. + # For example we probably don't want & as sub call here: + # Fcntl::S_IRUSR & $mode; + if ( $expecting == TERM || $next_type ne 'b' ) { + scan_identifier(); + } } else { } @@ -22939,7 +23483,7 @@ sub prepare_for_a_new_file { if ($is_pattern) { $in_quote = 1; $type = 'Q'; - $allowed_quote_modifiers = '[cgimosxp]'; + $allowed_quote_modifiers = '[msixpodualgc]'; } else { ( $type_sequence, $indent_flag ) = @@ -23298,12 +23842,18 @@ sub prepare_for_a_new_file { # ref: camel 3 p 147, # but perl may accept undocumented flags # perl 5.10 adds 'p' (preserve) + # Perl version 5.16, http://perldoc.perl.org/perlop.html, has these: + # /PATTERN/msixpodualgc or m?PATTERN?msixpodualgc + # s/PATTERN/REPLACEMENT/msixpodualgcer + # y/SEARCHLIST/REPLACEMENTLIST/cdsr + # tr/SEARCHLIST/REPLACEMENTLIST/cdsr + # qr/STRING/msixpodual my %quote_modifiers = ( - 's' => '[cegimosxp]', - 'y' => '[cds]', - 'tr' => '[cds]', - 'm' => '[cgimosxp]', - 'qr' => '[imosxp]', + 's' => '[msixpodualgcer]', + 'y' => '[cdsr]', + 'tr' => '[cdsr]', + 'm' => '[msixpodualgc]', + 'qr' => '[msixpodual]', 'q' => "", 'qq' => "", 'qw' => "", @@ -23837,8 +24387,6 @@ EOM # mistaking {s} in the following for a quoted bare word: # for(@[){s}bla}BLA} # Also treat q in something like var{-q} as a bare word, not qoute operator - ##if ( ( $last_nonblank_type eq 'L' ) - ## && ( $next_nonblank_token eq '}' ) ) if ( $next_nonblank_token eq '}' && ( @@ -23943,9 +24491,15 @@ EOM if ($next_nonblank_token) { if ( $is_keyword{$next_nonblank_token} ) { - warning( + + # Assume qw is used as a quote and okay, as in: + # use constant qw{ DEBUG 0 }; + # Not worth trying to parse for just a warning + if ( $next_nonblank_token ne 'qw' ) { + warning( "Attempting to define constant '$next_nonblank_token' which is a perl keyword\n" - ); + ); + } } # FIXME: could check for error in which next token is @@ -24095,13 +24649,26 @@ EOM $statement_type = $tok; # next '{' is block } + # # indent trailing if/unless/while/until # outdenting will be handled by later indentation loop - if ( $tok =~ /^(if|unless|while|until)$/ - && $next_nonblank_token ne '(' ) - { - $indent_flag = 1; - } +## DEACTIVATED: unfortunately this can cause some unwanted indentation like: +##$opt_o = 1 +## if !( +## $opt_b +## || $opt_c +## || $opt_d +## || $opt_f +## || $opt_i +## || $opt_l +## || $opt_o +## || $opt_x +## ); +## if ( $tok =~ /^(if|unless|while|until)$/ +## && $next_nonblank_token ne '(' ) +## { +## $indent_flag = 1; +## } } # check for inline label following @@ -24545,15 +25112,29 @@ EOM if ( $type eq 'k' ) { $indented_if_level = $level_in_tokenizer; } - } - if ( $routput_block_type->[$i] ) { - $nesting_block_flag = 1; - $nesting_block_string .= '1'; + # do not change container environement here if we are not + # at a real list. Adding this check prevents "blinkers" + # often near 'unless" clauses, such as in the following + # code: +## next +## unless -e ( +## $archive = +## File::Spec->catdir( $_, "auto", $root, "$sub$lib_ext" ) +## ); + + $nesting_block_string .= "$nesting_block_flag"; } else { - $nesting_block_flag = 0; - $nesting_block_string .= '0'; + + if ( $routput_block_type->[$i] ) { + $nesting_block_flag = 1; + $nesting_block_string .= '1'; + } + else { + $nesting_block_flag = 0; + $nesting_block_string .= '0'; + } } # we will use continuation indentation within containers @@ -24571,8 +25152,8 @@ EOM else { $bit = 1 unless - $is_logical_container{ $routput_container_type->[$i] - }; + $is_logical_container{ $routput_container_type->[$i] + }; } } $nesting_list_string .= $bit; @@ -24661,7 +25242,8 @@ EOM # /^(\}|\{|BEGIN|END|CHECK|INIT|AUTOLOAD|DESTROY|UNITCHECK|continue|;|if|elsif|else|unless|while|until|for|foreach)$/ elsif ( $is_zero_continuation_block_type{ - $routput_block_type->[$i] } ) + $routput_block_type->[$i] + } ) { $in_statement_continuation = 0; } @@ -24670,7 +25252,8 @@ EOM # /^(sort|grep|map|do|eval)$/ ) elsif ( $is_not_zero_continuation_block_type{ - $routput_block_type->[$i] } ) + $routput_block_type->[$i] + } ) { } @@ -25207,7 +25790,7 @@ sub code_block_type { # or a sub definition elsif ( ( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' ) - && $last_nonblank_token =~ /^sub\b/ ) + && $last_nonblank_token =~ /^(sub|package)\b/ ) { return $last_nonblank_token; } @@ -25454,7 +26037,8 @@ sub increase_nesting_depth { my ( $aa, $pos ) = @_; # USES GLOBAL VARIABLES: $tokenizer_self, @current_depth, - # @current_sequence_number, @depth_array, @starting_line_of_current_depth + # @current_sequence_number, @depth_array, @starting_line_of_current_depth, + # $statement_type my $bb; $current_depth[$aa]++; $total_depth++; @@ -25491,6 +26075,8 @@ sub increase_nesting_depth { } } } + $nested_statement_type[$aa][ $current_depth[$aa] ] = $statement_type; + $statement_type = ""; return ( $seqno, $indent ); } @@ -25500,6 +26086,7 @@ sub decrease_nesting_depth { # USES GLOBAL VARIABLES: $tokenizer_self, @current_depth, # @current_sequence_number, @depth_array, @starting_line_of_current_depth + # $statement_type my $bb; my $seqno = 0; my $input_line_number = $tokenizer_self->{_last_line_number}; @@ -25514,6 +26101,7 @@ sub decrease_nesting_depth { if ( $aa == QUESTION_COLON ) { $outdent = $nested_ternary_flag[ $current_depth[$aa] ]; } + $statement_type = $nested_statement_type[$aa][ $current_depth[$aa] ]; # check that any brace types $bb contained within are balanced for $bb ( 0 .. $#closing_brace_names ) { @@ -26258,7 +26846,7 @@ sub do_scan_package { # check for error my ( $next_nonblank_token, $i_next ) = find_next_nonblank_token( $i, $rtokens, $max_token_index ); - if ( $next_nonblank_token !~ /^[;\}]$/ ) { + if ( $next_nonblank_token !~ /^[;\{\}]$/ ) { warning( "Unexpected '$next_nonblank_token' after package name '$tok'\n" ); @@ -27015,7 +27603,7 @@ sub pattern_expected { # -1 - no my ( $i, $rtokens, $max_token_index ) = @_; my $next_token = $$rtokens[ $i + 1 ]; - if ( $next_token =~ /^[cgimosxp]/ ) { $i++; } # skip possible modifier + if ( $next_token =~ /^[msixpodualgc]/ ) { $i++; } # skip possible modifier my ( $next_nonblank_token, $i_next ) = find_next_nonblank_token( $i, $rtokens, $max_token_index ); @@ -28381,6 +28969,8 @@ BEGIN { vec warn while + given + when ); @is_keyword_taking_list{@keyword_taking_list} = (1) x scalar(@keyword_taking_list); @@ -28393,7 +28983,7 @@ BEGIN { # __PACKAGE__ # ); - # The list of keywords was extracted from function 'keyword' in + # The list of keywords was originally extracted from function 'keyword' in # perl file toke.c version 5.005.03, using this utility, plus a # little editing: (file getkwd.pl): # while (<>) { while (/\"(.*)\"/g) { print "$1\n"; } } @@ -28444,7 +29034,7 @@ For example, the perltidy script is basically just this: Perl::Tidy::perltidy(); The module accepts input and output streams by a variety of methods. -The following list of parameters may be any of a the following: a +The following list of parameters may be any of the following: a filename, an ARRAY reference, a SCALAR reference, or an object with either a B or B method, as appropriate. @@ -28477,8 +29067,9 @@ close method will be called at the end of the stream. =item source -If the B parameter is given, it defines the source of the -input stream. +If the B parameter is given, it defines the source of the input stream. +If an input stream is defined with the B parameter then no other source +filenames may be specified in the @ARGV array or B parameter. =item destination @@ -28487,8 +29078,10 @@ file or memory location to receive output of perltidy. =item stderr -The B parameter allows the calling program to capture the output -to what would otherwise go to the standard error output device. +The B parameter allows the calling program to redirect to a file the +output of what would otherwise go to the standard error output device. Unlike +many other parameters, $stderr must be a file or file handle; it may not be a +reference to a SCALAR or ARRAY. =item perltidyrc @@ -28565,7 +29158,22 @@ B in the perltidy distribution. =back -=head1 EXAMPLE +=head1 NOTES ON FORMATTING PARAMETERS + +Parameters which control formatting may be passed in several ways: in a +F<.perltidyrc> configuration file, in the B parameter, and in the +B parameter. + +The B<-syn> (B<--check-syntax>) flag may be used with all source and +destination streams except for standard input and output. However +data streams which are not associated with a filename will +be copied to a temporary file before being be passed to Perl. This +use of temporary files can cause somewhat confusing output from Perl. + +=head1 EXAMPLES + +The perltidy script itself is a simple example, and several +examples are given in the perltidy distribution. The following example passes perltidy a snippet as a reference to a string and receives the result back in a reference to @@ -28738,7 +29346,14 @@ to perltidy. =head1 VERSION -This man page documents Perl::Tidy version 20101217. +This man page documents Perl::Tidy version 20120701. + +=head1 LICENSE + +This package is free software; you can redistribute it and/or modify it +under the terms of the "GNU General Public License". + +Please refer to the file "COPYING" for details. =head1 AUTHOR