New upstream version 20170521

diff --git a/CHANGES b/CHANGES
index 0ae4633c4a973370ee6982c9873ff0a61fc463cd..1f6a50a900718be9444e00c9ede2c572f0f5fd07 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,72 @@
 Perltidy Change Log
 Perltidy Change Log

+  2017 05 21
+      - Fixed debian #862667: failure to check for perltidy.ERR deletion can lead 
+        to overwriting abritrary files by symlink attack. Perltidy was continuing 
+        to write files after an unlink failure.  Thanks to Don Armstrong 
+        for a patch.
+
+      - Fixed RT #116344, perltidy fails on certain anonymous hash references:
+        in the following code snippet the '?' was misparsed as a pattern 
+        delimiter rather than a ternary operator.
+            return ref {} ? 1 : 0;
+
+      - Fixed RT #113792: misparsing of a fat comma (=>) right after 
+        the __END__ or __DATA__ tokens.  These keywords were getting
+        incorrectly quoted by the following => operator.
+
+      - Fixed RT #118558. Custom Getopt::Long configuration breaks parsing 
+        of perltidyrc.  Perltidy was resetting the users configuration too soon.
+
+      - Fixed RT #119140, failure to parse double diamond operator.  Code to
+        handle this new operator has been added.
+
+      - Fixed RT #120968.  Fixed problem where -enc=utf8 didn't work 
+        with --backup-and-modify-in-place. Thanks to Heinz Knutzen for this patch.
+
+      - Fixed minor formatting issue where one-line blocks for subs with signatures 
+        were unnecesarily broken
+
+      - RT #32905, patch to fix utf-8 error when output was STDOUT. 
+
+      - RT #79947, improved spacing of try/catch/finally blocks. Thanks to qsimpleq
+        for a patch.
+
+      - Fixed #114909, Anonymous subs with signatures and prototypes misparsed as
+        broken ternaries, in which a statement such as this was not being parsed
+        correctly:
+            return sub ( $fh, $out ) : prototype(*$) { ... }
+
+      - Implemented RT #113689, option to introduces spaces after an opening block
+        brace and before a closing block brace. Four new optional controls are
+        added. The first two define the minimum number of blank lines to be
+        inserted 
+
+         -blao=i or --blank-lines-after-opening-block=i
+         -blbc=i or --blank-lines-before-closing-block=i
+
+        where i is an integer, the number of lines (the default is 0).  
+
+        The second two define the types of blocks to which the first two apply 
+
+         -blaol=s or --blank-lines-after-opening-block-list=s
+         -blbcl=s or --blank-lines-before-closing-block-list=s
+    
+        where s is a string of possible block keywords (default is just 'sub',
+        meaning a named subroutine).
+
+        For more information please see the documentation.
+
+      - The method for specifying block types for certain input parameters has
+        been generalized to distinguish between normal named subroutines and
+        anonymous subs.  The keyword for normal subroutines remains 'sub', and
+        the new keyword for anonymous subs is 'asub'. 
+
+      - Minor documentation changes. The BUGS sections now have a link
+        to CPAN where most open bugs and issues can be reviewed and bug reports
+        can be submitted.  The information in the AUTHOR and CREDITS sections of
+        the man pages have been removed from the man pages to streamline the
+        documentation. This information is still in the source code.
+

   2016 03 02
       - RT #112534. Corrected a minor problem in which an unwanted newline
         was placed before the closing brace of an anonymous sub with 
   2016 03 02
       - RT #112534. Corrected a minor problem in which an unwanted newline
         was placed before the closing brace of an anonymous sub with 

diff --git a/MANIFEST b/MANIFEST
index 2a2ac5200a44f07da152e738e297bb069d6dd0b6..1879424fe0ca2493e7397bb7a7d068df1f02e9d6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -20,6 +20,7 @@ examples/ex_mp.pl
 examples/lextest
 examples/find_naughty.pl
 examples/perltidyrc_dump.pl
 examples/lextest
 examples/find_naughty.pl
 examples/perltidyrc_dump.pl

+examples/perltidy_okw.pl

 examples/perlcomment.pl
 examples/perllinetype.pl
 examples/perlmask.pl
 examples/perlcomment.pl
 examples/perllinetype.pl
 examples/perlmask.pl

diff --git a/META.yml b/META.yml
index ed3d42e9078e300aeba359c3ea26527234bf1819..c1d906ce8b1304d32c361af082e1ed8da856005d 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Perl-Tidy
 --- #YAML:1.0
 name:               Perl-Tidy

-version:            20160302
+version:            20170521

 abstract:           indent and reformat perl scripts
 author:
     - Steve Hancock <perltidy@perltidy.sourceforge.net>
 abstract:           indent and reformat perl scripts
 author:
     - Steve Hancock <perltidy@perltidy.sourceforge.net>

diff --git a/README b/README
index be16c842f0848a92c1508a134e94b23fdae7d4fa..b7e35369d2f56a8c99cfaf162a600b549e1e7b50 100644 (file)
--- a/README
+++ b/README
@@ -48,10 +48,10 @@ WHAT NEXT
     Reading the brief tutorial should help you use perltidy effectively.
 
 FEEDBACK / BUG REPORTS
     Reading the brief tutorial should help you use perltidy effectively.
 
 FEEDBACK / BUG REPORTS

-    Bug reports, comments and suggestions are welcome. Attach the smallest
-    piece of code which demonstrates the bug or issue.

 
 

-     Steve Hancock
-     perltidy at users.sourceforge.net
-     http://perltidy.sourceforge.net
+    A list of current bugs and issues can be found at the CPAN site
+
+     https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy
+
+    To report a new bug or problem, use the link on this page .  

 
 

diff --git a/TODO b/TODO
index 396c5d0a405c30c829871465952c491b0aeb2378..b8359cfe8045b0c3a119197bb78e7ad500adb55c 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,39 +1,6 @@
 Perltidy TODO List
 Perltidy TODO List

-    This is a partial "wish-list" of features to add and things to do. For
-    the latest list of bugs and feature requests at CPAN see:

 
 

-    https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy
-
-  Improved Vertical Alignment
-    There are still many opportunities for improving vertical alignment.
-
-  Documentation
-    A FAQ is needed to explain some of the more subtle formatting issues,
-    and to give examples of different styles.
-
-    The -formatter callback object documentation is incomplete.
+    For a list of bugs and feature requests see:

 
 

-  HTML writer
-    The HTML writer does not colorize interpolated identifiers in here
-    documents or quoted strings. The tokenizer outputs interpolation
-    information for here docs; it still needs to be updated to do this for
-    multi-line quotes. Then code needs to be written to scan for and markup
-    identifiers.
-
-Things which have been suggested but will not be done
-  Recursive file processing
-    A -r flag might be nice, but this is best handled by an exterior shell
-    script.
-
-  Make perltidy support the syntax of module XXX
-    This generally won't be done unless the module is part of the core perl
-    distribution because it is such an open-ended problem. Compounding the
-    problem is the fact that perltidy often is invoked within an editor on
-    small snippets of code, so it must to work correctly without seeing any
-    particular 'use xxx' statement. Therefore, any syntax changes that
-    conflict with standard Perl syntax can't easily be handled.
-
-    However, an effort is being made to make perltidy generally more
-    tolerant of extensions to perl syntax. Also, the pre- and post-filter
-    capabilities of the Tidy.pm module may help.
+    https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy

 
 

diff --git a/bin/perltidy b/bin/perltidy
index 86bf60d5e794102d33923204b338413f1d145a09..174f792ab0b17455702263ac7971e4b07396fb4c 100755 (executable)
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -2331,7 +2331,7 @@ 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<n> blank lines precede a package
 =item B<-blbp=n>,  B<--blank-lines-before-packages=n>
 
 The parameter B<-blbp=n> requests that least B<n> blank lines precede a package

-which does not follow a comment.  The default is <-blbp=1>.  
+which does not follow a comment.  The default is B<-blbp=1>.  

 
 This parameter interacts with the value B<k> of the parameter
 B<--maximum-consecutive-blank-lines=k> (B<-mbl=k>) in the same way as described
 
 This parameter interacts with the value B<k> of the parameter
 B<--maximum-consecutive-blank-lines=k> (B<-mbl=k>) in the same way as described


@@ -2379,6 +2379,60 @@ This controls how often perltidy is allowed to add blank lines before
 certain block types (see previous section).  The default is 8.  Entering
 a value of B<0> is equivalent to entering a very large number.
 
 certain block types (see previous section).  The default is 8.  Entering
 a value of B<0> is equivalent to entering a very large number.
 

+=item B<-blao=i> or B<--blank-lines-after-opening-block=i>
+
+This control places a minimum of B<i> blank lines B<after> a line which B<ends>
+with an opening block brace of a specified type.  By default, this only applies
+to the block of a named B<sub>, but this can be changed (see B<-blaol> below).
+The default is not to do this (B<i=0>).
+
+Please see the note below on using the B<-blao> and B<-blbc> options.
+
+=item B<-blbc=i> or B<--blank-lines-before-closing-block=i>
+
+This control places a minimum of B<i> blank lines B<before> a line which
+B<begins> with a closing block brace of a specified type.  By default, this
+only applies to the block of a named B<sub>, but this can be changed (see
+B<-blbcl> below).  The default is not to do this (B<i=0>).
+
+=item B<-blaol=s> or B<--blank-lines-after-opening-block-list=s>
+
+The parameter B<s> is a list of block type keywords to which the flag B<-blao>
+should apply.  The section L<"Specifying Block Types"> explains how to list
+block types.
+
+=item B<-blbcl=s> or B<--blank-lines-before-closing-block-list=s>
+
+This parameter is a list of block type keywords to which the flag B<-blbc>
+should apply.  The section L<"Specifying Block Types"> explains how to list
+block types.
+
+=item Note on using the B<-blao> and B<-blbc> options.
+
+These blank line controls introduce a certain minimum number of blank lines in
+the text, but the final number of blank lines may be greater, depending on
+values of the other blank line controls and the number of old blank lines.  A
+consequence is that introducing blank lines with these and other controls
+cannot be exactly undone, so some experimentation with these controls is
+recommended before using them.
+
+For example, suppose that for some reason we decide to introduce one blank
+space at the beginning and ending of all blocks.  We could do
+this using
+
+  perltidy -blao=2 -blbc=2 -blaol='*' -blbcl='*' filename
+
+Now suppose the script continues to be developed, but at some later date we
+decide we don't want these spaces after all. we might expect that running with
+the flags B<-blao=0> and B<-blbc=0> will undo them.  However, by default
+perltidy retains single blank lines, so the blank lines remain.  
+
+We can easily fix this by telling perltidy to ignore old blank lines by
+including the added parameter B<-kbl=0> and rerunning. Then the unwanted blank
+lines will be gone.  However, this will cause all old blank lines to be
+ignored, perhaps even some that were added by hand to improve formatting. So
+please be cautious when using these parameters.
+

 =item B<-mbl=n> B<--maximum-consecutive-blank-lines=n>   
 
 This parameter specifies the maximum number of consecutive blank lines which
 =item B<-mbl=n> B<--maximum-consecutive-blank-lines=n>   
 
 This parameter specifies the maximum number of consecutive blank lines which


@@ -3027,6 +3081,9 @@ of the keyword which introduces that block, such as B<if>, B<else>, or B<sub>.
 An exception is a labeled block, which has no keyword, and should be specified
 with just a colon.  To specify all blocks use B<'*'>.
 
 An exception is a labeled block, which has no keyword, and should be specified
 with just a colon.  To specify all blocks use B<'*'>.
 

+The keyword B<sub> indicates a named sub.  For anonymous subs, use the special
+keyword B<asub>.
+

 For example, the following parameter specifies C<sub>, labels, C<BEGIN>, and
 C<END> blocks:
 
 For example, the following parameter specifies C<sub>, labels, C<BEGIN>, and
 C<END> blocks:
 


@@ -3139,32 +3196,19 @@ perlstyle(1), Perl::Tidy(3)
 
 =head1 VERSION
 
 
 =head1 VERSION
 

-This man page documents perltidy version 20160302.
-
-=head1 CREDITS
-
-Michael Cartmell supplied code for adaptation to VMS and helped with
-v-strings.
-
-Yves Orton supplied code for adaptation to the various versions
-of Windows. 
-
-Axel Rose supplied a patch for MacPerl.
+This man page documents perltidy version 20170521.

 
 

-Hugh S. Myers designed and implemented the initial Perl::Tidy module interface. 
+=head1 BUG REPORTS

 
 

-Many others have supplied key ideas, suggestions, and bug reports;
-see the CHANGES file.
+A list of current bugs and issues can be found at the CPAN site

 
 

-=head1 AUTHOR
+     https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy

 
 

-  Steve Hancock
-  email: perltidy at users.sourceforge.net
-  http://perltidy.sourceforge.net
+To report a new bug or problem, use the link on this page.  

 
 =head1 COPYRIGHT
 
 
 =head1 COPYRIGHT
 

-Copyright (c) 2000-2012 by Steve Hancock
+Copyright (c) 2000-2017 by Steve Hancock

 
 =head1 LICENSE
 
 
 =head1 LICENSE
 

diff --git a/docs/perltidy.1 b/docs/perltidy.1
index b2a3c6538a0a46c3da762971e9916797de4de401..cf35a78f237015e48903aa90f29ce60c586d3797 100644 (file)
--- a/docs/perltidy.1
+++ b/docs/perltidy.1
@@ -124,7 +124,7 @@
 .\" ========================================================================
 .\"
 .IX Title "PERLTIDY 1"
 .\" ========================================================================
 .\"
 .IX Title "PERLTIDY 1"

-.TH PERLTIDY 1 "2016-03-01" "perl v5.14.2" "User Contributed Perl Documentation"
+.TH PERLTIDY 1 "2017-05-21" "perl v5.14.2" "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
 .\" For nroff, turn off justification.  Always turn off hyphenation; it makes
 .\" way too many mistakes in technical documents.
 .if n .ad l


@@ -2450,7 +2450,7 @@ 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
 .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>.
+which does not follow a comment.  The default is \fB\-blbp=1\fR.

 .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
 .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


@@ -2487,6 +2487,57 @@ This is negated with \fB\-nbbb\fR or  \fB\-\-noblanks\-before\-blocks\fR.
 This controls how often perltidy is allowed to add blank lines before 
 certain block types (see previous section).  The default is 8.  Entering
 a value of \fB0\fR is equivalent to entering a very large number.
 This controls how often perltidy is allowed to add blank lines before 
 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\-blao=i\fR or \fB\-\-blank\-lines\-after\-opening\-block=i\fR" 4
+.IX Item "-blao=i or --blank-lines-after-opening-block=i"
+This control places a minimum of \fBi\fR blank lines \fBafter\fR a line which \fBends\fR
+with an opening block brace of a specified type.  By default, this only applies
+to the block of a named \fBsub\fR, but this can be changed (see \fB\-blaol\fR below).
+The default is not to do this (\fBi=0\fR).
+.Sp
+Please see the note below on using the \fB\-blao\fR and \fB\-blbc\fR options.
+.IP "\fB\-blbc=i\fR or \fB\-\-blank\-lines\-before\-closing\-block=i\fR" 4
+.IX Item "-blbc=i or --blank-lines-before-closing-block=i"
+This control places a minimum of \fBi\fR blank lines \fBbefore\fR a line which
+\&\fBbegins\fR with a closing block brace of a specified type.  By default, this
+only applies to the block of a named \fBsub\fR, but this can be changed (see
+\&\fB\-blbcl\fR below).  The default is not to do this (\fBi=0\fR).
+.IP "\fB\-blaol=s\fR or \fB\-\-blank\-lines\-after\-opening\-block\-list=s\fR" 4
+.IX Item "-blaol=s or --blank-lines-after-opening-block-list=s"
+The parameter \fBs\fR is a list of block type keywords to which the flag \fB\-blao\fR
+should apply.  The section \*(L"Specifying Block Types\*(R" explains how to list
+block types.
+.IP "\fB\-blbcl=s\fR or \fB\-\-blank\-lines\-before\-closing\-block\-list=s\fR" 4
+.IX Item "-blbcl=s or --blank-lines-before-closing-block-list=s"
+This parameter is a list of block type keywords to which the flag \fB\-blbc\fR
+should apply.  The section \*(L"Specifying Block Types\*(R" explains how to list
+block types.
+.IP "Note on using the \fB\-blao\fR and \fB\-blbc\fR options." 4
+.IX Item "Note on using the -blao and -blbc options."
+These blank line controls introduce a certain minimum number of blank lines in
+the text, but the final number of blank lines may be greater, depending on
+values of the other blank line controls and the number of old blank lines.  A
+consequence is that introducing blank lines with these and other controls
+cannot be exactly undone, so some experimentation with these controls is
+recommended before using them.
+.Sp
+For example, suppose that for some reason we decide to introduce one blank
+space at the beginning and ending of all blocks.  We could do
+this using
+.Sp
+.Vb 1
+\&  perltidy \-blao=2 \-blbc=2 \-blaol=\*(Aq*\*(Aq \-blbcl=\*(Aq*\*(Aq filename
+.Ve
+.Sp
+Now suppose the script continues to be developed, but at some later date we
+decide we don't want these spaces after all. we might expect that running with
+the flags \fB\-blao=0\fR and \fB\-blbc=0\fR will undo them.  However, by default
+perltidy retains single blank lines, so the blank lines remain.
+.Sp
+We can easily fix this by telling perltidy to ignore old blank lines by
+including the added parameter \fB\-kbl=0\fR and rerunning. Then the unwanted blank
+lines will be gone.  However, this will cause all old blank lines to be
+ignored, perhaps even some that were added by hand to improve formatting. So
+please be cautious when using these parameters.

 .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
 .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


@@ -3129,6 +3180,9 @@ of the keyword which introduces that block, such as \fBif\fR, \fBelse\fR, or \fB
 An exception is a labeled block, which has no keyword, and should be specified
 with just a colon.  To specify all blocks use \fB'*'\fR.
 .PP
 An exception is a labeled block, which has no keyword, and should be specified
 with just a colon.  To specify all blocks use \fB'*'\fR.
 .PP

+The keyword \fBsub\fR indicates a named sub.  For anonymous subs, use the special
+keyword \fBasub\fR.
+.PP

 For example, the following parameter specifies \f(CW\*(C`sub\*(C'\fR, labels, \f(CW\*(C`BEGIN\*(C'\fR, and
 \&\f(CW\*(C`END\*(C'\fR blocks:
 .PP
 For example, the following parameter specifies \f(CW\*(C`sub\*(C'\fR, labels, \f(CW\*(C`BEGIN\*(C'\fR, and
 \&\f(CW\*(C`END\*(C'\fR blocks:
 .PP


@@ -3229,31 +3283,19 @@ purpose of this rule is to prevent generating confusing filenames such as
 \&\fIperlstyle\fR\|(1), \fIPerl::Tidy\fR\|(3)
 .SH "VERSION"
 .IX Header "VERSION"
 \&\fIperlstyle\fR\|(1), \fIPerl::Tidy\fR\|(3)
 .SH "VERSION"
 .IX Header "VERSION"

-This man page documents perltidy version 20160302.
-.SH "CREDITS"
-.IX Header "CREDITS"
-Michael Cartmell supplied code for adaptation to \s-1VMS\s0 and helped with
-v\-strings.
+This man page documents perltidy version 20170521.
+.SH "BUG REPORTS"
+.IX Header "BUG REPORTS"
+A list of current bugs and issues can be found at the \s-1CPAN\s0 site

 .PP
 .PP

-Yves Orton supplied code for adaptation to the various versions
-of Windows.
-.PP
-Axel Rose supplied a patch for MacPerl.
-.PP
-Hugh S. Myers designed and implemented the initial Perl::Tidy module interface.
-.PP
-Many others have supplied key ideas, suggestions, and bug reports;
-see the \s-1CHANGES\s0 file.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-.Vb 3
-\&  Steve Hancock
-\&  email: perltidy at users.sourceforge.net
-\&  http://perltidy.sourceforge.net
+.Vb 1
+\&     https://rt.cpan.org/Public/Dist/Display.html?Name=Perl\-Tidy

 .Ve
 .Ve

+.PP
+To report a new bug or problem, use the link on this page.

 .SH "COPYRIGHT"
 .IX Header "COPYRIGHT"
 .SH "COPYRIGHT"
 .IX Header "COPYRIGHT"

-Copyright (c) 2000\-2012 by Steve Hancock
+Copyright (c) 2000\-2017 by Steve Hancock

 .SH "LICENSE"
 .IX Header "LICENSE"
 This package is free software; you can redistribute it and/or modify it
 .SH "LICENSE"
 .IX Header "LICENSE"
 This package is free software; you can redistribute it and/or modify it

diff --git a/examples/perltidy_okw.pl b/examples/perltidy_okw.pl
new file mode 100644 (file)
index 0000000..d12370f
--- /dev/null
+++ b/examples/perltidy_okw.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -w
+
+# Example use a perltidy postfilter to outdent certain leading keywords
+
+# Usage:
+# perltidy_okw.pl -sil=1 file.pl
+
+# This version outdents hardwired keywords 'step', 'command', and 'expected'
+# The following is an example of the desired effect. The flag -sil=1 is
+# needed to get a starting indentation level so that the outdenting 
+# is visible.
+
+=pod
+step 4;
+command 'Share project: project1';
+expected 'A project megjelenik a serveren';
+      shareProject ('project1', 'login', '123', Login => 1, PortalServer =>
+$openJoinAddress);
+      valueCheck ('project1_share', listBIMCloudData ('projects'));
+
+
+step 5;
+command 'quitAC';
+      quitAC ();
+=cut
+
+# Run it exactly like perltidy, and the postfilter removes the
+# leading whitespace of lines which begin with your keywords.  The
+# postfilter works on the file as a single string, so the 'm' quote
+# modifier is needed to make the ^ and $ string positioners work
+
+# See http://perltidy.sourceforge.net/Tidy.html for further details
+# on how to call Perl::Tidy
+use Perl::Tidy;
+my $arg_string = undef;
+my $err=Perl::Tidy::perltidy(
+    argv => $arg_string,
+    postfilter =>
+      sub { $_ = $_[0]; s/^\s*(step|command|expected)(.*)$/$1$2/gm; return $_ }
+);
+if ($err) {
+    die "Error calling perltidy\n";
+}

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 2b0df0ebb207c656ed6471bcbd07b3082c59de84..edcec6d2f1d33eb20d3a867c4b842c9519c0dd8c 100644 (file)
--- a/lib/Perl/Tidy.pm
+++ b/lib/Perl/Tidy.pm
@@ -3,7 +3,7 @@
 #
 #    perltidy - a perl script indenter and formatter
 #
 #
 #    perltidy - a perl script indenter and formatter
 #

-#    Copyright (c) 2000-2016 by Steve Hancock
+#    Copyright (c) 2000-2017 by Steve Hancock

 #    Distributed under the GPL license agreement; see file COPYING
 #
 #    This program is free software; you can redistribute it and/or modify
 #    Distributed under the GPL license agreement; see file COPYING
 #
 #    This program is free software; you can redistribute it and/or modify


@@ -83,7 +83,7 @@ use File::Copy;
 use File::Temp qw(tempfile);
 
 BEGIN {
 use File::Temp qw(tempfile);
 
 BEGIN {

-    ( $VERSION = q($Id: Tidy.pm,v 1.74 2016/03/02 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 2017/05/21 13:56:49 perltidy Exp $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker

 }
 
 sub streamhandle {
 }
 
 sub streamhandle {


@@ -1235,7 +1235,14 @@ EOM
             my $fout = IO::File->new("> $input_file")
               or Die
 "problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n";
             my $fout = IO::File->new("> $input_file")
               or Die
 "problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n";

-            binmode $fout;
+            if ($binmode) {
+                if (   $rOpts->{'character-encoding'}
+                    && $rOpts->{'character-encoding'} eq 'utf8' )
+                {
+                    binmode $fout, ":encoding(UTF-8)";
+                }
+                else { binmode $fout }
+            }

             my $line;
             while ( $line = $output_file->getline() ) {
                 $fout->print($line);
             my $line;
             while ( $line = $output_file->getline() ) {
                 $fout->print($line);


@@ -1721,6 +1728,11 @@ sub generate_options {
     $add_option->( 'maximum-consecutive-blank-lines', 'mbl',  '=i' );
     $add_option->( 'keep-old-blank-lines',            'kbl',  '=i' );
 
     $add_option->( 'maximum-consecutive-blank-lines', 'mbl',  '=i' );
     $add_option->( 'keep-old-blank-lines',            'kbl',  '=i' );
 

+    $add_option->( 'blank-lines-after-opening-block',       'blao',  '=i' );
+    $add_option->( 'blank-lines-before-closing-block',      'blbc',  '=i' );
+    $add_option->( 'blank-lines-after-opening-block-list',  'blaol', '=s' );
+    $add_option->( 'blank-lines-before-closing-block-list', 'blbcl', '=s' );
+

     ########################################
     $category = 9;    # Other controls
     ########################################
     ########################################
     $category = 9;    # Other controls
     ########################################


@@ -2168,6 +2180,17 @@ sub _process_command_line {
 
     use Getopt::Long;
 
 
     use Getopt::Long;
 

+    # Save any current Getopt::Long configuration
+    # and set to Getopt::Long defaults.  Use eval to avoid
+    # breaking old versions of Perl without these routines.
+    # Previous configuration is reset at the exit of this routine.
+    my $glc;
+    eval { $glc = Getopt::Long::Configure() };
+    unless ($@) {
+        eval { Getopt::Long::ConfigDefaults() };
+    }
+    else { $glc = undef }
+

     my (
         $roption_string,   $rdefaults, $rexpansion,
         $roption_category, $roption_range
     my (
         $roption_string,   $rdefaults, $rexpansion,
         $roption_category, $roption_range


@@ -2185,23 +2208,9 @@ sub _process_command_line {
         unless ( $dump_options_type eq 'perltidyrc' ) {
             for $i (@$rdefaults) { push @ARGV, "--" . $i }
         }
         unless ( $dump_options_type eq 'perltidyrc' ) {
             for $i (@$rdefaults) { push @ARGV, "--" . $i }
         }

-
-        # Patch to save users Getopt::Long configuration
-        # and set to Getopt::Long defaults.  Use eval to avoid
-        # breaking old versions of Perl without these routines.
-        my $glc;
-        eval { $glc = Getopt::Long::Configure() };
-        unless ($@) {
-            eval { Getopt::Long::ConfigDefaults() };
-        }
-        else { $glc = undef }
-

         if ( !GetOptions( \%Opts, @$roption_string ) ) {
             Die "Programming Bug: error in setting default options";
         }
         if ( !GetOptions( \%Opts, @$roption_string ) ) {
             Die "Programming Bug: error in setting default options";
         }

-
-        # Patch to put the previous Getopt::Long configuration back
-        eval { Getopt::Long::Configure($glc) } if defined $glc;

     }
 
     my $word;
     }
 
     my $word;


@@ -2415,6 +2424,9 @@ EOM
         Die "Error on command line; for help try 'perltidy -h'\n";
     }
 
         Die "Error on command line; for help try 'perltidy -h'\n";
     }
 

+    # reset Getopt::Long configuration back to its previous value
+    eval { Getopt::Long::Configure($glc) } if defined $glc;
+

     return ( \%Opts, $config_file, \@raw_options, $roption_string,
         $rexpansion, $roption_category, $roption_range );
 }    # end of _process_command_line
     return ( \%Opts, $config_file, \@raw_options, $roption_string,
         $rexpansion, $roption_category, $roption_range );
 }    # end of _process_command_line


@@ -2501,27 +2513,25 @@ sub check_options {
         $rOpts->{'iterations'} = 1;
     }
 
         $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;
+    my $check_blank_count = sub {
+        my ( $key, $abbrev ) = @_;
+        if ( $rOpts->{$key} ) {
+            if ( $rOpts->{$key} < 0 ) {
+                $rOpts->{$key} = 0;
+                Warn "negative value of $abbrev, setting 0\n";
+            }
+            if ( $rOpts->{$key} > 100 ) {
+                Warn "unreasonably large value of $abbrev, reducing\n";
+                $rOpts->{$key} = 100;
+            }

         }
         }

-    }
+    };
+
+    # check for reasonable number of blank lines and fix to avoid problems
+    $check_blank_count->( 'blank-lines-before-subs',          '-blbs' );
+    $check_blank_count->( 'blank-lines-before-packages',      '-blbp' );
+    $check_blank_count->( 'blank-lines-after-block-opening',  '-blao' );
+    $check_blank_count->( 'blank-lines-before-block-closing', '-blbc' );

 
     # setting a non-negative logfile gap causes logfile to be saved
     if ( defined( $rOpts->{'logfile-gap'} ) && $rOpts->{'logfile-gap'} >= 0 ) {
 
     # setting a non-negative logfile gap causes logfile to be saved
     if ( defined( $rOpts->{'logfile-gap'} ) && $rOpts->{'logfile-gap'} >= 0 ) {


@@ -3349,7 +3359,7 @@ sub show_version {
     print STDOUT <<"EOM";
 This is perltidy, v$VERSION 
 
     print STDOUT <<"EOM";
 This is perltidy, v$VERSION 
 

-Copyright 2000-2016, Steve Hancock
+Copyright 2000-2017, 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.
 
 Perltidy is free software and may be copied under the terms of the GNU
 General Public License, which is included in the distribution files.


@@ -3692,7 +3702,10 @@ sub do_syntax_check {
     # now wish for luck...
     my $msg = qx/perl $flags $quoted_stream_filename $error_redirection/;
 
     # now wish for luck...
     my $msg = qx/perl $flags $quoted_stream_filename $error_redirection/;
 

-    unlink $stream_filename if ($is_tmpfile);
+    if ($is_tmpfile) {
+        unlink $stream_filename
+          or Perl::Tidy::Die("couldn't unlink stream $stream_filename: $!\n");
+    }

     return $stream_filename, $msg;
 }
 
     return $stream_filename, $msg;
 }
 


@@ -3955,15 +3968,17 @@ sub new {
         unless ($fh) { Perl::Tidy::Die "Cannot write to output stream\n"; }
         $output_file_open = 1;
         if ($binmode) {
         unless ($fh) { Perl::Tidy::Die "Cannot write to output stream\n"; }
         $output_file_open = 1;
         if ($binmode) {

-            if ( ref($fh) eq 'IO::File' ) {
-                if (   $rOpts->{'character-encoding'}
-                    && $rOpts->{'character-encoding'} eq 'utf8' )
-                {
-                    binmode $fh, ":encoding(UTF-8)";
+            if (   $rOpts->{'character-encoding'}
+                && $rOpts->{'character-encoding'} eq 'utf8' )
+            {
+                if ( ref($fh) eq 'IO::File' ) {
+                    $fh->binmode(":encoding(UTF-8)");
+                }
+                elsif ( $output_file eq '-' ) {
+                    binmode STDOUT, ":encoding(UTF-8)";

                 }
                 }

-                else { binmode $fh }

             }
             }

-            if ( $output_file eq '-' ) { binmode STDOUT }
+            elsif ( $output_file eq '-' ) { binmode STDOUT }

         }
     }
 
         }
     }
 


@@ -4128,7 +4143,11 @@ sub new {
 
     # remove any old error output file if we might write a new one
     unless ( $fh_warnings || ref($warning_file) ) {
 
     # remove any old error output file if we might write a new one
     unless ( $fh_warnings || ref($warning_file) ) {

-        if ( -e $warning_file ) { unlink($warning_file) }
+        if ( -e $warning_file ) {
+            unlink($warning_file)
+              or Perl::Tidy::Die(
+                "couldn't unlink warning file $warning_file: $!\n");
+        }

     }
 
     my $logfile_gap =
     }
 
     my $logfile_gap =


@@ -5437,7 +5456,13 @@ sub pod_to_html {
 
     # note that we have to unlink tmpfile before making frames
     # because the tmpfile may be one of the names used for frames
 
     # note that we have to unlink tmpfile before making frames
     # because the tmpfile may be one of the names used for frames

-    unlink $tmpfile if -e $tmpfile;
+    if ( -e $tmpfile ) {
+        unless ( unlink($tmpfile) ) {
+            Perl::Tidy::Warn("couldn't unlink temporary file $tmpfile: $!\n");
+            $success_flag = 0;
+        }
+    }
+

     if ( $success_flag && $rOpts->{'frames'} ) {
         $self->make_frame( \@toc );
     }
     if ( $success_flag && $rOpts->{'frames'} ) {
         $self->make_frame( \@toc );
     }


@@ -6138,6 +6163,9 @@ use vars qw{
   $closing_side_comment_prefix_pattern
   $closing_side_comment_list_pattern
 
   $closing_side_comment_prefix_pattern
   $closing_side_comment_list_pattern
 

+  $blank_lines_after_opening_block_pattern
+  $blank_lines_before_closing_block_pattern
+

   $last_nonblank_token
   $last_nonblank_type
   $last_last_nonblank_token
   $last_nonblank_token
   $last_nonblank_type
   $last_last_nonblank_token


@@ -6249,6 +6277,9 @@ use vars qw{
   %is_opening_type
   %is_closing_token
   %is_opening_token
   %is_opening_type
   %is_closing_token
   %is_opening_token

+
+  $SUB_PATTERN
+  $ASUB_PATTERN

 };
 
 BEGIN {
 };
 
 BEGIN {


@@ -6346,6 +6377,16 @@ BEGIN {
 
     @_ = qw" } ) ] ";
     @is_closing_token{@_} = (1) x scalar(@_);
 
     @_ = qw" } ) ] ";
     @is_closing_token{@_} = (1) x scalar(@_);

+
+    # Patterns for standardizing matches to block types for regular subs and
+    # anonymous subs. Examples
+    #  'sub process' is a named sub
+    #  'sub ::m' is a named sub
+    #  'sub' is an anonymous sub
+    #  'sub:' is a label, not a sub
+    #  'substr' is a keyword
+    $SUB_PATTERN  = '^sub\s+(::|\w)';
+    $ASUB_PATTERN = '^sub$';

 }
 
 # whitespace codes
 }
 
 # whitespace codes


@@ -7620,6 +7661,7 @@ sub check_options {
 
     make_bli_pattern();
     make_block_brace_vertical_tightness_pattern();
 
     make_bli_pattern();
     make_block_brace_vertical_tightness_pattern();

+    make_blank_line_pattern();

 
     if ( $rOpts->{'line-up-parentheses'} ) {
 
 
     if ( $rOpts->{'line-up-parentheses'} ) {
 


@@ -7718,7 +7760,7 @@ EOM
     # default keywords for which space is introduced before an opening paren
     # (at present, including them messes up vertical alignment)
     @_ = qw(my local our and or err eq ne if else elsif until
     # default keywords for which space is introduced before an opening paren
     # (at present, including them messes up vertical alignment)
     @_ = qw(my local our and or err eq ne if else elsif until

-      unless while for foreach return switch case given when);
+      unless while for foreach return switch case given when catch);

     @space_after_keyword{@_} = (1) x scalar(@_);
 
     # first remove any or all of these if desired
     @space_after_keyword{@_} = (1) x scalar(@_);
 
     # first remove any or all of these if desired


@@ -8094,6 +8136,23 @@ sub make_block_brace_vertical_tightness_pattern {
     }
 }
 
     }
 }
 

+sub make_blank_line_pattern {
+
+    $blank_lines_before_closing_block_pattern = $SUB_PATTERN;
+    my $key = 'blank-lines-before-closing-block-list';
+    if ( defined( $rOpts->{$key} ) && $rOpts->{$key} ) {
+        $blank_lines_before_closing_block_pattern =
+          make_block_pattern( '-blbcl', $rOpts->{$key} );
+    }
+
+    $blank_lines_after_opening_block_pattern = $SUB_PATTERN;
+    $key = 'blank-lines-after-opening-block-list';
+    if ( defined( $rOpts->{$key} ) && $rOpts->{$key} ) {
+        $blank_lines_after_opening_block_pattern =
+          make_block_pattern( '-blaol', $rOpts->{$key} );
+    }
+}
+

 sub make_block_pattern {
 
     #  given a string of block-type keywords, return a regex to match them
 sub make_block_pattern {
 
     #  given a string of block-type keywords, return a regex to match them


@@ -8106,6 +8165,11 @@ sub make_block_pattern {
     #   input string: "if else elsif unless while for foreach do : sub";
     #   pattern:  '^((if|else|elsif|unless|while|for|foreach|do|\w+:)$|sub)';
 
     #   input string: "if else elsif unless while for foreach do : sub";
     #   pattern:  '^((if|else|elsif|unless|while|for|foreach|do|\w+:)$|sub)';
 

+    #  Minor Update:
+    #
+    #  To distinguish between anonymous subs and named subs, use 'sub' to
+    #   indicate a named sub, and 'asub' to indicate an anonymous sub
+

     my ( $abbrev, $string ) = @_;
     my @list  = split_words($string);
     my @words = ();
     my ( $abbrev, $string ) = @_;
     my @list  = split_words($string);
     my @words = ();


@@ -8116,6 +8180,8 @@ sub make_block_pattern {
         $seen{$i} = 1;
         if ( $i eq 'sub' ) {
         }
         $seen{$i} = 1;
         if ( $i eq 'sub' ) {
         }

+        elsif ( $i eq 'asub' ) {
+        }

         elsif ( $i eq ';' ) {
             push @words, ';';
         }
         elsif ( $i eq ';' ) {
             push @words, ';';
         }


@@ -8134,8 +8200,15 @@ sub make_block_pattern {
         }
     }
     my $pattern = '(' . join( '|', @words ) . ')$';
         }
     }
     my $pattern = '(' . join( '|', @words ) . ')$';

+    my $sub_patterns = "";

     if ( $seen{'sub'} ) {
     if ( $seen{'sub'} ) {

-        $pattern = '(' . $pattern . '|sub)';
+        $sub_patterns .= '|' . $SUB_PATTERN;
+    }
+    if ( $seen{'asub'} ) {
+        $sub_patterns .= '|' . $ASUB_PATTERN;
+    }
+    if ($sub_patterns) {
+        $pattern = '(' . $pattern . $sub_patterns . ')';

     }
     $pattern = '^' . $pattern;
     return $pattern;
     }
     $pattern = '^' . $pattern;
     return $pattern;


@@ -8769,6 +8842,10 @@ sub set_white_space_flag {
 
                         # but watch out for this: [ [ ]    (misc.t)
                         && $last_token ne $token
 
                         # but watch out for this: [ [ ]    (misc.t)
                         && $last_token ne $token

+
+                        # double diamond is usually spaced
+                        && $token ne '<<>>'
+

                       )
                     {
 
                       )
                     {
 


@@ -9704,7 +9781,7 @@ sub set_white_space_flag {
                     $type                   = $type_save;
                 }
 
                     $type                   = $type_save;
                 }
 

-                if ( $token =~ /^sub/ ) { $token =~ s/\s+/ /g }
+                if ( $token =~ /$SUB_PATTERN/ ) { $token =~ s/\s+/ /g }

 
                 # trim identifiers of trailing blanks which can occur
                 # under some unusual circumstances, such as if the
 
                 # trim identifiers of trailing blanks which can occur
                 # under some unusual circumstances, such as if the


@@ -9843,11 +9920,12 @@ sub set_white_space_flag {
                 my $want_break =
 
                   # use -bl flag if not a sub block of any type
                 my $want_break =
 
                   # use -bl flag if not a sub block of any type

-                  $block_type !~ /^sub/
+                  #$block_type !~ /^sub/
+                  $block_type !~ /^sub\b/

                   ? $rOpts->{'opening-brace-on-new-line'}
 
                   # use -sbl flag for a named sub block
                   ? $rOpts->{'opening-brace-on-new-line'}
 
                   # use -sbl flag for a named sub block

-                  : $block_type !~ /^sub\W*$/
+                  : $block_type !~ /$ASUB_PATTERN/

                   ? $rOpts->{'opening-sub-brace-on-new-line'}
 
                   # use -asbl flag for an anonymous sub block
                   ? $rOpts->{'opening-sub-brace-on-new-line'}
 
                   # use -asbl flag for an anonymous sub block


@@ -10043,7 +10121,7 @@ sub set_white_space_flag {
                 }
 
                 # anonymous sub
                 }
 
                 # anonymous sub

-                elsif ( $block_type =~ /^sub\W*$/ ) {
+                elsif ( $block_type =~ /$ASUB_PATTERN/ ) {

 
                     if ($is_one_line_block) {
                         $rbrace_follower = \%is_anon_sub_1_brace_follower;
 
                     if ($is_one_line_block) {
                         $rbrace_follower = \%is_anon_sub_1_brace_follower;


@@ -10130,7 +10208,7 @@ sub set_white_space_flag {
                         && (
                             $is_block_without_semicolon{
                                 $last_nonblank_block_type}
                         && (
                             $is_block_without_semicolon{
                                 $last_nonblank_block_type}

-                            || $last_nonblank_block_type =~ /^sub\s+\w/
+                            || $last_nonblank_block_type =~ /$SUB_PATTERN/

                             || $last_nonblank_block_type =~ /^\w+:$/ )
                     )
                     || $last_nonblank_type eq ';'
                             || $last_nonblank_block_type =~ /^\w+:$/ )
                     )
                     || $last_nonblank_type eq ';'


@@ -10387,6 +10465,20 @@ sub output_line_to_go {
                   );
             }
 
                   );
             }
 

+            # Check for blank lines wanted before a closing brace
+            if ( $leading_token eq '}' ) {
+                if (   $rOpts->{'blank-lines-before-closing-block'}
+                    && $block_type_to_go[$imin]
+                    && $block_type_to_go[$imin] =~
+                    /$blank_lines_before_closing_block_pattern/ )
+                {
+                    my $nblanks = $rOpts->{'blank-lines-before-closing-block'};
+                    if ( $nblanks > $want_blank ) {
+                        $want_blank = $nblanks;
+                    }
+                }
+            }
+

             if ($want_blank) {
 
                 # future: send blank line down normal path to VerticalAligner
             if ($want_blank) {
 
                 # future: send blank line down normal path to VerticalAligner


@@ -10502,7 +10594,30 @@ sub output_line_to_go {
             $do_not_pad = correct_lp_indentation( $ri_first, $ri_last );
         }
         send_lines_to_vertical_aligner( $ri_first, $ri_last, $do_not_pad );
             $do_not_pad = correct_lp_indentation( $ri_first, $ri_last );
         }
         send_lines_to_vertical_aligner( $ri_first, $ri_last, $do_not_pad );

+
+        # Insert any requested blank lines after an opening brace.  We have to
+        # skip back before any side comment to find the terminal token
+        my $iterm;
+        for ( $iterm = $imax ; $iterm >= $imin ; $iterm-- ) {
+            next if $types_to_go[$iterm] eq '#';
+            next if $types_to_go[$iterm] eq 'b';
+            last;
+        }
+
+        # write requested number of blank lines after an opening block brace
+        if ( $iterm >= $imin && $types_to_go[$iterm] eq '{' ) {
+            if (   $rOpts->{'blank-lines-after-opening-block'}
+                && $block_type_to_go[$iterm]
+                && $block_type_to_go[$iterm] =~
+                /$blank_lines_after_opening_block_pattern/ )
+            {
+                my $nblanks = $rOpts->{'blank-lines-after-opening-block'};
+                Perl::Tidy::VerticalAligner::flush();
+                $file_writer_object->require_blank_code_lines($nblanks);
+            }
+        }

     }
     }

+

     prepare_for_new_input_lines();
 
     # output any new -cscw block comment
     prepare_for_new_input_lines();
 
     # output any new -cscw block comment


@@ -10589,36 +10704,28 @@ sub starting_one_line_block {
 
     # the previous nonblank token should start these block types
     elsif (( $last_last_nonblank_token_to_go eq $block_type )
 
     # the previous nonblank token should start these block types
     elsif (( $last_last_nonblank_token_to_go eq $block_type )

-        || ( $block_type =~ /^sub/ )
+        || ( $block_type =~ /^sub\b/ )

         || $block_type =~ /\(\)/ )
     {
         $i_start = $last_last_nonblank_index_to_go;
 
         || $block_type =~ /\(\)/ )
     {
         $i_start = $last_last_nonblank_index_to_go;
 

-        # Patch for signatures and extended syntax ...
-        # if the previous token was a closing paren we should walk back up to
-        # find the keyword (sub). Otherwise, we might form a one line block,
-        # which stays intact, and cause the parenthesized expression to break
-        # open.  That looks bad.
+        # For signatures and extended syntax ...
+        # If this brace follows a parenthesized list, we should look back to
+        # find the keyword before the opening paren because otherwise we might
+        # form a one line block which stays intack, and cause the parenthesized
+        # expression to break open. That looks bad.  However, actually
+        # searching for the opening paren is slow and tedius.
+        # The actual keyword is often at the start of a line, but might not be.
+        # For example, we might have an anonymous sub with signature list
+        # following a =>.  It is safe to mark the start anywhere before the
+        # opening paren, so we just go back to the prevoious break (or start of
+        # the line) if that is before the opening paren.  The minor downside is
+        # that we may very occasionally break open a block unnecessarily.

         if ( $tokens_to_go[$i_start] eq ')' ) {
         if ( $tokens_to_go[$i_start] eq ')' ) {

-
-            # walk back to find the first token with this level
-            # it should be the opening paren...
-            my $lev_want = $levels_to_go[$i_start];
-            for ( $i_start-- ; $i_start >= 0 ; $i_start-- ) {
-                if ( $i_start <= 0 ) { return 0 }
-                my $lev = $levels_to_go[$i_start];
-                if ( $lev <= $lev_want ) {
-
-                    # if not an opening paren then probably a syntax error
-                    if ( $tokens_to_go[$i_start] ne '(' ) { return 0 }
-
-                    # now step back to the opening keyword (sub)
-                    $i_start--;
-                    if ( $i_start > 0 && $types_to_go[$i_start] eq 'b' ) {
-                        $i_start--;
-                    }
-                }
-            }
+            $i_start = $index_max_forced_break + 1;
+            if ( $types_to_go[$i_start] eq 'b' ) { $i_start++; }
+            my $lev = $levels_to_go[$i_start];
+            if ( $lev > $level ) { return 0 }

         }
     }
 
         }
     }
 


@@ -11773,7 +11880,7 @@ sub accumulate_block_text {
         # curly.  Note: 'else' does not, but must be included to allow trailing
         # if/elsif text to be appended.
         # patch for SWITCH/CASE: added 'case' and 'when'
         # curly.  Note: 'else' does not, but must be included to allow trailing
         # if/elsif text to be appended.
         # patch for SWITCH/CASE: added 'case' and 'when'

-        @_ = qw(if elsif else unless while until for foreach case when);
+        @_ = qw(if elsif else unless while until for foreach case when catch);

         @is_if_elsif_else_unless_while_until_for_foreach{@_} =
           (1) x scalar(@_);
     }
         @is_if_elsif_else_unless_while_until_for_foreach{@_} =
           (1) x scalar(@_);
     }


@@ -12660,7 +12767,8 @@ sub send_lines_to_vertical_aligner {
 
                     # remove sub names to allow one-line sub braces to align
                     # regardless of name
 
                     # remove sub names to allow one-line sub braces to align
                     # regardless of name

-                    if ( $block_type =~ /^sub / ) { $block_type = 'sub' }
+                    #if ( $block_type =~ /^sub / ) { $block_type = 'sub' }
+                    if ( $block_type =~ /$SUB_PATTERN/ ) { $block_type = 'sub' }

 
                     # allow all control-type blocks to align
                     if ( $block_type =~ /^[A-Z]+$/ ) { $block_type = 'BEGIN' }
 
                     # allow all control-type blocks to align
                     if ( $block_type =~ /^[A-Z]+$/ ) { $block_type = 'BEGIN' }


@@ -13084,7 +13192,7 @@ sub lookup_opening_indentation {
                 # but right now we do not have that information.  For now
                 # we see if we are in a list, and this works well.
                 # See test files 'sub*.t' for good test cases.
                 # but right now we do not have that information.  For now
                 # we see if we are in a list, and this works well.
                 # See test files 'sub*.t' for good test cases.

-                if (   $block_type_to_go[$ibeg] =~ /^sub\s*\(?/
+                if (   $block_type_to_go[$ibeg] =~ /$ASUB_PATTERN/

                     && $container_environment_to_go[$i_terminal] eq 'LIST'
                     && !$rOpts->{'indent-closing-brace'} )
                 {
                     && $container_environment_to_go[$i_terminal] eq 'LIST'
                     && !$rOpts->{'indent-closing-brace'} )
                 {


@@ -18781,7 +18889,7 @@ sub set_continuation_breaks {
                     # sub block breaks handled at higher level, unless
                     # it looks like the preceeding list is long and broken
                     && !(
                     # sub block breaks handled at higher level, unless
                     # it looks like the preceeding list is long and broken
                     && !(

-                        $next_nonblank_block_type =~ /^sub/
+                        $next_nonblank_block_type =~ /^sub\b/

                         && ( $nesting_depth_to_go[$i_begin] ==
                             $nesting_depth_to_go[$i_next_nonblank] )
                     )
                         && ( $nesting_depth_to_go[$i_begin] ==
                             $nesting_depth_to_go[$i_next_nonblank] )
                     )


@@ -22899,6 +23007,7 @@ use vars qw{
   %is_digraph
   %is_file_test_operator
   %is_trigraph
   %is_digraph
   %is_file_test_operator
   %is_trigraph

+  %is_tetragraph

   %is_valid_token_type
   %is_keyword
   %is_code_block_token
   %is_valid_token_type
   %is_keyword
   %is_code_block_token


@@ -24307,7 +24416,7 @@ sub prepare_for_a_new_file {
                 $container_type = $want_paren;
                 $want_paren     = "";
             }
                 $container_type = $want_paren;
                 $want_paren     = "";
             }

-            elsif ( $statement_type =~ /^sub/ ) {
+            elsif ( $statement_type =~ /^sub\b/ ) {

                 $container_type = $statement_type;
             }
             else {
                 $container_type = $statement_type;
             }
             else {


@@ -24426,6 +24535,12 @@ sub prepare_for_a_new_file {
 
             $container_type = $paren_type[$paren_depth];
 
 
             $container_type = $paren_type[$paren_depth];
 

+            # restore statement type as 'sub' at closing paren of a signature
+            # so that a subsequent ':' is identified as an attribute
+            if ( $container_type =~ /^sub\b/ ) {
+                $statement_type = $container_type;
+            }
+

             #    /^(for|foreach)$/
             if ( $is_for_foreach{ $paren_type[$paren_depth] } ) {
                 my $num_sc = $paren_semicolon_count[$paren_depth];
             #    /^(for|foreach)$/
             if ( $is_for_foreach{ $paren_type[$paren_depth] } ) {
                 my $num_sc = $paren_semicolon_count[$paren_depth];


@@ -24794,7 +24909,7 @@ sub prepare_for_a_new_file {
 
             # ATTRS: check for a ':' which introduces an attribute list
             # (this might eventually get its own token type)
 
             # ATTRS: check for a ':' which introduces an attribute list
             # (this might eventually get its own token type)

-            elsif ( $statement_type =~ /^sub/ ) {
+            elsif ( $statement_type =~ /^sub\b/ ) {

                 $type              = 'A';
                 $in_attribute_list = 1;
             }
                 $type              = 'A';
                 $in_attribute_list = 1;
             }


@@ -25272,6 +25387,11 @@ sub prepare_for_a_new_file {
             $input_line =~ s/^\s*//;    # trim left end
         }
 
             $input_line =~ s/^\s*//;    # trim left end
         }
 

+        # Set a flag to indicate if we might be at an __END__ or __DATA__ line
+        # This will be used below to avoid quoting a bare word followed by
+        # a fat comma.
+        my $is_END_or_DATA = $input_line =~ /^\s*__(END|DATA)__\s*$/;
+

         # update the copy of the line for use in error messages
         # This must be exactly what we give the pre_tokenizer
         $tokenizer_self->{_line_text} = $input_line;
         # update the copy of the line for use in error messages
         # This must be exactly what we give the pre_tokenizer
         $tokenizer_self->{_line_text} = $input_line;


@@ -25583,6 +25703,17 @@ EOM
                     $tok = $test_tok;
                     $i++;
                 }
                     $tok = $test_tok;
                     $i++;
                 }

+
+                # The only current tetragraph is the double diamond operator
+                # and its first three characters are not a trigraph, so
+                # we do can do a special test for it
+                elsif ( $test_tok eq '<<>' ) {
+                    $test_tok .= $$rtokens[ $i + 2 ];
+                    if ( $is_tetragraph{$test_tok} ) {
+                        $tok = $test_tok;
+                        $i += 2;
+                    }
+                }

             }
 
             $type      = $tok;
             }
 
             $type      = $tok;


@@ -25636,7 +25767,9 @@ EOM
                 }
 
                 # quote a word followed by => operator
                 }
 
                 # quote a word followed by => operator

-                if ( $next_nonblank_token eq '=' ) {
+                # unless the word __END__ or __DATA__ and the only word on
+                # the line.
+                if ( !$is_END_or_DATA && $next_nonblank_token eq '=' ) {

 
                     if ( $$rtokens[ $i_next + 1 ] eq '>' ) {
                         if ( $is_constant{$current_package}{$tok} ) {
 
                     if ( $$rtokens[ $i_next + 1 ] eq '>' ) {
                         if ( $is_constant{$current_package}{$tok} ) {


@@ -26974,6 +27107,17 @@ sub operator_expected {
         {
             $op_expected = OPERATOR;
         }
         {
             $op_expected = OPERATOR;
         }

+
+        # Patch for RT #116344: misparse a ternary operator after an anonymous
+        # hash, like this:
+        #   return ref {} ? 1 : 0;
+        # The right brace should really be marked type 'R' in this case, and
+        # it is safest to return an UNKNOWN here. Expecting a TERM will
+        # cause the '?' to always be interpreted as a pattern delimiter
+        # rather than introducing a ternary operator.
+        elsif ( $tok eq '?' ) {
+            $op_expected = UNKNOWN;
+        }

         else {
             $op_expected = TERM;
         }
         else {
             $op_expected = TERM;
         }


@@ -29974,6 +30118,9 @@ BEGIN {
     my @trigraphs = qw( ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.=);
     @is_trigraph{@trigraphs} = (1) x scalar(@trigraphs);
 
     my @trigraphs = qw( ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.=);
     @is_trigraph{@trigraphs} = (1) x scalar(@trigraphs);
 

+    my @tetragraphs = qw( <<>> );
+    @is_tetragraph{@tetragraphs} = (1) x scalar(@tetragraphs);
+

     # make a hash of all valid token types for self-checking the tokenizer
     # (adding NEW_TOKENS : select a new character and add to this list)
     my @valid_token_types = qw#
     # make a hash of all valid token types for self-checking the tokenizer
     # (adding NEW_TOKENS : select a new character and add to this list)
     my @valid_token_types = qw#


@@ -29982,6 +30129,7 @@ BEGIN {
       #;
     push( @valid_token_types, @digraphs );
     push( @valid_token_types, @trigraphs );
       #;
     push( @valid_token_types, @digraphs );
     push( @valid_token_types, @trigraphs );

+    push( @valid_token_types, @tetragraphs );

     push( @valid_token_types, ( '#', ',', 'CORE::' ) );
     @is_valid_token_type{@valid_token_types} = (1) x scalar(@valid_token_types);
 
     push( @valid_token_types, ( '#', ',', 'CORE::' ) );
     @is_valid_token_type{@valid_token_types} = (1) x scalar(@valid_token_types);
 


@@ -30007,7 +30155,7 @@ BEGIN {
     @_ =
       qw( BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else
       unless do while until eval for foreach map grep sort
     @_ =
       qw( BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else
       unless do while until eval for foreach map grep sort

-      switch case given when catch);
+      switch case given when catch try finally);

     @is_code_block_token{@_} = (1) x scalar(@_);
 
     # I'll build the list of keywords incrementally
     @is_code_block_token{@_} = (1) x scalar(@_);
 
     # I'll build the list of keywords incrementally


@@ -30236,6 +30384,8 @@ BEGIN {
       when
       err
       say
       when
       err
       say

+
+      catch

     );
 
     # patched above for SWITCH/CASE given/when err say
     );
 
     # patched above for SWITCH/CASE given/when err say


@@ -30454,4 +30604,3 @@ BEGIN {
     @is_keyword{@Keywords} = (1) x scalar(@Keywords);
 }
 1;
     @is_keyword{@Keywords} = (1) x scalar(@Keywords);
 }
 1;

-__END__

diff --git a/lib/Perl/Tidy.pod b/lib/Perl/Tidy.pod
index 1213156c386425dc96e1dca7ae2504385154ec2d..d6815ce0802ac1aa26924180f3f2c4946b16fe75 100644 (file)
--- a/lib/Perl/Tidy.pod
+++ b/lib/Perl/Tidy.pod
@@ -408,14 +408,9 @@ C<write_debug_entry> in Tidy.pm.
 
   &perltidy
 
 
   &perltidy
 

-=head1 CREDITS
-
-Thanks to Hugh Myers who developed the initial modular interface 
-to perltidy.
-

 =head1 VERSION
 
 =head1 VERSION
 

-This man page documents Perl::Tidy version 20160302.
+This man page documents Perl::Tidy version 20170521.

 
 =head1 LICENSE
 
 
 =head1 LICENSE
 


@@ -424,10 +419,13 @@ under the terms of the "GNU General Public License".
 
 Please refer to the file "COPYING" for details.
 
 
 Please refer to the file "COPYING" for details.
 

-=head1 AUTHOR
+=head1 BUG REPORTS
+
+A list of current bugs and issues can be found at the CPAN site
+
+     https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Tidy

 
 

- Steve Hancock
- perltidy at users.sourceforge.net
+To report a new bug or problem, use the link on this page .  

 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO