#
###########################################################-
#
#    perltidy - a perl script indenter and formatter
#
#    Copyright (c) 2000-2020 by Steve Hancock
#    Distributed under the GPL license agreement; see file COPYING
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License along
#    with this program; if not, write to the Free Software Foundation, Inc.,
#    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
#    For brief instructions, try 'perltidy -h'.
#    For more complete documentation, try 'man perltidy'
#    or visit http://perltidy.sourceforge.net
#
#    This script is an example of the default style.  It was formatted with:
#
#      perltidy Tidy.pm
#
#    Code Contributions: See ChangeLog.html for a complete history.
#      Michael Cartmell supplied code for adaptation to VMS and helped with
#        v-strings.
#      Hugh S. Myers supplied sub streamhandle and the supporting code to
#        create a Perl::Tidy module which can operate on strings, arrays, etc.
#      Yves Orton supplied coding to help detect Windows versions.
#      Axel Rose supplied a patch for MacPerl.
#      Sebastien Aperghis-Tramoni supplied a patch for the defined or operator.
#      Dan Tyrell contributed a patch for binary I/O.
#      Ueli Hugenschmidt contributed a patch for -fpsc
#      Sam Kington supplied a patch to identify the initial indentation of
#      entabbed code.
#      jonathan swartz supplied patches for:
#      * .../ pattern, which looks upwards from directory
#      * --notidy, to be used in directories where we want to avoid
#        accidentally tidying
#      * prefilter and postfilter
#      * iterations option
#
#      Many others have supplied key ideas, suggestions, and bug reports;
#        see the CHANGES file.
#
############################################################

package Perl::Tidy;

# perlver reports minimum version needed is 5.8.0
# 5.004 needed for IO::File
# 5.008 needed for wide characters
use 5.008;
use warnings;
use strict;
use Exporter;
use Carp;
use Digest::MD5 qw(md5_hex);
use Perl::Tidy::Debugger;
use Perl::Tidy::DevNull;
use Perl::Tidy::Diagnostics;
use Perl::Tidy::FileWriter;
use Perl::Tidy::Formatter;
use Perl::Tidy::HtmlWriter;
use Perl::Tidy::IOScalar;
use Perl::Tidy::IOScalarArray;
use Perl::Tidy::IndentationItem;
use Perl::Tidy::LineSink;
use Perl::Tidy::LineSource;
use Perl::Tidy::Logger;
use Perl::Tidy::Tokenizer;
use Perl::Tidy::VerticalAligner;
local $| = 1;

use vars qw{
  $VERSION
  @ISA
  @EXPORT
  $missing_file_spec
  $fh_stderr
  $Warn_count
};

@ISA    = qw( Exporter );
@EXPORT = qw( &perltidy );

use Cwd;
use Encode ();
use Encode::Guess;
use IO::File;
use File::Basename;
use File::Copy;
use File::Temp qw(tempfile);

BEGIN {

    # Release version is the approximate YYMMDD of the release.
    # Development version is (Last Release).(Development Number)

    # To make the number continually increasing, the Development Number is a 2
    # digit number starting at 01 after a release is continually bumped along
    # at significant points during development. If it ever reaches 99 then the
    # Release version must be bumped, and it is probably past time for a
    # release anyway.

    $VERSION = '20200619';
}

sub streamhandle {

    # given filename and mode (r or w), create an object which:
    #   has a 'getline' method if mode='r', and
    #   has a 'print' method if mode='w'.
    # The objects also need a 'close' method.
    #
    # How the object is made:
    #
    # if $filename is:     Make object using:
    # ----------------     -----------------
    # '-'                  (STDIN if mode = 'r', STDOUT if mode='w')
    # string               IO::File
    # ARRAY  ref           Perl::Tidy::IOScalarArray (formerly IO::ScalarArray)
    # STRING ref           Perl::Tidy::IOScalar      (formerly IO::Scalar)
    # object               object
    #                      (check for 'print' method for 'w' mode)
    #                      (check for 'getline' method for 'r' mode)

    # An optional flag $is_encoded_data may be given, as follows:

    # Case 1. Any non-empty string: encoded data is being transferred, set
    # encoding to be utf8 for files and for stdin.

    # Case 2. Not given, or an empty string: unencoded binary data is being
    # transferred, set binary mode for files and for stdin.

    my ( $filename, $mode, $is_encoded_data ) = @_;

    my $ref = ref($filename);
    my $New;
    my $fh;

    # handle a reference
    if ($ref) {
        if ( $ref eq 'ARRAY' ) {
            $New = sub { Perl::Tidy::IOScalarArray->new( $filename, $mode ) };
        }
        elsif ( $ref eq 'SCALAR' ) {
            $New = sub { Perl::Tidy::IOScalar->new( $filename, $mode ) };
        }
        else {

            # Accept an object with a getline method for reading. Note:
            # IO::File is built-in and does not respond to the defined
            # operator.  If this causes trouble, the check can be
            # skipped and we can just let it crash if there is no
            # getline.
            if ( $mode =~ /[rR]/ ) {

                # RT#97159; part 1 of 2: updated to use 'can'
                ##if ( $ref eq 'IO::File' || defined &{ $ref . "::getline" } ) {
                if ( $ref->can('getline') ) {
                    $New = sub { $filename };
                }
                else {
                    $New = sub { undef };
                    confess <<EOM;
------------------------------------------------------------------------
No 'getline' method is defined for object of class $ref
Please check your call to Perl::Tidy::perltidy.  Trace follows.
------------------------------------------------------------------------
EOM
                }
            }

            # Accept an object with a print method for writing.
            # See note above about IO::File
            if ( $mode =~ /[wW]/ ) {

                # RT#97159; part 2 of 2: updated to use 'can'
                ##if ( $ref eq 'IO::File' || defined &{ $ref . "::print" } ) {
                if ( $ref->can('print') ) {
                    $New = sub { $filename };
                }
                else {
                    $New = sub { undef };
                    confess <<EOM;
------------------------------------------------------------------------
No 'print' method is defined for object of class $ref
Please check your call to Perl::Tidy::perltidy. Trace follows.
------------------------------------------------------------------------
EOM
                }
            }
        }
    }

    # handle a string
    else {
        if ( $filename eq '-' ) {
            $New = sub { $mode eq 'w' ? *STDOUT : *STDIN }
        }
        else {
            $New = sub { IO::File->new( $filename, $mode ) };
        }
    }
    $fh = $New->( $filename, $mode );
    if ( !$fh ) {

        Warn("Couldn't open file:$filename in mode:$mode : $!\n");

    }
    else {

        # Case 1: handle encoded data
        if ($is_encoded_data) {
            if ( ref($fh) eq 'IO::File' ) {
                $fh->binmode(":raw:encoding(UTF-8)");
            }
            elsif ( $fh eq '-' ) {
                binmode STDOUT, ":raw:encoding(UTF-8)";
            }
        }

        # Case 2: handle unencoded data
        else {
            if    ( ref($fh) eq 'IO::File' ) { $fh->binmode(); }
            elsif ( $fh eq '-' )             { binmode STDOUT }
        }
    }

    return $fh, ( $ref or $filename );
}

sub find_input_line_ending {

    # Peek at a file and return first line ending character.
    # Return undefined value in case of any trouble.
    my ($input_file) = @_;
    my $ending;

    # silently ignore input from object or stdin
    if ( ref($input_file) || $input_file eq '-' ) {
        return $ending;
    }

    my $fh;
    open( $fh, '<', $input_file ) || return $ending;

    binmode $fh;
    my $buf;
    read( $fh, $buf, 1024 );
    close $fh;
    if ( $buf && $buf =~ /([\012\015]+)/ ) {
        my $test = $1;

        # dos
        if ( $test =~ /^(\015\012)+$/ ) { $ending = "\015\012" }

        # mac
        elsif ( $test =~ /^\015+$/ ) { $ending = "\015" }

        # unix
        elsif ( $test =~ /^\012+$/ ) { $ending = "\012" }

        # unknown
        else { }
    }

    # no ending seen
    else { }

    return $ending;
}

sub catfile {

    # concatenate a path and file basename
    # returns undef in case of error

    my @parts = @_;

    BEGIN {
        eval { require File::Spec };
        $missing_file_spec = $@;
    }

    # use File::Spec if we can
    unless ($missing_file_spec) {
        return File::Spec->catfile(@parts);
    }

    # Perl 5.004 systems may not have File::Spec so we'll make
    # a simple try.  We assume File::Basename is available.
    # return if not successful.
    my $name      = pop @parts;
    my $path      = join '/', @parts;
    my $test_file = $path . $name;
    my ( $test_name, $test_path ) = fileparse($test_file);
    return $test_file if ( $test_name eq $name );
    return            if ( $^O eq 'VMS' );

    # this should work at least for Windows and Unix:
    $test_file = $path . '/' . $name;
    ( $test_name, $test_path ) = fileparse($test_file);
    return $test_file if ( $test_name eq $name );
    return;
}

# Here is a map of the flow of data from the input source to the output
# line sink:
#
# LineSource-->Tokenizer-->Formatter-->VerticalAligner-->FileWriter-->
#       input                         groups                 output
#       lines   tokens      lines       of          lines    lines
#                                      lines
#
# The names correspond to the package names responsible for the unit processes.
#
# The overall process is controlled by the "main" package.
#
# LineSource is the stream of input lines
#
# Tokenizer analyzes a line and breaks it into tokens, peeking ahead
# if necessary.  A token is any section of the input line which should be
# manipulated as a single entity during formatting.  For example, a single
# ',' character is a token, and so is an entire side comment.  It handles
# the complexities of Perl syntax, such as distinguishing between '<<' as
# a shift operator and as a here-document, or distinguishing between '/'
# as a divide symbol and as a pattern delimiter.
#
# Formatter inserts and deletes whitespace between tokens, and breaks
# sequences of tokens at appropriate points as output lines.  It bases its
# decisions on the default rules as modified by any command-line options.
#
# VerticalAligner collects groups of lines together and tries to line up
# certain tokens, such as '=>', '#', and '=' by adding whitespace.
#
# FileWriter simply writes lines to the output stream.
#
# The Logger package, not shown, records significant events and warning
# messages.  It writes a .LOG file, which may be saved with a
# '-log' or a '-g' flag.

sub perltidy {

    my %input_hash = @_;

    my %defaults = (
        argv                  => undef,
        destination           => undef,
        formatter             => undef,
        logfile               => undef,
        errorfile             => undef,
        teefile               => undef,
        debugfile             => undef,
        perltidyrc            => undef,
        source                => undef,
        stderr                => undef,
        dump_options          => undef,
        dump_options_type     => undef,
        dump_getopt_flags     => undef,
        dump_options_category => undef,
        dump_options_range    => undef,
        dump_abbreviations    => undef,
        prefilter             => undef,
        postfilter            => undef,
    );

    # don't overwrite callers ARGV
    local @ARGV   = @ARGV;
    local *STDERR = *STDERR;

    if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
        local $" = ')(';
        my @good_keys = sort keys %defaults;
        @bad_keys = sort @bad_keys;
        confess <<EOM;
------------------------------------------------------------------------
Unknown perltidy parameter : (@bad_keys)
perltidy only understands : (@good_keys)
------------------------------------------------------------------------

EOM
    }

    my $get_hash_ref = sub {
        my ($key) = @_;
        my $hash_ref = $input_hash{$key};
        if ( defined($hash_ref) ) {
            unless ( ref($hash_ref) eq 'HASH' ) {
                my $what = ref($hash_ref);
                my $but_is =
                  $what ? "but is ref to $what" : "but is not a reference";
                croak <<EOM;
------------------------------------------------------------------------
error in call to perltidy:
-$key must be reference to HASH $but_is
------------------------------------------------------------------------
EOM
            }
        }
        return $hash_ref;
    };

    %input_hash = ( %defaults, %input_hash );
    my $argv               = $input_hash{'argv'};
    my $destination_stream = $input_hash{'destination'};
    my $errorfile_stream   = $input_hash{'errorfile'};
    my $logfile_stream     = $input_hash{'logfile'};
    my $teefile_stream     = $input_hash{'teefile'};
    my $debugfile_stream   = $input_hash{'debugfile'};
    my $perltidyrc_stream  = $input_hash{'perltidyrc'};
    my $source_stream      = $input_hash{'source'};
    my $stderr_stream      = $input_hash{'stderr'};
    my $user_formatter     = $input_hash{'formatter'};
    my $prefilter          = $input_hash{'prefilter'};
    my $postfilter         = $input_hash{'postfilter'};

    if ($stderr_stream) {
        ( $fh_stderr, my $stderr_file ) =
          Perl::Tidy::streamhandle( $stderr_stream, 'w' );
        if ( !$fh_stderr ) {
            croak <<EOM;
------------------------------------------------------------------------
Unable to redirect STDERR to $stderr_stream
Please check value of -stderr in call to perltidy
------------------------------------------------------------------------
EOM
        }
    }
    else {
        $fh_stderr = *STDERR;
    }

    sub Warn { my $msg = shift; $fh_stderr->print($msg); $Warn_count++; return }

    sub Exit {
        my $flag = shift;
        if   ($flag) { goto ERROR_EXIT }
        else         { goto NORMAL_EXIT }
        croak "unexpectd return to Exit";
    }

    sub Die {
        my $msg = shift;
        Warn($msg);
        Exit(1);
        croak "unexpected return to Die";
    }

    my $md5_hex = sub {
        my ($buf) = @_;

        # Evaluate the MD5 sum for a string
        # Patch for [rt.cpan.org #88020]
        # Use utf8::encode since md5_hex() only operates on bytes.
        # my $digest = md5_hex( utf8::encode($sink_buffer) );

        # Note added 20180114: the above patch did not work correctly.  I'm not
        # sure why.  But switching to the method recommended in the Perl 5
        # documentation for Encode worked.  According to this we can either use
        #    $octets = encode_utf8($string)  or equivalently
        #    $octets = encode("utf8",$string)
        # and then calculate the checksum.  So:
        my $octets = Encode::encode( "utf8", $buf );
        my $digest = md5_hex($octets);
        return $digest;
    };

    # extract various dump parameters
    my $dump_options_type     = $input_hash{'dump_options_type'};
    my $dump_options          = $get_hash_ref->('dump_options');
    my $dump_getopt_flags     = $get_hash_ref->('dump_getopt_flags');
    my $dump_options_category = $get_hash_ref->('dump_options_category');
    my $dump_abbreviations    = $get_hash_ref->('dump_abbreviations');
    my $dump_options_range    = $get_hash_ref->('dump_options_range');

    # validate dump_options_type
    if ( defined($dump_options) ) {
        unless ( defined($dump_options_type) ) {
            $dump_options_type = 'perltidyrc';
        }
        unless ( $dump_options_type =~ /^(perltidyrc|full)$/ ) {
            croak <<EOM;
------------------------------------------------------------------------
Please check value of -dump_options_type in call to perltidy;
saw: '$dump_options_type' 
expecting: 'perltidyrc' or 'full'
------------------------------------------------------------------------
EOM

        }
    }
    else {
        $dump_options_type = "";
    }

    if ($user_formatter) {

        # if the user defines a formatter, there is no output stream,
        # but we need a null stream to keep coding simple
        $destination_stream = Perl::Tidy::DevNull->new();
    }

    # see if ARGV is overridden
    if ( defined($argv) ) {

        my $rargv = ref $argv;
        if ( $rargv eq 'SCALAR' ) { $argv = ${$argv}; $rargv = undef }

        # ref to ARRAY
        if ($rargv) {
            if ( $rargv eq 'ARRAY' ) {
                @ARGV = @{$argv};
            }
            else {
                croak <<EOM;
------------------------------------------------------------------------
Please check value of -argv in call to perltidy;
it must be a string or ref to ARRAY but is: $rargv
------------------------------------------------------------------------
EOM
            }
        }

        # string
        else {
            my ( $rargv, $msg ) = parse_args($argv);
            if ($msg) {
                Die(<<EOM);
Error parsing this string passed to to perltidy with 'argv': 
$msg
EOM
            }
            @ARGV = @{$rargv};
        }
    }

    my $rpending_complaint;
    ${$rpending_complaint} = "";
    my $rpending_logfile_message;
    ${$rpending_logfile_message} = "";

    my ( $is_Windows, $Windows_type ) = look_for_Windows($rpending_complaint);

    # VMS file names are restricted to a 40.40 format, so we append _tdy
    # instead of .tdy, etc. (but see also sub check_vms_filename)
    my $dot;
    my $dot_pattern;
    if ( $^O eq 'VMS' ) {
        $dot         = '_';
        $dot_pattern = '_';
    }
    else {
        $dot         = '.';
        $dot_pattern = '\.';    # must escape for use in regex
    }

    #---------------------------------------------------------------
    # get command line options
    #---------------------------------------------------------------
    my ( $rOpts, $config_file, $rraw_options, $roption_string,
        $rexpansion, $roption_category, $roption_range )
      = process_command_line(
        $perltidyrc_stream,  $is_Windows, $Windows_type,
        $rpending_complaint, $dump_options_type,
      );

    my $saw_extrude = ( grep { m/^-extrude$/ } @{$rraw_options} ) ? 1 : 0;
    my $saw_pbp =
      ( grep { m/^-(pbp|perl-best-practices)$/ } @{$rraw_options} ) ? 1 : 0;

    #---------------------------------------------------------------
    # Handle requests to dump information
    #---------------------------------------------------------------

    # return or exit immediately after all dumps
    my $quit_now = 0;

    # Getopt parameters and their flags
    if ( defined($dump_getopt_flags) ) {
        $quit_now = 1;
        foreach my $op ( @{$roption_string} ) {
            my $opt  = $op;
            my $flag = "";

            # Examples:
            #  some-option=s
            #  some-option=i
            #  some-option:i
            #  some-option!
            if ( $opt =~ /(.*)(!|=.*|:.*)$/ ) {
                $opt  = $1;
                $flag = $2;
            }
            $dump_getopt_flags->{$opt} = $flag;
        }
    }

    if ( defined($dump_options_category) ) {
        $quit_now = 1;
        %{$dump_options_category} = %{$roption_category};
    }

    if ( defined($dump_options_range) ) {
        $quit_now = 1;
        %{$dump_options_range} = %{$roption_range};
    }

    if ( defined($dump_abbreviations) ) {
        $quit_now = 1;
        %{$dump_abbreviations} = %{$rexpansion};
    }

    if ( defined($dump_options) ) {
        $quit_now = 1;
        %{$dump_options} = %{$rOpts};
    }

    Exit(0) if ($quit_now);

    # make printable string of options for this run as possible diagnostic
    my $readable_options = readable_options( $rOpts, $roption_string );

    # dump from command line
    if ( $rOpts->{'dump-options'} ) {
        print STDOUT $readable_options;
        Exit(0);
    }

    #---------------------------------------------------------------
    # check parameters and their interactions
    #---------------------------------------------------------------
    my $tabsize =
      check_options( $rOpts, $is_Windows, $Windows_type, $rpending_complaint );

    if ($user_formatter) {
        $rOpts->{'format'} = 'user';
    }

    # there must be one entry here for every possible format
    my %default_file_extension = (
        tidy => 'tdy',
        html => 'html',
        user => '',
    );

    # be sure we have a valid output format
    unless ( exists $default_file_extension{ $rOpts->{'format'} } ) {
        my $formats = join ' ',
          sort map { "'" . $_ . "'" } keys %default_file_extension;
        my $fmt = $rOpts->{'format'};
        Die("-format='$fmt' but must be one of: $formats\n");
    }

    my $output_extension = 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 );

    my $html_toc_extension =
      make_extension( $rOpts->{'html-toc-extension'}, 'toc', $dot );

    my $html_src_extension =
      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';

    # Turn off -b with warnings in case of conflicts with other options.
    # NOTE: Do this silently, without warnings, if there is a source or
    # destination stream, or standard output is used.  This is because the -b
    # flag may have been in a .perltidyrc file and warnings break
    # Test::NoWarnings.  See email discussion with Merijn Brand 26 Feb 2014.
    if ($in_place_modify) {
        if (   $rOpts->{'standard-output'}
            || $destination_stream
            || ref $source_stream
            || $rOpts->{'outfile'}
            || defined( $rOpts->{'output-path'} ) )
        {
            $in_place_modify = 0;
        }
    }

    Perl::Tidy::Formatter::check_options($rOpts);
    Perl::Tidy::Tokenizer::check_options($rOpts);
    if ( $rOpts->{'format'} eq 'html' ) {
        Perl::Tidy::HtmlWriter->check_options($rOpts);
    }

    # make the pattern of file extensions that we shouldn't touch
    my $forbidden_file_extensions = "(($dot_pattern)(LOG|DEBUG|ERR|TEE)";
    if ($output_extension) {
        my $ext = quotemeta($output_extension);
        $forbidden_file_extensions .= "|$ext";
    }
    if ( $in_place_modify && $backup_extension ) {
        my $ext = quotemeta($backup_extension);
        $forbidden_file_extensions .= "|$ext";
    }
    $forbidden_file_extensions .= ')$';

    # Create a diagnostics object if requested;
    # This is only useful for code development
    my $diagnostics_object = undef;
    if ( $rOpts->{'DIAGNOSTICS'} ) {
        $diagnostics_object = Perl::Tidy::Diagnostics->new();
    }

    # no filenames should be given if input is from an array
    if ($source_stream) {
        if ( @ARGV > 0 ) {
            Die(
"You may not specify any filenames when a source array is given\n"
            );
        }

        # we'll stuff the source array into ARGV
        unshift( @ARGV, $source_stream );

        # No special treatment for source stream which is a filename.
        # This will enable checks for binary files and other bad stuff.
        $source_stream = undef unless ref($source_stream);
    }

    # use stdin by default if no source array and no args
    else {
        unshift( @ARGV, '-' ) unless @ARGV;
    }

    # Flag for loading module Unicode::GCString for evaluating text width:
    #   undef = ok to use but not yet loaded
    #       0 = do not use; failed to load or not wanted
    #       1 = successfully loaded and ok to use
    # The module is not actually loaded unless/until it is needed
    my $loaded_unicode_gcstring;
    if ( !$rOpts->{'use-unicode-gcstring'} ) {
        $loaded_unicode_gcstring = 0;
    }

    #---------------------------------------------------------------
    # Ready to go...
    # main loop to process all files in argument list
    #---------------------------------------------------------------
    my $number_of_files = @ARGV;
    my $formatter       = undef;
    my $tokenizer       = undef;

    # If requested, process in order of increasing file size
    # This can significantly reduce perl's virtual memory usage during testing.
    if ( $number_of_files > 1 && $rOpts->{'file-size-order'} ) {
        @ARGV =
          map  { $_->[0] }
          sort { $a->[1] <=> $b->[1] }
          map  { [ $_, -e $_ ? -s $_ : 0 ] } @ARGV;
    }

    while ( my $input_file = shift @ARGV ) {
        my $fileroot;
        my @input_file_stat;
        my $display_name;

        #---------------------------------------------------------------
        # prepare this input stream
        #---------------------------------------------------------------
        if ($source_stream) {
            $fileroot     = "perltidy";
            $display_name = "<source_stream>";

            # If the source is from an array or string, then .LOG output
            # is only possible if a logfile stream is specified.  This prevents
            # unexpected perltidy.LOG files.
            if ( !defined($logfile_stream) ) {
                $logfile_stream = Perl::Tidy::DevNull->new();

                # Likewise for .TEE and .DEBUG output
            }
            if ( !defined($teefile_stream) ) {
                $teefile_stream = Perl::Tidy::DevNull->new();
            }
            if ( !defined($debugfile_stream) ) {
                $debugfile_stream = Perl::Tidy::DevNull->new();
            }
        }
        elsif ( $input_file eq '-' ) {    # '-' indicates input from STDIN
            $fileroot     = "perltidy";   # root name to use for .ERR, .LOG, etc
            $display_name = "<stdin>";
            $in_place_modify = 0;
        }
        else {
            $fileroot     = $input_file;
            $display_name = $input_file;
            unless ( -e $input_file ) {

                # file doesn't exist - check for a file glob
                if ( $input_file =~ /([\?\*\[\{])/ ) {

                    # Windows shell may not remove quotes, so do it
                    my $input_file = $input_file;
                    if ( $input_file =~ /^\'(.+)\'$/ ) { $input_file = $1 }
                    if ( $input_file =~ /^\"(.+)\"$/ ) { $input_file = $1 }
                    my $pattern = fileglob_to_re($input_file);
                    ##eval "/$pattern/";
                    if ( !$@ && opendir( DIR, './' ) ) {
                        my @files =
                          grep { /$pattern/ && !-d $_ } readdir(DIR);
                        closedir(DIR);
                        if (@files) {
                            unshift @ARGV, @files;
                            next;
                        }
                    }
                }
                Warn("skipping file: '$input_file': no matches found\n");
                next;
            }

            unless ( -f $input_file ) {
                Warn("skipping file: $input_file: not a regular file\n");
                next;
            }

            # As a safety precaution, skip zero length files.
            # If for example a source file got clobbered somehow,
            # the old .tdy or .bak files might still exist so we
            # shouldn't overwrite them with zero length files.
            unless ( -s $input_file ) {
                Warn("skipping file: $input_file: Zero size\n");
                next;
            }

            unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) {
                Warn(
                    "skipping file: $input_file: Non-text (override with -f)\n"
                );
                next;
            }

            # we should have a valid filename now
            $fileroot        = $input_file;
            @input_file_stat = stat($input_file);

            if ( $^O eq 'VMS' ) {
                ( $fileroot, $dot ) = check_vms_filename($fileroot);
            }

            # add option to change path here
            if ( defined( $rOpts->{'output-path'} ) ) {

                my ( $base, $old_path ) = fileparse($fileroot);
                my $new_path = $rOpts->{'output-path'};
                unless ( -d $new_path ) {
                    unless ( mkdir $new_path, 0777 ) {
                        Die("unable to create directory $new_path: $!\n");
                    }
                }
                my $path = $new_path;
                $fileroot = catfile( $path, $base );
                unless ($fileroot) {
                    Die(<<EOM);
------------------------------------------------------------------------
Problem combining $new_path and $base to make a filename; check -opath
------------------------------------------------------------------------
EOM
                }
            }
        }

        # Skip files with same extension as the output files because
        # this can lead to a messy situation with files like
        # script.tdy.tdy.tdy ... or worse problems ...  when you
        # rerun perltidy over and over with wildcard input.
        if (
            !$source_stream
            && (   $input_file =~ /$forbidden_file_extensions/
                || $input_file eq 'DIAGNOSTICS' )
          )
        {
            Warn("skipping file: $input_file: wrong extension\n");
            next;
        }

        # the 'source_object' supplies a method to read the input file
        my $source_object = Perl::Tidy::LineSource->new(
            input_file               => $input_file,
            rOpts                    => $rOpts,
            rpending_logfile_message => $rpending_logfile_message,
        );
        next unless ($source_object);

        my $max_iterations      = $rOpts->{'iterations'};
        my $do_convergence_test = $max_iterations > 1;
        my $convergence_log_message;
        my %saw_md5;
        my $digest_input = 0;

        my $buf = '';
        while ( my $line = $source_object->get_line() ) {
            $buf .= $line;
        }

        # Decode the input stream if necessary requested
        my $encoding_in              = "";
        my $rOpts_character_encoding = $rOpts->{'character-encoding'};
        my $encoding_log_message;

        # Case 1. See if we already have an encoded string. In that
        # case, we have to ignore any encoding flag.
        if ( utf8::is_utf8($buf) ) {
            $encoding_in = "utf8";
        }

        # Case 2. No input stream encoding requested.  This is appropriate
        # for single-byte encodings like ascii, latin-1, etc
        elsif ( !$rOpts_character_encoding
            || $rOpts_character_encoding eq 'none' )
        {

            # nothing to do
        }

        # Case 3. guess input stream encoding if requested
        elsif ( $rOpts_character_encoding =~ /^guess$/i ) {

            # The guessing strategy is simple: use Encode::Guess to guess
            # an encoding.  If and only if the guess is utf8, try decoding and
            # use it if successful.  Otherwise, we proceed assuming the
            # characters are encoded as single bytes (same as if 'none' had
            # been specified as the encoding).

            # In testing I have found that including additional guess 'suspect'
            # encodings sometimes works but can sometimes lead to disaster by
            # using an incorrect decoding.  The user can always specify a
            # specific input encoding.
            my $buf_in = $buf;

            my $decoder = guess_encoding( $buf_in, 'utf8' );
            if ( ref($decoder) ) {
                $encoding_in = $decoder->name;
                if ( $encoding_in !~ /^(UTF-8|utf8)$/ ) {
                    $encoding_in = "";
                    $buf         = $buf_in;
                    $encoding_log_message .= <<EOM;
Guessed encoding '$encoding_in' is not utf8; no encoding will be used
EOM
                }
                else {

                    eval { $buf = $decoder->decode($buf_in); };
                    if ($@) {

                        $encoding_log_message .= <<EOM;
Guessed encoding '$encoding_in' but decoding was unsuccessful; no encoding is used
EOM

                        # Note that a guess failed, but keep going
                        # This warning can eventually be removed
                        Warn(
"file: $input_file: bad guess to decode source as $encoding_in\n"
                        );
                        $encoding_in = "";
                        $buf         = $buf_in;
                    }
                    else {
                        $encoding_log_message .= <<EOM;
Guessed encoding '$encoding_in' successfully decoded
EOM
                    }
                }
            }
        }

        # Case 4. Decode with a specific encoding
        else {
            $encoding_in = $rOpts_character_encoding;
            eval {
                $buf = Encode::decode( $encoding_in, $buf,
                    Encode::FB_CROAK | Encode::LEAVE_SRC );
            };
            if ($@) {

                # Quit if we cannot decode by the requested encoding;
                # Something is not right.
                Warn(
"skipping file: $display_name: Unable to decode source as $encoding_in\n"
                );
                next;
            }
            else {
                $encoding_log_message .= <<EOM;
Specified encoding '$encoding_in' successfully decoded
EOM
            }
        }

        # Set the encoding to be used for all further i/o: If we have
        # decoded the data with any format, then we must continue to
        # read and write it as encoded data, and we will normalize these
        # operations with utf8.  If we have not decoded the data, then
        # we must not treat it as encoded data.
        my $is_encoded_data = $encoding_in ? 'utf8' : "";

       # Define the function to determine the display width of character strings
        my $length_function = sub { return length( $_[0] ) };
        if ($is_encoded_data) {

            # Delete any Byte Order Mark (BOM), which can cause trouble
            $buf =~ s/^\x{FEFF}//;

            # Try to load Unicode::GCString for defining text display width, if
            # requested, when the first encoded file is encountered
            if ( !defined($loaded_unicode_gcstring) ) {
                eval { require Unicode::GCString };
                $loaded_unicode_gcstring = !$@;
                if ( $@ && $rOpts->{'use-unicode-gcstring'} ) {
                    Warn(<<EOM);
----------------------
Unable to load Unicode::GCString: $@
Processing continues but some vertical alignment may be poor
To prevent this warning message, you can either:
- install module Unicode::GCString, or
- remove '--use-unicode-gcstring' or '-gcs' from your perltidyrc or command line
----------------------
EOM
                }
            }
            if ($loaded_unicode_gcstring) {
                $length_function = sub {
                    return Unicode::GCString->new( $_[0] )->columns;
                };
            }
        }

        # MD5 sum of input file is evaluated before any prefilter
        if ( $rOpts->{'assert-tidy'} || $rOpts->{'assert-untidy'} ) {
            $digest_input = $md5_hex->($buf);
        }

        # Prefilters and postfilters: The prefilter is a code reference
        # that will be applied to the source before tidying, and the
        # postfilter is a code reference to the result before outputting.

        $buf = $prefilter->($buf) if $prefilter;

        # starting MD5 sum for convergence test is evaluated after any prefilter
        if ($do_convergence_test) {
            my $digest = $md5_hex->($buf);
            $saw_md5{$digest} = 0;
        }

        $source_object = Perl::Tidy::LineSource->new(
            input_file               => \$buf,
            rOpts                    => $rOpts,
            rpending_logfile_message => $rpending_logfile_message,
        );

        # register this file name with the Diagnostics package
        $diagnostics_object->set_input_file($input_file)
          if $diagnostics_object;

        #---------------------------------------------------------------
        # prepare the output stream
        #---------------------------------------------------------------
        my $output_file = undef;
        my $actual_output_extension;

        if ( $rOpts->{'outfile'} ) {

            if ( $number_of_files <= 1 ) {

                if ( $rOpts->{'standard-output'} ) {
                    my $msg = "You may not use -o and -st together";
                    $msg .= " (-pbp contains -st; see manual)" if ($saw_pbp);
                    Die("$msg\n");
                }
                elsif ($destination_stream) {
                    Die(
"You may not specify a destination array and -o together\n"
                    );
                }
                elsif ( defined( $rOpts->{'output-path'} ) ) {
                    Die("You may not specify -o and -opath together\n");
                }
                elsif ( defined( $rOpts->{'output-file-extension'} ) ) {
                    Die("You may not specify -o and -oext together\n");
                }
                $output_file = $rOpts->{outfile};

                # make sure user gives a file name after -o
                if ( $output_file =~ /^-/ ) {
                    Die("You must specify a valid filename after -o\n");
                }

                # do not overwrite input file with -o
                if ( @input_file_stat && ( $output_file eq $input_file ) ) {
                    Die("Use 'perltidy -b $input_file' to modify in-place\n");
                }
            }
            else {
                Die("You may not use -o with more than one input file\n");
            }
        }
        elsif ( $rOpts->{'standard-output'} ) {
            if ($destination_stream) {
                my $msg =
                  "You may not specify a destination array and -st together\n";
                $msg .= " (-pbp contains -st; see manual)" if ($saw_pbp);
                Die("$msg\n");
            }
            $output_file = '-';

            if ( $number_of_files <= 1 ) {
            }
            else {
                Die("You may not use -st with more than one input file\n");
            }
        }
        elsif ($destination_stream) {
            $output_file = $destination_stream;
        }
        elsif ($source_stream) {    # source but no destination goes to stdout
            $output_file = '-';
        }
        elsif ( $input_file eq '-' ) {
            $output_file = '-';
        }
        else {
            if ($in_place_modify) {
                $output_file = IO::File->new_tmpfile()
                  or Die("cannot open temp file for -b option: $!\n");
            }
            else {
                $actual_output_extension = $output_extension;
                $output_file             = $fileroot . $output_extension;
            }
        }

        my $fh_tee;
        my $tee_file = $fileroot . $dot . "TEE";
        if ($teefile_stream) { $tee_file = $teefile_stream }
        if (   $rOpts->{'tee-pod'}
            || $rOpts->{'tee-block-comments'}
            || $rOpts->{'tee-side-comments'} )
        {
            ( $fh_tee, my $tee_filename ) =
              Perl::Tidy::streamhandle( $tee_file, 'w', $is_encoded_data );
            if ( !$fh_tee ) {
                Warn("couldn't open TEE file $tee_file: $!\n");
            }
        }

        my $line_separator = $rOpts->{'output-line-ending'};
        if ( $rOpts->{'preserve-line-endings'} ) {
            $line_separator = find_input_line_ending($input_file);
        }

        $line_separator = "\n" unless defined($line_separator);

        # the 'sink_object' knows how to write the output file
        my ( $sink_object, $postfilter_buffer );
        my $use_buffer =
             $postfilter
          || $rOpts->{'assert-tidy'}
          || $rOpts->{'assert-untidy'};

        $sink_object = Perl::Tidy::LineSink->new(
            output_file    => $use_buffer ? \$postfilter_buffer : $output_file,
            line_separator => $line_separator,
            rOpts          => $rOpts,
            rpending_logfile_message => $rpending_logfile_message,
            is_encoded_data          => $is_encoded_data,
        );

        #---------------------------------------------------------------
        # initialize the error logger for this file
        #---------------------------------------------------------------
        my $warning_file = $fileroot . $dot . "ERR";
        if ($errorfile_stream) { $warning_file = $errorfile_stream }
        my $log_file = $fileroot . $dot . "LOG";
        if ($logfile_stream) { $log_file = $logfile_stream }

        my $logger_object = Perl::Tidy::Logger->new(
            rOpts           => $rOpts,
            log_file        => $log_file,
            warning_file    => $warning_file,
            fh_stderr       => $fh_stderr,
            saw_extruce     => $saw_extrude,
            display_name    => $display_name,
            is_encoded_data => $is_encoded_data,
        );
        write_logfile_header(
            $rOpts,        $logger_object, $config_file,
            $rraw_options, $Windows_type,  $readable_options,
        );
        $logger_object->write_logfile_entry($encoding_log_message)
          if $encoding_log_message;

        if ( ${$rpending_logfile_message} ) {
            $logger_object->write_logfile_entry( ${$rpending_logfile_message} );
        }
        if ( ${$rpending_complaint} ) {
            $logger_object->complain( ${$rpending_complaint} );
        }

        #---------------------------------------------------------------
        # initialize the debug object, if any
        #---------------------------------------------------------------
        my $debugger_object = undef;
        if ( $rOpts->{DEBUG} ) {
            my $debug_file = $fileroot . $dot . "DEBUG";
            if ($debugfile_stream) { $debug_file = $debugfile_stream }
            $debugger_object =
              Perl::Tidy::Debugger->new( $debug_file, $is_encoded_data );
        }

        #---------------------------------------------------------------
        # loop over iterations for one source stream
        #---------------------------------------------------------------

        # 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;
        my $fh_tee_final          = $fh_tee;

        foreach my $iter ( 1 .. $max_iterations ) {

            # send output stream to temp buffers until last iteration
            my $sink_buffer;
            if ( $iter < $max_iterations ) {
                $sink_object = Perl::Tidy::LineSink->new(
                    output_file              => \$sink_buffer,
                    line_separator           => $line_separator,
                    rOpts                    => $rOpts,
                    rpending_logfile_message => $rpending_logfile_message,
                    is_encoded_data          => $is_encoded_data,
                );
            }
            else {
                $sink_object = $sink_object_final;
            }

            # Save logger, debugger and tee 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.
            # (3) the tee option only works on first pass if comments are also
            # being deleted.

            if ( $iter > 1 ) {
                $debugger_object = undef;
                $logger_object   = undef;
                $fh_tee          = undef;
            }

            #------------------------------------------------------------
            # 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.
            $formatter = undef;

            if ($user_formatter) {
                $formatter = $user_formatter;
            }
            elsif ( $rOpts->{'format'} eq 'html' ) {
                $formatter = Perl::Tidy::HtmlWriter->new(
                    input_file         => $fileroot,
                    html_file          => $output_file,
                    extension          => $actual_output_extension,
                    html_toc_extension => $html_toc_extension,
                    html_src_extension => $html_src_extension,
                );
            }
            elsif ( $rOpts->{'format'} eq 'tidy' ) {
                $formatter = Perl::Tidy::Formatter->new(
                    logger_object      => $logger_object,
                    diagnostics_object => $diagnostics_object,
                    sink_object        => $sink_object,
                    length_function    => $length_function,
                    fh_tee             => $fh_tee,
                );
            }
            else {
                Die("I don't know how to do -format=$rOpts->{'format'}\n");
            }

            unless ($formatter) {
                Die("Unable to continue with $rOpts->{'format'} formatting\n");
            }

            #---------------------------------------------------------------
            # create the tokenizer for this file
            #---------------------------------------------------------------
            $tokenizer = undef;                     # must destroy old tokenizer
            $tokenizer = Perl::Tidy::Tokenizer->new(
                source_object      => $source_object,
                logger_object      => $logger_object,
                debugger_object    => $debugger_object,
                diagnostics_object => $diagnostics_object,
                tabsize            => $tabsize,

                starting_level      => $rOpts->{'starting-indentation-level'},
                indent_columns      => $rOpts->{'indent-columns'},
                look_for_hash_bang  => $rOpts->{'look-for-hash-bang'},
                look_for_autoloader => $rOpts->{'look-for-autoloader'},
                look_for_selfloader => $rOpts->{'look-for-selfloader'},
                trim_qw             => $rOpts->{'trim-qw'},
                extended_syntax     => $rOpts->{'extended-syntax'},

                continuation_indentation =>
                  $rOpts->{'continuation-indentation'},
                outdent_labels => $rOpts->{'outdent-labels'},
            );

            #---------------------------------------------------------------
            # now we can do it
            #---------------------------------------------------------------
            process_this_file( $tokenizer, $formatter );

            #---------------------------------------------------------------
            # close the input source and report errors
            #---------------------------------------------------------------
            $source_object->close_input_file();

            # line source for next iteration (if any) comes from the current
            # temporary output buffer
            if ( $iter < $max_iterations ) {

                $sink_object->close_output_file();
                $source_object = Perl::Tidy::LineSource->new(
                    input_file               => \$sink_buffer,
                    rOpts                    => $rOpts,
                    rpending_logfile_message => $rpending_logfile_message,
                );

                # stop iterations if errors or converged
                my $stop_now = $tokenizer->report_tokenization_errors();
                $stop_now ||= $tokenizer->get_unexpected_error_count();
                if ($stop_now) {
                    $convergence_log_message = <<EOM;
Stopping iterations because of severe errors.                       
EOM
                }
                elsif ($do_convergence_test) {

                    my $digest = $md5_hex->($sink_buffer);
                    if ( !defined( $saw_md5{$digest} ) ) {
                        $saw_md5{$digest} = $iter;
                    }
                    else {

                        # Deja vu, stop iterating
                        $stop_now = 1;
                        my $iterm = $iter - 1;
                        if ( $saw_md5{$digest} != $iterm ) {

                            # Blinking (oscillating) between two stable
                            # end states.  This has happened in the past
                            # but at present there are no known instances.
                            $convergence_log_message = <<EOM;
Blinking. Output for iteration $iter same as for $saw_md5{$digest}. 
EOM
                            $diagnostics_object->write_diagnostics(
                                $convergence_log_message)
                              if $diagnostics_object;

# Uncomment to search for blinking states
# Warn( "$display_name: blinking; iter $iter same as for $saw_md5{$digest}\n" );

                        }
                        else {
                            $convergence_log_message = <<EOM;
Converged.  Output for iteration $iter same as for iter $iterm.
EOM
                            $diagnostics_object->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;
        $fh_tee          = $fh_tee_final;

        $logger_object->write_logfile_entry($convergence_log_message)
          if $convergence_log_message;

        #---------------------------------------------------------------
        # Perform any postfilter operation
        #---------------------------------------------------------------
        if ($use_buffer) {
            $sink_object->close_output_file();
            $sink_object = Perl::Tidy::LineSink->new(
                output_file              => $output_file,
                line_separator           => $line_separator,
                rOpts                    => $rOpts,
                rpending_logfile_message => $rpending_logfile_message,
                is_encoded_data          => $is_encoded_data,
            );

            my $buf =
                $postfilter
              ? $postfilter->($postfilter_buffer)
              : $postfilter_buffer;

            # Check if file changed if requested, but only after any postfilter
            if ( $rOpts->{'assert-tidy'} ) {
                my $digest_output = $md5_hex->($buf);
                if ( $digest_output ne $digest_input ) {
                    $logger_object->warning(
"assertion failure: '--assert-tidy' is set but output differs from input\n"
                    );
                }
            }
            if ( $rOpts->{'assert-untidy'} ) {
                my $digest_output = $md5_hex->($buf);
                if ( $digest_output eq $digest_input ) {
                    $logger_object->warning(
"assertion failure: '--assert-untidy' is set but output equals input\n"
                    );
                }
            }

            $source_object = Perl::Tidy::LineSource->new(
                input_file               => \$buf,
                rOpts                    => $rOpts,
                rpending_logfile_message => $rpending_logfile_message,
            );
            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)
        #---------------------------------------------------------------
        if ($in_place_modify) {
            unless ( -f $input_file ) {

                # oh, oh, no real file to backup ..
                # shouldn't happen because of numerous preliminary checks
                Die(
"problem with -b backing up input file '$input_file': not a file\n"
                );
            }
            my $backup_name = $input_file . $backup_extension;
            if ( -f $backup_name ) {
                unlink($backup_name)
                  or Die(
"unable to remove previous '$backup_name' for -b option; check permissions: $!\n"
                  );
            }

            # 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 a temporary file for -b option: $!\n");

            my ( $fout, $iname ) =
              Perl::Tidy::streamhandle( $input_file, 'w', $is_encoded_data );
            if ( !$fout ) {
                Die(
"problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n"
                );
            }

            my $line;
            while ( $line = $output_file->getline() ) {
                $fout->print($line);
            }
            $fout->close();
            $output_file = $input_file;
            $ofname      = $input_file;
        }

        #---------------------------------------------------------------
        # clean up and report errors
        #---------------------------------------------------------------
        $sink_object->close_output_file()    if $sink_object;
        $debugger_object->close_debug_file() if $debugger_object;

        # set output file permissions
        if ( $output_file && -f $output_file && !-l $output_file ) {
            if (@input_file_stat) {

                # Set file ownership and permissions
                if ( $rOpts->{'format'} eq 'tidy' ) {
                    my ( $mode_i, $uid_i, $gid_i ) =
                      @input_file_stat[ 2, 4, 5 ];
                    my ( $uid_o, $gid_o ) = ( stat($output_file) )[ 4, 5 ];
                    my $input_file_permissions  = $mode_i & oct(7777);
                    my $output_file_permissions = $input_file_permissions;

                    #rt128477: avoid inconsistent owner/group and suid/sgid
                    if ( $uid_i != $uid_o || $gid_i != $gid_o ) {

                        # try to change owner and group to match input file if
                        # in -b mode.  Note: chown returns number of files
                        # successfully changed.
                        if ( $in_place_modify
                            && chown( $uid_i, $gid_i, $output_file ) )
                        {
                            # owner/group successfully changed
                        }
                        else {

                            # owner or group differ: do not copy suid and sgid
                            $output_file_permissions = $mode_i & oct(777);
                            if ( $input_file_permissions !=
                                $output_file_permissions )
                            {
                                Warn(
"Unable to copy setuid and/or setgid bits for output file '$output_file'\n"
                                );
                            }
                        }
                    }

                    # Make the output file for rw unless we are in -b mode.
                    # Explanation: perltidy does not unlink existing output
                    # files before writing to them, for safety.  If a
                    # designated output file exists and is not writable,
                    # perltidy will halt.  This can prevent a data loss if a
                    # user accidentally enters "perltidy infile -o
                    # important_ro_file", or "perltidy infile -st
                    # >important_ro_file". But it also means that perltidy can
                    # get locked out of rerunning unless it marks its own
                    # output files writable. The alternative, of always
                    # unlinking the designated output file, is less safe and
                    # not always possible, except in -b mode, where there is an
                    # assumption that a previous backup can be unlinked even if
                    # not writable.
                    if ( !$in_place_modify ) {
                        $output_file_permissions |= oct(600);
                    }

                    if ( !chmod( $output_file_permissions, $output_file ) ) {

                        # couldn't change file permissions
                        my $operm = sprintf "%04o", $output_file_permissions;
                        Warn(
"Unable to set permissions for output file '$output_file' to $operm\n"
                        );
                    }
                }

                # 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  : NOT ALLOWED, too risky, 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"
                );
            }
            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 main loop to process all files

    # Fix for RT #130297: return a true value if anything was written to the
    # standard error output, even non-fatal warning messages, otherwise return
    # false.

    # These exit codes are returned:
    #  0 = perltidy ran to completion with no errors
    #  1 = perltidy could not run to completion due to errors
    #  2 = perltidy ran to completion with error messages

    # Note that if perltidy is run with multiple files, any single file with
    # errors or warnings will write a line like
    #        '## Please see file testing.t.ERR'
    # to standard output for each file with errors, so the flag will be true,
    # even only some of the multiple files may have had errors.

  NORMAL_EXIT:
    my $ret = $Warn_count ? 2 : 0;
    return $ret;

  ERROR_EXIT:
    return 1;
}    # 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 ) = File::Temp::tempfile();
                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 {

    # modified (corrected) from version in find2perl
    my $x = shift;
    $x =~ s#([./^\$()])#\\$1#g;    # escape special characters
    $x =~ s#\*#.*#g;               # '*' -> '.*'
    $x =~ s#\?#.#g;                # '?' -> '.'
    return "^$x\\z";               # match whole word
}

sub make_extension {

    # Make a file extension, including any leading '.' if necessary
    # The '.' may actually be an '_' under VMS
    my ( $extension, $default, $dot ) = @_;

    # Use the default if none specified
    $extension = $default unless ($extension);

    # Only extensions with these leading characters get a '.'
    # This rule gives the user some freedom
    if ( $extension =~ /^[a-zA-Z0-9]/ ) {
        $extension = $dot . $extension;
    }
    return $extension;
}

sub write_logfile_header {
    my (
        $rOpts,        $logger_object, $config_file,
        $rraw_options, $Windows_type,  $readable_options
    ) = @_;
    $logger_object->write_logfile_entry(
"perltidy version $VERSION log file on a $^O system, OLD_PERL_VERSION=$]\n"
    );
    if ($Windows_type) {
        $logger_object->write_logfile_entry("Windows type is $Windows_type\n");
    }
    my $options_string = join( ' ', @{$rraw_options} );

    if ($config_file) {
        $logger_object->write_logfile_entry(
            "Found Configuration File >>> $config_file \n");
    }
    $logger_object->write_logfile_entry(
        "Configuration and command line parameters for this run:\n");
    $logger_object->write_logfile_entry("$options_string\n");

    if ( $rOpts->{'DEBUG'} || $rOpts->{'show-options'} ) {
        $rOpts->{'logfile'} = 1;    # force logfile to be saved
        $logger_object->write_logfile_entry(
            "Final parameter set for this run\n");
        $logger_object->write_logfile_entry(
            "------------------------------------\n");

        $logger_object->write_logfile_entry($readable_options);

        $logger_object->write_logfile_entry(
            "------------------------------------\n");
    }
    $logger_object->write_logfile_entry(
        "To find error messages search for 'WARNING' with your editor\n");
    return;
}

sub generate_options {

    ######################################################################
    # Generate and return references to:
    #  @option_string - the list of options to be passed to Getopt::Long
    #  @defaults - the list of default options
    #  %expansion - a hash showing how all abbreviations are expanded
    #  %category - a hash giving the general category of each option
    #  %option_range - a hash giving the valid ranges of certain options

    # Note: a few options are not documented in the man page and usage
    # message. This is because these are experimental or debug options and
    # may or may not be retained in future versions.
    #
    # Here are the undocumented flags as far as I know.  Any of them
    # may disappear at any time.  They are mainly for fine-tuning
    # and debugging.
    #
    # fll --> fuzzy-line-length           # a trivial parameter which gets
    #                                       turned off for the extrude option
    #                                       which is mainly for debugging
    # scl --> short-concatenation-item-length   # helps break at '.'
    # recombine                           # for debugging line breaks
    # valign                              # for debugging vertical alignment
    # I   --> DIAGNOSTICS                 # for debugging [**DEACTIVATED**]
    ######################################################################

    # here is a summary of the Getopt codes:
    # <none> does not take an argument
    # =s takes a mandatory string
    # :s takes an optional string  (DO NOT USE - filenames will get eaten up)
    # =i takes a mandatory integer
    # :i takes an optional integer (NOT RECOMMENDED - can cause trouble)
    # ! does not take an argument and may be negated
    #  i.e., -foo and -nofoo are allowed
    # a double dash signals the end of the options list
    #
    #---------------------------------------------------------------
    # Define the option string passed to GetOptions.
    #---------------------------------------------------------------

    my @option_string   = ();
    my %expansion       = ();
    my %option_category = ();
    my %option_range    = ();
    my $rexpansion      = \%expansion;

    # names of categories in manual
    # leading integers will allow sorting
    my @category_name = (
        '0. I/O control',
        '1. Basic formatting options',
        '2. Code indentation control',
        '3. Whitespace control',
        '4. Comment controls',
        '5. Linebreak controls',
        '6. Controlling list formatting',
        '7. Retaining or ignoring existing line breaks',
        '8. Blank line control',
        '9. Other controls',
        '10. HTML options',
        '11. pod2html options',
        '12. Controlling HTML properties',
        '13. Debugging',
    );

    #  These options are parsed directly by perltidy:
    #    help h
    #    version v
    #  However, they are included in the option set so that they will
    #  be seen in the options dump.

    # These long option names have no abbreviations or are treated specially
    @option_string = qw(
      html!
      noprofile
      no-profile
      npro
      recombine!
      valign!
      notidy
    );

    my $category = 13;    # Debugging
    foreach (@option_string) {
        my $opt = $_;     # must avoid changing the actual flag
        $opt =~ s/!$//;
        $option_category{$opt} = $category_name[$category];
    }

    $category = 11;                                       # HTML
    $option_category{html} = $category_name[$category];

    # routine to install and check options
    my $add_option = sub {
        my ( $long_name, $short_name, $flag ) = @_;
        push @option_string, $long_name . $flag;
        $option_category{$long_name} = $category_name[$category];
        if ($short_name) {
            if ( $expansion{$short_name} ) {
                my $existing_name = $expansion{$short_name}[0];
                Die(
"redefining abbreviation $short_name for $long_name; already used for $existing_name\n"
                );
            }
            $expansion{$short_name} = [$long_name];
            if ( $flag eq '!' ) {
                my $nshort_name = 'n' . $short_name;
                my $nolong_name = 'no' . $long_name;
                if ( $expansion{$nshort_name} ) {
                    my $existing_name = $expansion{$nshort_name}[0];
                    Die(
"attempting to redefine abbreviation $nshort_name for $nolong_name; already used for $existing_name\n"
                    );
                }
                $expansion{$nshort_name} = [$nolong_name];
            }
        }
    };

    # Install long option names which have a simple abbreviation.
    # Options with code '!' get standard negation ('no' for long names,
    # 'n' for abbreviations).  Categories follow the manual.

    ###########################
    $category = 0;    # I/O_Control
    ###########################
    $add_option->( 'backup-and-modify-in-place', 'b',     '!' );
    $add_option->( 'backup-file-extension',      'bext',  '=s' );
    $add_option->( 'character-encoding',         'enc',   '=s' );
    $add_option->( 'force-read-binary',          'f',     '!' );
    $add_option->( 'format',                     'fmt',   '=s' );
    $add_option->( 'iterations',                 'it',    '=i' );
    $add_option->( 'logfile',                    'log',   '!' );
    $add_option->( 'logfile-gap',                'g',     ':i' );
    $add_option->( 'outfile',                    'o',     '=s' );
    $add_option->( 'output-file-extension',      'oext',  '=s' );
    $add_option->( 'output-path',                'opath', '=s' );
    $add_option->( 'profile',                    'pro',   '=s' );
    $add_option->( 'quiet',                      'q',     '!' );
    $add_option->( 'standard-error-output',      'se',    '!' );
    $add_option->( 'standard-output',            'st',    '!' );
    $add_option->( 'use-unicode-gcstring',       'gcs',   '!' );
    $add_option->( 'warning-output',             'w',     '!' );

    # options which are both toggle switches and values moved here
    # to hide from tidyview (which does not show category 0 flags):
    # -ole moved here from category 1
    # -sil moved here from category 2
    $add_option->( 'output-line-ending',         'ole', '=s' );
    $add_option->( 'starting-indentation-level', 'sil', '=i' );

    ########################################
    $category = 1;    # Basic formatting options
    ########################################
    $add_option->( 'check-syntax',                 'syn',  '!' );
    $add_option->( 'entab-leading-whitespace',     'et',   '=i' );
    $add_option->( 'indent-columns',               'i',    '=i' );
    $add_option->( 'maximum-line-length',          'l',    '=i' );
    $add_option->( 'variable-maximum-line-length', 'vmll', '!' );
    $add_option->( 'whitespace-cycle',             'wc',   '=i' );
    $add_option->( 'perl-syntax-check-flags',      'pscf', '=s' );
    $add_option->( 'preserve-line-endings',        'ple',  '!' );
    $add_option->( 'tabs',                         't',    '!' );
    $add_option->( 'default-tabsize',              'dt',   '=i' );
    $add_option->( 'extended-syntax',              'xs',   '!' );
    $add_option->( 'assert-tidy',                  'ast',  '!' );
    $add_option->( 'assert-untidy',                'asu',  '!' );
    $add_option->( 'sub-alias-list',               'sal',  '=s' );

    ########################################
    $category = 2;    # Code indentation control
    ########################################
    $add_option->( 'continuation-indentation',           'ci',   '=i' );
    $add_option->( 'line-up-parentheses',                'lp',   '!' );
    $add_option->( 'outdent-keyword-list',               'okwl', '=s' );
    $add_option->( 'outdent-keywords',                   'okw',  '!' );
    $add_option->( 'outdent-labels',                     'ola',  '!' );
    $add_option->( 'outdent-long-quotes',                'olq',  '!' );
    $add_option->( 'indent-closing-brace',               'icb',  '!' );
    $add_option->( 'closing-token-indentation',          'cti',  '=i' );
    $add_option->( 'closing-paren-indentation',          'cpi',  '=i' );
    $add_option->( 'closing-brace-indentation',          'cbi',  '=i' );
    $add_option->( 'closing-square-bracket-indentation', 'csbi', '=i' );
    $add_option->( 'brace-left-and-indent',              'bli',  '!' );
    $add_option->( 'brace-left-and-indent-list',         'blil', '=s' );

    ########################################
    $category = 3;    # Whitespace control
    ########################################
    $add_option->( 'add-semicolons',                            'asc',   '!' );
    $add_option->( 'add-whitespace',                            'aws',   '!' );
    $add_option->( 'block-brace-tightness',                     'bbt',   '=i' );
    $add_option->( 'brace-tightness',                           'bt',    '=i' );
    $add_option->( 'delete-old-whitespace',                     'dws',   '!' );
    $add_option->( 'delete-semicolons',                         'dsm',   '!' );
    $add_option->( 'keyword-paren-inner-tightness',             'kpit',  '=i' );
    $add_option->( 'keyword-paren-inner-tightness-list',        'kpitl', '=s' );
    $add_option->( 'logical-padding',                           'lop',   '!' );
    $add_option->( 'nospace-after-keyword',                     'nsak',  '=s' );
    $add_option->( 'nowant-left-space',                         'nwls',  '=s' );
    $add_option->( 'nowant-right-space',                        'nwrs',  '=s' );
    $add_option->( 'paren-tightness',                           'pt',    '=i' );
    $add_option->( 'space-after-keyword',                       'sak',   '=s' );
    $add_option->( 'space-for-semicolon',                       'sfs',   '!' );
    $add_option->( 'space-function-paren',                      'sfp',   '!' );
    $add_option->( 'space-keyword-paren',                       'skp',   '!' );
    $add_option->( 'space-terminal-semicolon',                  'sts',   '!' );
    $add_option->( 'square-bracket-tightness',                  'sbt',   '=i' );
    $add_option->( 'square-bracket-vertical-tightness',         'sbvt',  '=i' );
    $add_option->( 'square-bracket-vertical-tightness-closing', 'sbvtc', '=i' );
    $add_option->( 'tight-secret-operators',                    'tso',   '!' );
    $add_option->( 'trim-qw',                                   'tqw',   '!' );
    $add_option->( 'trim-pod',                                  'trp',   '!' );
    $add_option->( 'want-left-space',                           'wls',   '=s' );
    $add_option->( 'want-right-space',                          'wrs',   '=s' );
    $add_option->( 'space-prototype-paren',                     'spp',   '=i' );

    ########################################
    $category = 4;    # Comment controls
    ########################################
    $add_option->( 'closing-side-comment-else-flag',    'csce', '=i' );
    $add_option->( 'closing-side-comment-interval',     'csci', '=i' );
    $add_option->( 'closing-side-comment-list',         'cscl', '=s' );
    $add_option->( 'closing-side-comment-maximum-text', 'csct', '=i' );
    $add_option->( 'closing-side-comment-prefix',       'cscp', '=s' );
    $add_option->( 'closing-side-comment-warnings',     'cscw', '!' );
    $add_option->( 'closing-side-comments',             'csc',  '!' );
    $add_option->( 'closing-side-comments-balanced',    'cscb', '!' );
    $add_option->( 'format-skipping',                   'fs',   '!' );
    $add_option->( 'format-skipping-begin',             'fsb',  '=s' );
    $add_option->( 'format-skipping-end',               'fse',  '=s' );
    $add_option->( 'hanging-side-comments',             'hsc',  '!' );
    $add_option->( 'indent-block-comments',             'ibc',  '!' );
    $add_option->( 'indent-spaced-block-comments',      'isbc', '!' );
    $add_option->( 'fixed-position-side-comment',       'fpsc', '=i' );
    $add_option->( 'minimum-space-to-comment',          'msc',  '=i' );
    $add_option->( 'outdent-long-comments',             'olc',  '!' );
    $add_option->( 'outdent-static-block-comments',     'osbc', '!' );
    $add_option->( 'static-block-comment-prefix',       'sbcp', '=s' );
    $add_option->( 'static-block-comments',             'sbc',  '!' );
    $add_option->( 'static-side-comment-prefix',        'sscp', '=s' );
    $add_option->( 'static-side-comments',              'ssc',  '!' );
    $add_option->( 'ignore-side-comment-lengths',       'iscl', '!' );

    ########################################
    $category = 5;    # Linebreak controls
    ########################################
    $add_option->( 'add-newlines',                            'anl',   '!' );
    $add_option->( 'block-brace-vertical-tightness',          'bbvt',  '=i' );
    $add_option->( 'block-brace-vertical-tightness-list',     'bbvtl', '=s' );
    $add_option->( 'brace-vertical-tightness',                'bvt',   '=i' );
    $add_option->( 'brace-vertical-tightness-closing',        'bvtc',  '=i' );
    $add_option->( 'cuddled-else',                            'ce',    '!' );
    $add_option->( 'cuddled-block-list',                      'cbl',   '=s' );
    $add_option->( 'cuddled-block-list-exclusive',            'cblx',  '!' );
    $add_option->( 'cuddled-break-option',                    'cbo',   '=i' );
    $add_option->( 'delete-old-newlines',                     'dnl',   '!' );
    $add_option->( 'opening-brace-always-on-right',           'bar',   '!' );
    $add_option->( 'opening-brace-on-new-line',               'bl',    '!' );
    $add_option->( 'opening-hash-brace-right',                'ohbr',  '!' );
    $add_option->( 'opening-paren-right',                     'opr',   '!' );
    $add_option->( 'opening-square-bracket-right',            'osbr',  '!' );
    $add_option->( 'opening-anonymous-sub-brace-on-new-line', 'asbl',  '!' );
    $add_option->( 'opening-sub-brace-on-new-line',           'sbl',   '!' );
    $add_option->( 'paren-vertical-tightness',                'pvt',   '=i' );
    $add_option->( 'paren-vertical-tightness-closing',        'pvtc',  '=i' );
    $add_option->( 'weld-nested-containers',                  'wn',    '!' );
    $add_option->( 'space-backslash-quote',                   'sbq',   '=i' );
    $add_option->( 'stack-closing-block-brace',               'scbb',  '!' );
    $add_option->( 'stack-closing-hash-brace',                'schb',  '!' );
    $add_option->( 'stack-closing-paren',                     'scp',   '!' );
    $add_option->( 'stack-closing-square-bracket',            'scsb',  '!' );
    $add_option->( 'stack-opening-block-brace',               'sobb',  '!' );
    $add_option->( 'stack-opening-hash-brace',                'sohb',  '!' );
    $add_option->( 'stack-opening-paren',                     'sop',   '!' );
    $add_option->( 'stack-opening-square-bracket',            'sosb',  '!' );
    $add_option->( 'vertical-tightness',                      'vt',    '=i' );
    $add_option->( 'vertical-tightness-closing',              'vtc',   '=i' );
    $add_option->( 'want-break-after',                        'wba',   '=s' );
    $add_option->( 'want-break-before',                       'wbb',   '=s' );
    $add_option->( 'break-after-all-operators',               'baao',  '!' );
    $add_option->( 'break-before-all-operators',              'bbao',  '!' );
    $add_option->( 'keep-interior-semicolons',                'kis',   '!' );
    $add_option->( 'one-line-block-semicolons',               'olbs',  '=i' );
    $add_option->( 'one-line-block-nesting',                  'olbn',  '=i' );

    ########################################
    $category = 6;    # Controlling list formatting
    ########################################
    $add_option->( 'break-at-old-comma-breakpoints', 'boc', '!' );
    $add_option->( 'comma-arrow-breakpoints',        'cab', '=i' );
    $add_option->( 'maximum-fields-per-table',       'mft', '=i' );

    ########################################
    $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-method-breakpoints',    'bom', '!' );
    $add_option->( 'break-at-old-semicolon-breakpoints', 'bos', '!' );
    $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->( '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' );

    $add_option->( 'keyword-group-blanks-list',         'kgbl', '=s' );
    $add_option->( 'keyword-group-blanks-size',         'kgbs', '=s' );
    $add_option->( 'keyword-group-blanks-repeat-count', 'kgbr', '=i' );
    $add_option->( 'keyword-group-blanks-before',       'kgbb', '=i' );
    $add_option->( 'keyword-group-blanks-after',        'kgba', '=i' );
    $add_option->( 'keyword-group-blanks-inside',       'kgbi', '!' );
    $add_option->( 'keyword-group-blanks-delete',       'kgbd', '!' );

    $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
    ########################################
    $add_option->( 'delete-block-comments',        'dbc',  '!' );
    $add_option->( 'delete-closing-side-comments', 'dcsc', '!' );
    $add_option->( 'delete-pod',                   'dp',   '!' );
    $add_option->( 'delete-side-comments',         'dsc',  '!' );
    $add_option->( 'tee-block-comments',           'tbc',  '!' );
    $add_option->( 'tee-pod',                      'tp',   '!' );
    $add_option->( 'tee-side-comments',            'tsc',  '!' );
    $add_option->( 'look-for-autoloader',          'lal',  '!' );
    $add_option->( 'look-for-hash-bang',           'x',    '!' );
    $add_option->( 'look-for-selfloader',          'lsl',  '!' );
    $add_option->( 'pass-version-line',            'pvl',  '!' );

    ########################################
    $category = 13;    # Debugging
    ########################################
##  $add_option->( 'DIAGNOSTICS',                     'I',    '!' );
    $add_option->( 'DEBUG',                           'D',    '!' );
    $add_option->( 'dump-cuddled-block-list',         'dcbl', '!' );
    $add_option->( 'dump-defaults',                   'ddf',  '!' );
    $add_option->( 'dump-long-names',                 'dln',  '!' );
    $add_option->( 'dump-options',                    'dop',  '!' );
    $add_option->( 'dump-profile',                    'dpro', '!' );
    $add_option->( 'dump-short-names',                'dsn',  '!' );
    $add_option->( 'dump-token-types',                'dtt',  '!' );
    $add_option->( 'dump-want-left-space',            'dwls', '!' );
    $add_option->( 'dump-want-right-space',           'dwrs', '!' );
    $add_option->( 'fuzzy-line-length',               'fll',  '!' );
    $add_option->( 'help',                            'h',    '' );
    $add_option->( 'short-concatenation-item-length', 'scl',  '=i' );
    $add_option->( 'show-options',                    'opt',  '!' );
    $add_option->( 'timestamp',                       'ts',   '!' );
    $add_option->( 'version',                         'v',    '' );
    $add_option->( 'memoize',                         'mem',  '!' );
    $add_option->( 'file-size-order',                 'fso',  '!' );

    #---------------------------------------------------------------------

    # The Perl::Tidy::HtmlWriter will add its own options to the string
    Perl::Tidy::HtmlWriter->make_getopt_long_names( \@option_string );

    ########################################
    # Set categories 10, 11, 12
    ########################################
    # Based on their known order
    $category = 12;    # HTML properties
    foreach my $opt (@option_string) {
        my $long_name = $opt;
        $long_name =~ s/(!|=.*|:.*)$//;
        unless ( defined( $option_category{$long_name} ) ) {
            if ( $long_name =~ /^html-linked/ ) {
                $category = 10;    # HTML options
            }
            elsif ( $long_name =~ /^pod2html/ ) {
                $category = 11;    # Pod2html
            }
            $option_category{$long_name} = $category_name[$category];
        }
    }

    #---------------------------------------------------------------
    # Assign valid ranges to certain options
    #---------------------------------------------------------------
    # In the future, these may be used to make preliminary checks
    # hash keys are long names
    # If key or value is undefined:
    #   strings may have any value
    #   integer ranges are >=0
    # If value is defined:
    #   value is [qw(any valid words)] for strings
    #   value is [min, max] for integers
    #   if min is undefined, there is no lower limit
    #   if max is undefined, there is no upper limit
    # Parameters not listed here have defaults
    %option_range = (
        'format'             => [ 'tidy', 'html', 'user' ],
        'output-line-ending' => [ 'dos',  'win',  'mac', 'unix' ],
        'space-backslash-quote'         => [ 0, 2 ],
        'block-brace-tightness'         => [ 0, 2 ],
        'keyword-paren-inner-tightness' => [ 0, 2 ],
        'brace-tightness'               => [ 0, 2 ],
        'paren-tightness'               => [ 0, 2 ],
        'square-bracket-tightness'      => [ 0, 2 ],

        'block-brace-vertical-tightness'            => [ 0, 2 ],
        'brace-vertical-tightness'                  => [ 0, 2 ],
        'brace-vertical-tightness-closing'          => [ 0, 2 ],
        'paren-vertical-tightness'                  => [ 0, 2 ],
        'paren-vertical-tightness-closing'          => [ 0, 2 ],
        'square-bracket-vertical-tightness'         => [ 0, 2 ],
        'square-bracket-vertical-tightness-closing' => [ 0, 2 ],
        'vertical-tightness'                        => [ 0, 2 ],
        'vertical-tightness-closing'                => [ 0, 2 ],

        'closing-brace-indentation'          => [ 0, 3 ],
        'closing-paren-indentation'          => [ 0, 3 ],
        'closing-square-bracket-indentation' => [ 0, 3 ],
        'closing-token-indentation'          => [ 0, 3 ],

        'closing-side-comment-else-flag' => [ 0, 2 ],
        'comma-arrow-breakpoints'        => [ 0, 5 ],

        'keyword-group-blanks-before' => [ 0, 2 ],
        'keyword-group-blanks-after'  => [ 0, 2 ],

        'space-prototype-paren' => [ 0, 2 ],
    );

    # Note: we could actually allow negative ci if someone really wants it:
    # $option_range{'continuation-indentation'} = [ undef, undef ];

    #---------------------------------------------------------------
    # Assign default values to the above options here, except
    # for 'outfile' and 'help'.
    # These settings should approximate the perlstyle(1) suggestions.
    #---------------------------------------------------------------
    my @defaults = qw(
      add-newlines
      add-semicolons
      add-whitespace
      blanks-before-blocks
      blanks-before-comments
      blank-lines-before-subs=1
      blank-lines-before-packages=1

      keyword-group-blanks-size=5
      keyword-group-blanks-repeat-count=0
      keyword-group-blanks-before=1
      keyword-group-blanks-after=1
      nokeyword-group-blanks-inside
      nokeyword-group-blanks-delete

      block-brace-tightness=0
      block-brace-vertical-tightness=0
      brace-tightness=1
      brace-vertical-tightness-closing=0
      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=5
      nocheck-syntax
      character-encoding=guess
      closing-side-comment-interval=6
      closing-side-comment-maximum-text=20
      closing-side-comment-else-flag=0
      closing-side-comments-balanced
      closing-paren-indentation=0
      closing-brace-indentation=0
      closing-square-bracket-indentation=0
      continuation-indentation=2
      cuddled-break-option=1
      delete-old-newlines
      delete-semicolons
      extended-syntax
      fuzzy-line-length
      hanging-side-comments
      indent-block-comments
      indent-columns=4
      iterations=1
      keep-old-blank-lines=1
      keyword-paren-inner-tightness=1
      logical-padding
      long-block-line-count=8
      look-for-autoloader
      look-for-selfloader
      maximum-consecutive-blank-lines=1
      maximum-fields-per-table=0
      maximum-line-length=80
      memoize
      minimum-space-to-comment=4
      nobrace-left-and-indent
      nocuddled-else
      nodelete-old-whitespace
      nohtml
      nologfile
      noquiet
      noshow-options
      nostatic-side-comments
      notabs
      nowarning-output
      one-line-block-semicolons=1
      one-line-block-nesting=0
      outdent-labels
      outdent-long-quotes
      outdent-long-comments
      paren-tightness=1
      paren-vertical-tightness-closing=0
      paren-vertical-tightness=0
      pass-version-line
      noweld-nested-containers
      recombine
      nouse-unicode-gcstring
      valign
      short-concatenation-item-length=8
      space-for-semicolon
      space-backslash-quote=1
      space-prototype-paren=1
      square-bracket-tightness=1
      square-bracket-vertical-tightness-closing=0
      square-bracket-vertical-tightness=0
      static-block-comments
      timestamp
      trim-qw
      format=tidy
      backup-file-extension=bak
      format-skipping
      default-tabsize=8

      pod2html
      html-table-of-contents
      html-entities
    );

    push @defaults, "perl-syntax-check-flags=-c -T";

    #---------------------------------------------------------------
    # Define abbreviations which will be expanded into the above primitives.
    # These may be defined recursively.
    #---------------------------------------------------------------
    %expansion = (
        %expansion,
        'freeze-newlines'   => [qw(noadd-newlines nodelete-old-newlines)],
        'fnl'               => [qw(freeze-newlines)],
        'freeze-whitespace' => [qw(noadd-whitespace nodelete-old-whitespace)],
        'fws'               => [qw(freeze-whitespace)],
        'freeze-blank-lines' =>
          [qw(maximum-consecutive-blank-lines=0 keep-old-blank-lines=2)],
        'fbl'                => [qw(freeze-blank-lines)],
        'indent-only'        => [qw(freeze-newlines freeze-whitespace)],
        'outdent-long-lines' => [qw(outdent-long-quotes outdent-long-comments)],
        'nooutdent-long-lines' =>
          [qw(nooutdent-long-quotes nooutdent-long-comments)],
        'noll' => [qw(nooutdent-long-lines)],
        'io'   => [qw(indent-only)],
        'delete-all-comments' =>
          [qw(delete-block-comments delete-side-comments delete-pod)],
        'nodelete-all-comments' =>
          [qw(nodelete-block-comments nodelete-side-comments nodelete-pod)],
        'dac'  => [qw(delete-all-comments)],
        'ndac' => [qw(nodelete-all-comments)],
        'gnu'  => [qw(gnu-style)],
        'pbp'  => [qw(perl-best-practices)],
        'tee-all-comments' =>
          [qw(tee-block-comments tee-side-comments tee-pod)],
        'notee-all-comments' =>
          [qw(notee-block-comments notee-side-comments notee-pod)],
        'tac'   => [qw(tee-all-comments)],
        'ntac'  => [qw(notee-all-comments)],
        'html'  => [qw(format=html)],
        'nhtml' => [qw(format=tidy)],
        'tidy'  => [qw(format=tidy)],

        # -cb is now a synonym for -ce
        'cb'             => [qw(cuddled-else)],
        'cuddled-blocks' => [qw(cuddled-else)],

        'utf8'  => [qw(character-encoding=utf8)],
        'UTF8'  => [qw(character-encoding=utf8)],
        'guess' => [qw(character-encoding=guess)],

        'swallow-optional-blank-lines'   => [qw(kbl=0)],
        'noswallow-optional-blank-lines' => [qw(kbl=1)],
        'sob'                            => [qw(kbl=0)],
        'nsob'                           => [qw(kbl=1)],

        'break-after-comma-arrows'   => [qw(cab=0)],
        'nobreak-after-comma-arrows' => [qw(cab=1)],
        '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)],

        'keyword-group-blanks'   => [qw(kgbb=2 kgbi kgba=2)],
        'kgb'                    => [qw(kgbb=2 kgbi kgba=2)],
        'nokeyword-group-blanks' => [qw(kgbb=1 nkgbi kgba=1)],
        'nkgb'                   => [qw(kgbb=1 nkgbi kgba=1)],

        'break-at-old-trinary-breakpoints' => [qw(bot)],

        'cti=0' => [qw(cpi=0 cbi=0 csbi=0)],
        'cti=1' => [qw(cpi=1 cbi=1 csbi=1)],
        'cti=2' => [qw(cpi=2 cbi=2 csbi=2)],
        'icp'   => [qw(cpi=2 cbi=2 csbi=2)],
        'nicp'  => [qw(cpi=0 cbi=0 csbi=0)],

        'closing-token-indentation=0' => [qw(cpi=0 cbi=0 csbi=0)],
        'closing-token-indentation=1' => [qw(cpi=1 cbi=1 csbi=1)],
        'closing-token-indentation=2' => [qw(cpi=2 cbi=2 csbi=2)],
        'indent-closing-paren'        => [qw(cpi=2 cbi=2 csbi=2)],
        'noindent-closing-paren'      => [qw(cpi=0 cbi=0 csbi=0)],

        'vt=0' => [qw(pvt=0 bvt=0 sbvt=0)],
        'vt=1' => [qw(pvt=1 bvt=1 sbvt=1)],
        'vt=2' => [qw(pvt=2 bvt=2 sbvt=2)],

        'vertical-tightness=0' => [qw(pvt=0 bvt=0 sbvt=0)],
        'vertical-tightness=1' => [qw(pvt=1 bvt=1 sbvt=1)],
        'vertical-tightness=2' => [qw(pvt=2 bvt=2 sbvt=2)],

        'vtc=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
        'vtc=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
        'vtc=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],

        'vertical-tightness-closing=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
        'vertical-tightness-closing=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
        'vertical-tightness-closing=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],

        'otr'                   => [qw(opr ohbr osbr)],
        'opening-token-right'   => [qw(opr ohbr osbr)],
        'notr'                  => [qw(nopr nohbr nosbr)],
        'noopening-token-right' => [qw(nopr nohbr nosbr)],

        'sot'                    => [qw(sop sohb sosb)],
        'nsot'                   => [qw(nsop nsohb nsosb)],
        'stack-opening-tokens'   => [qw(sop sohb sosb)],
        'nostack-opening-tokens' => [qw(nsop nsohb nsosb)],

        'sct'                    => [qw(scp schb scsb)],
        'stack-closing-tokens'   => => [qw(scp schb scsb)],
        'nsct'                   => [qw(nscp nschb nscsb)],
        'nostack-closing-tokens' => [qw(nscp nschb nscsb)],

        'sac'                    => [qw(sot sct)],
        'nsac'                   => [qw(nsot nsct)],
        'stack-all-containers'   => [qw(sot sct)],
        'nostack-all-containers' => [qw(nsot nsct)],

        'act=0'                      => [qw(pt=0 sbt=0 bt=0 bbt=0)],
        'act=1'                      => [qw(pt=1 sbt=1 bt=1 bbt=1)],
        'act=2'                      => [qw(pt=2 sbt=2 bt=2 bbt=2)],
        'all-containers-tightness=0' => [qw(pt=0 sbt=0 bt=0 bbt=0)],
        'all-containers-tightness=1' => [qw(pt=1 sbt=1 bt=1 bbt=1)],
        'all-containers-tightness=2' => [qw(pt=2 sbt=2 bt=2 bbt=2)],

        'stack-opening-block-brace'   => [qw(bbvt=2 bbvtl=*)],
        'sobb'                        => [qw(bbvt=2 bbvtl=*)],
        'nostack-opening-block-brace' => [qw(bbvt=0)],
        'nsobb'                       => [qw(bbvt=0)],

        'converge'   => [qw(it=4)],
        'noconverge' => [qw(it=1)],
        'conv'       => [qw(it=4)],
        'nconv'      => [qw(it=1)],

        # 'mangle' originally deleted pod and comments, but to keep it
        # reversible, it no longer does.  But if you really want to
        # delete them, just use:
        #   -mangle -dac

        # An interesting use for 'mangle' is to do this:
        #    perltidy -mangle myfile.pl -st | perltidy -o myfile.pl.new
        # which will form as many one-line blocks as possible

        'mangle' => [
            qw(
              check-syntax
              keep-old-blank-lines=0
              delete-old-newlines
              delete-old-whitespace
              delete-semicolons
              indent-columns=0
              maximum-consecutive-blank-lines=0
              maximum-line-length=100000
              noadd-newlines
              noadd-semicolons
              noadd-whitespace
              noblanks-before-blocks
              blank-lines-before-subs=0
              blank-lines-before-packages=0
              notabs
              )
        ],

        # 'extrude' originally deleted pod and comments, but to keep it
        # reversible, it no longer does.  But if you really want to
        # delete them, just use
        #   extrude -dac
        #
        # An interesting use for 'extrude' is to do this:
        #    perltidy -extrude myfile.pl -st | perltidy -o myfile.pl.new
        # which will break up all one-line blocks.
        #
        # Removed 'check-syntax' option, which is unsafe because it may execute
        # code in BEGIN blocks.  Example 'Moose/debugger-duck_type.t'.

        'extrude' => [
            qw(
              ci=0
              delete-old-newlines
              delete-old-whitespace
              delete-semicolons
              indent-columns=0
              maximum-consecutive-blank-lines=0
              maximum-line-length=1
              noadd-semicolons
              noadd-whitespace
              noblanks-before-blocks
              blank-lines-before-subs=0
              blank-lines-before-packages=0
              nofuzzy-line-length
              notabs
              norecombine
              )
        ],

        # this style tries to follow the GNU Coding Standards (which do
        # not really apply to perl but which are followed by some perl
        # programmers).
        'gnu-style' => [
            qw(
              lp bl noll pt=2 bt=2 sbt=2 cpi=1 csbi=1 cbi=1
              )
        ],

        # Style suggested in Damian Conway's Perl Best Practices
        'perl-best-practices' => [
            qw(l=78 i=4 ci=4 st se vt=2 cti=0 pt=1 bt=1 sbt=1 bbt=1 nsfs nolq),
q(wbb=% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=)
        ],

        # Additional styles can be added here
    );

    Perl::Tidy::HtmlWriter->make_abbreviated_names( \%expansion );

    # Uncomment next line to dump all expansions for debugging:
    # dump_short_names(\%expansion);
    return (
        \@option_string,   \@defaults, \%expansion,
        \%option_category, \%option_range
    );

}    # end of generate_options

# Memoize process_command_line. Given same @ARGV passed in, return same
# values and same @ARGV back.
# This patch was supplied by Jonathan Swartz Nov 2012 and significantly speeds
# up masontidy (https://metacpan.org/module/masontidy)

my %process_command_line_cache;

sub process_command_line {

    my @q = @_;
    my (
        $perltidyrc_stream,  $is_Windows, $Windows_type,
        $rpending_complaint, $dump_options_type
    ) = @q;

    my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type;
    if ($use_cache) {
        my $cache_key = join( chr(28), @ARGV );
        if ( my $result = $process_command_line_cache{$cache_key} ) {
            my ( $argv, @retvals ) = @{$result};
            @ARGV = @{$argv};
            return @retvals;
        }
        else {
            my @retvals = _process_command_line(@q);
            $process_command_line_cache{$cache_key} = [ \@ARGV, @retvals ]
              if $retvals[0]->{'memoize'};
            return @retvals;
        }
    }
    else {
        return _process_command_line(@q);
    }
}

# (note the underscore here)
sub _process_command_line {

    my (
        $perltidyrc_stream,  $is_Windows, $Windows_type,
        $rpending_complaint, $dump_options_type
    ) = @_;

    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
    ) = generate_options();

    #---------------------------------------------------------------
    # set the defaults by passing the above list through GetOptions
    #---------------------------------------------------------------
    my %Opts = ();
    {
        local @ARGV = ();

        # do not load the defaults if we are just dumping perltidyrc
        unless ( $dump_options_type eq 'perltidyrc' ) {
            for my $i ( @{$rdefaults} ) { push @ARGV, "--" . $i }
        }
        if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
            Die(
"Programming Bug reported by 'GetOptions': error in setting default options"
            );
        }
    }

    my $word;
    my @raw_options        = ();
    my $config_file        = "";
    my $saw_ignore_profile = 0;
    my $saw_dump_profile   = 0;

    #---------------------------------------------------------------
    # Take a first look at the command-line parameters.  Do as many
    # immediate dumps as possible, which can avoid confusion if the
    # perltidyrc file has an error.
    #---------------------------------------------------------------
    foreach my $i (@ARGV) {

        $i =~ s/^--/-/;
        if ( $i =~ /^-(npro|noprofile|no-profile)$/ ) {
            $saw_ignore_profile = 1;
        }

        # note: this must come before -pro and -profile, below:
        elsif ( $i =~ /^-(dump-profile|dpro)$/ ) {
            $saw_dump_profile = 1;
        }
        elsif ( $i =~ /^-(pro|profile)=(.+)/ ) {
            if ($config_file) {
                Warn(
"Only one -pro=filename allowed, using '$2' instead of '$config_file'\n"
                );
            }
            $config_file = $2;

            # resolve <dir>/.../<file>, meaning look upwards from directory
            if ( defined($config_file) ) {
                if ( my ( $start_dir, $search_file ) =
                    ( $config_file =~ m{^(.*)\.\.\./(.*)$} ) )
                {
                    $start_dir = '.' if !$start_dir;
                    $start_dir = Cwd::realpath($start_dir);
                    if ( my $found_file =
                        find_file_upwards( $start_dir, $search_file ) )
                    {
                        $config_file = $found_file;
                    }
                }
            }
            unless ( -e $config_file ) {
                Warn("cannot find file given with -pro=$config_file: $!\n");
                $config_file = "";
            }
        }
        elsif ( $i =~ /^-(pro|profile)=?$/ ) {
            Die("usage: -pro=filename or --profile=filename, no spaces\n");
        }
        elsif ( $i =~ /^-(help|h|HELP|H|\?)$/ ) {
            usage();
            Exit(0);
        }
        elsif ( $i =~ /^-(version|v)$/ ) {
            show_version();
            Exit(0);
        }
        elsif ( $i =~ /^-(dump-defaults|ddf)$/ ) {
            dump_defaults( @{$rdefaults} );
            Exit(0);
        }
        elsif ( $i =~ /^-(dump-long-names|dln)$/ ) {
            dump_long_names( @{$roption_string} );
            Exit(0);
        }
        elsif ( $i =~ /^-(dump-short-names|dsn)$/ ) {
            dump_short_names($rexpansion);
            Exit(0);
        }
        elsif ( $i =~ /^-(dump-token-types|dtt)$/ ) {
            Perl::Tidy::Tokenizer->dump_token_types(*STDOUT);
            Exit(0);
        }
    }

    if ( $saw_dump_profile && $saw_ignore_profile ) {
        Warn("No profile to dump because of -npro\n");
        Exit(1);
    }

    #---------------------------------------------------------------
    # read any .perltidyrc configuration file
    #---------------------------------------------------------------
    unless ($saw_ignore_profile) {

        # resolve possible conflict between $perltidyrc_stream passed
        # as call parameter to perltidy and -pro=filename on command
        # line.
        if ($perltidyrc_stream) {
            if ($config_file) {
                Warn(<<EOM);
 Conflict: a perltidyrc configuration file was specified both as this
 perltidy call parameter: $perltidyrc_stream 
 and with this -profile=$config_file.
 Using -profile=$config_file.
EOM
            }
            else {
                $config_file = $perltidyrc_stream;
            }
        }

        # look for a config file if we don't have one yet
        my $rconfig_file_chatter;
        ${$rconfig_file_chatter} = "";
        $config_file =
          find_config_file( $is_Windows, $Windows_type, $rconfig_file_chatter,
            $rpending_complaint )
          unless $config_file;

        # open any config file
        my $fh_config;
        if ($config_file) {
            ( $fh_config, $config_file ) =
              Perl::Tidy::streamhandle( $config_file, 'r' );
            unless ($fh_config) {
                ${$rconfig_file_chatter} .=
                  "# $config_file exists but cannot be opened\n";
            }
        }

        if ($saw_dump_profile) {
            dump_config_file( $fh_config, $config_file, $rconfig_file_chatter );
            Exit(0);
        }

        if ($fh_config) {

            my ( $rconfig_list, $death_message ) =
              read_config_file( $fh_config, $config_file, $rexpansion );
            Die($death_message) if ($death_message);

            # process any .perltidyrc parameters right now so we can
            # localize errors
            if ( @{$rconfig_list} ) {
                local @ARGV = @{$rconfig_list};

                expand_command_abbreviations( $rexpansion, \@raw_options,
                    $config_file );

                if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
                    Die(
"Error in this config file: $config_file  \nUse -npro to ignore this file, -h for help'\n"
                    );
                }

                # Anything left in this local @ARGV is an error and must be
                # invalid bare words from the configuration file.  We cannot
                # check this earlier because bare words may have been valid
                # values for parameters.  We had to wait for GetOptions to have
                # a look at @ARGV.
                if (@ARGV) {
                    my $count = @ARGV;
                    my $str   = "\'" . pop(@ARGV) . "\'";
                    while ( my $param = pop(@ARGV) ) {
                        if ( length($str) < 70 ) {
                            $str .= ", '$param'";
                        }
                        else {
                            $str .= ", ...";
                            last;
                        }
                    }
                    Die(<<EOM);
There are $count unrecognized values in the configuration file '$config_file':
$str
Use leading dashes for parameters.  Use -npro to ignore this file.
EOM
                }

                # Undo any options which cause premature exit.  They are not
                # appropriate for a config file, and it could be hard to
                # diagnose the cause of the premature exit.
                foreach (
                    qw{
                    dump-cuddled-block-list
                    dump-defaults
                    dump-long-names
                    dump-options
                    dump-profile
                    dump-short-names
                    dump-token-types
                    dump-want-left-space
                    dump-want-right-space
                    help
                    stylesheet
                    version
                    }
                  )
                {

                    if ( defined( $Opts{$_} ) ) {
                        delete $Opts{$_};
                        Warn("ignoring --$_ in config file: $config_file\n");
                    }
                }
            }
        }
    }

    #---------------------------------------------------------------
    # now process the command line parameters
    #---------------------------------------------------------------
    expand_command_abbreviations( $rexpansion, \@raw_options, $config_file );

    local $SIG{'__WARN__'} = sub { Warn( $_[0] ) };
    if ( !GetOptions( \%Opts, @{$roption_string} ) ) {
        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

sub check_options {

    my ( $rOpts, $is_Windows, $Windows_type, $rpending_complaint ) = @_;

    #---------------------------------------------------------------
    # check and handle any interactions among the basic options..
    #---------------------------------------------------------------

    # Since -vt, -vtc, and -cti are abbreviations, but under
    # msdos, an unquoted input parameter like vtc=1 will be
    # seen as 2 parameters, vtc and 1, so the abbreviations
    # won't be seen.  Therefore, we will catch them here if
    # they get through.

    if ( defined $rOpts->{'vertical-tightness'} ) {
        my $vt = $rOpts->{'vertical-tightness'};
        $rOpts->{'paren-vertical-tightness'}          = $vt;
        $rOpts->{'square-bracket-vertical-tightness'} = $vt;
        $rOpts->{'brace-vertical-tightness'}          = $vt;
    }

    if ( defined $rOpts->{'vertical-tightness-closing'} ) {
        my $vtc = $rOpts->{'vertical-tightness-closing'};
        $rOpts->{'paren-vertical-tightness-closing'}          = $vtc;
        $rOpts->{'square-bracket-vertical-tightness-closing'} = $vtc;
        $rOpts->{'brace-vertical-tightness-closing'}          = $vtc;
    }

    if ( defined $rOpts->{'closing-token-indentation'} ) {
        my $cti = $rOpts->{'closing-token-indentation'};
        $rOpts->{'closing-square-bracket-indentation'} = $cti;
        $rOpts->{'closing-brace-indentation'}          = $cti;
        $rOpts->{'closing-paren-indentation'}          = $cti;
    }

    # In quiet mode, there is no log file and hence no way to report
    # results of syntax check, so don't do it.
    if ( $rOpts->{'quiet'} ) {
        $rOpts->{'check-syntax'} = 0;
    }

    # can't check syntax if no output
    if ( $rOpts->{'format'} ne 'tidy' ) {
        $rOpts->{'check-syntax'} = 0;
    }

    # Never let Windows 9x/Me systems run syntax check -- this will prevent a
    # wide variety of nasty problems on these systems, because they cannot
    # reliably run backticks.  Don't even think about changing this!
    if (   $rOpts->{'check-syntax'}
        && $is_Windows
        && ( !$Windows_type || $Windows_type =~ /^(9|Me)/ ) )
    {
        $rOpts->{'check-syntax'} = 0;
    }

    ###########################################################################
    # Added Dec 2017: Deactivating check-syntax for all systems for safety
    # because unexpected results can occur when code in BEGIN blocks is
    # executed.  This flag was included to help check for perltidy mistakes,
    # and may still be useful for debugging.  To activate for testing comment
    # out the next three lines.  Also fix sub 'do_check_syntax' in this file.
    ###########################################################################
    else {
        $rOpts->{'check-syntax'} = 0;
    }

    # It's really a bad idea to check syntax as root unless you wrote
    # the script yourself.  FIXME: not sure if this works with VMS
    unless ($is_Windows) {

        if ( $< == 0 && $rOpts->{'check-syntax'} ) {
            $rOpts->{'check-syntax'} = 0;
            ${$rpending_complaint} .=
"Syntax check deactivated for safety; you shouldn't run this as root\n";
        }
    }

    # check iteration count and quietly fix if necessary:
    # - iterations option only applies to code beautification mode
    # - 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'} > 6 )  { $rOpts->{'iterations'} = 6 }
    }
    else {
        $rOpts->{'iterations'} = 1;
    }

    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 ) {
        $rOpts->{'logfile'} = 1;
    }

    # set short-cut flag when only indentation is to be done.
    # Note that the user may or may not have already set the
    # indent-only flag.
    if (   !$rOpts->{'add-whitespace'}
        && !$rOpts->{'delete-old-whitespace'}
        && !$rOpts->{'add-newlines'}
        && !$rOpts->{'delete-old-newlines'} )
    {
        $rOpts->{'indent-only'} = 1;
    }

    # -isbc implies -ibc
    if ( $rOpts->{'indent-spaced-block-comments'} ) {
        $rOpts->{'indent-block-comments'} = 1;
    }

    # -bli flag implies -bl
    if ( $rOpts->{'brace-left-and-indent'} ) {
        $rOpts->{'opening-brace-on-new-line'} = 1;
    }

    if (   $rOpts->{'opening-brace-always-on-right'}
        && $rOpts->{'opening-brace-on-new-line'} )
    {
        Warn(<<EOM);
 Conflict: you specified both 'opening-brace-always-on-right' (-bar) and 
  'opening-brace-on-new-line' (-bl).  Ignoring -bl. 
EOM
        $rOpts->{'opening-brace-on-new-line'} = 0;
    }

    # it simplifies things if -bl is 0 rather than undefined
    if ( !defined( $rOpts->{'opening-brace-on-new-line'} ) ) {
        $rOpts->{'opening-brace-on-new-line'} = 0;
    }

    # -sbl defaults to -bl if not defined
    if ( !defined( $rOpts->{'opening-sub-brace-on-new-line'} ) ) {
        $rOpts->{'opening-sub-brace-on-new-line'} =
          $rOpts->{'opening-brace-on-new-line'};
    }

    if ( $rOpts->{'entab-leading-whitespace'} ) {
        if ( $rOpts->{'entab-leading-whitespace'} < 0 ) {
            Warn("-et=n must use a positive integer; ignoring -et\n");
            $rOpts->{'entab-leading-whitespace'} = undef;
        }

        # entab leading whitespace has priority over the older 'tabs' option
        if ( $rOpts->{'tabs'} ) { $rOpts->{'tabs'} = 0; }
    }

    # set a default tabsize to be used in guessing the starting indentation
    # level if and only if this run does not use tabs and the old code does
    # use tabs
    if ( $rOpts->{'default-tabsize'} ) {
        if ( $rOpts->{'default-tabsize'} < 0 ) {
            Warn("negative value of -dt, setting 0\n");
            $rOpts->{'default-tabsize'} = 0;
        }
        if ( $rOpts->{'default-tabsize'} > 20 ) {
            Warn("unreasonably large value of -dt, reducing\n");
            $rOpts->{'default-tabsize'} = 20;
        }
    }
    else {
        $rOpts->{'default-tabsize'} = 8;
    }

    # Check and clean up any sub-alias-list
    if ( $rOpts->{'sub-alias-list'} ) {
        my $sub_alias_string = $rOpts->{'sub-alias-list'};
        $sub_alias_string =~ s/,/ /g;    # allow commas
        $sub_alias_string =~ s/^\s+//;
        $sub_alias_string =~ s/\s+$//;
        my @sub_alias_list     = split /\s+/, $sub_alias_string;
        my @filtered_word_list = ('sub');
        my %seen;

        # include 'sub' for later convenience
        $seen{sub}++;
        foreach my $word (@sub_alias_list) {
            if ($word) {
                if ( $word !~ /^\w[\w\d]*$/ ) {
                    Warn("unexpected sub alias '$word' - ignoring\n");
                }
                if ( !$seen{$word} ) {
                    $seen{$word}++;
                    push @filtered_word_list, $word;
                }
            }
        }
        my $joined_words = join ' ', @filtered_word_list;
        $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list;
    }

    # Define $tabsize, the number of spaces per tab for use in
    # guessing the indentation of source lines with leading tabs.
    # Assume same as for this run if tabs are used , otherwise assume
    # a default value, typically 8
    my $tabsize =
        $rOpts->{'entab-leading-whitespace'}
      ? $rOpts->{'entab-leading-whitespace'}
      : $rOpts->{'tabs'} ? $rOpts->{'indent-columns'}
      :                    $rOpts->{'default-tabsize'};
    return $tabsize;
}

sub find_file_upwards {
    my ( $search_dir, $search_file ) = @_;

    $search_dir  =~ s{/+$}{};
    $search_file =~ s{^/+}{};

    while (1) {
        my $try_path = "$search_dir/$search_file";
        if ( -f $try_path ) {
            return $try_path;
        }
        elsif ( $search_dir eq '/' ) {
            return;
        }
        else {
            $search_dir = dirname($search_dir);
        }
    }

    # This return is for Perl-Critic.
    # We shouldn't get out of the while loop without a return
    return;
}

sub expand_command_abbreviations {

    # go through @ARGV and expand any abbreviations

    my ( $rexpansion, $rraw_options, $config_file ) = @_;

    # set a pass limit to prevent an infinite loop;
    # 10 should be plenty, but it may be increased to allow deeply
    # nested expansions.
    my $max_passes = 10;
    my @new_argv   = ();

    # keep looping until all expansions have been converted into actual
    # dash parameters..
    foreach my $pass_count ( 0 .. $max_passes ) {
        my @new_argv     = ();
        my $abbrev_count = 0;

        # loop over each item in @ARGV..
        foreach my $word (@ARGV) {

            # convert any leading 'no-' to just 'no'
            if ( $word =~ /^(-[-]?no)-(.*)/ ) { $word = $1 . $2 }

            # if it is a dash flag (instead of a file name)..
            if ( $word =~ /^-[-]?([\w\-]+)(.*)/ ) {

                my $abr   = $1;
                my $flags = $2;

                # save the raw input for debug output in case of circular refs
                if ( $pass_count == 0 ) {
                    push( @{$rraw_options}, $word );
                }

                # recombine abbreviation and flag, if necessary,
                # to allow abbreviations with arguments such as '-vt=1'
                if ( $rexpansion->{ $abr . $flags } ) {
                    $abr   = $abr . $flags;
                    $flags = "";
                }

                # if we see this dash item in the expansion hash..
                if ( $rexpansion->{$abr} ) {
                    $abbrev_count++;

                    # stuff all of the words that it expands to into the
                    # new arg list for the next pass
                    foreach my $abbrev ( @{ $rexpansion->{$abr} } ) {
                        next unless $abbrev;    # for safety; shouldn't happen
                        push( @new_argv, '--' . $abbrev . $flags );
                    }
                }

                # not in expansion hash, must be actual long name
                else {
                    push( @new_argv, $word );
                }
            }

            # not a dash item, so just save it for the next pass
            else {
                push( @new_argv, $word );
            }
        }    # end of this pass

        # update parameter list @ARGV to the new one
        @ARGV = @new_argv;
        last unless ( $abbrev_count > 0 );

        # make sure we are not in an infinite loop
        if ( $pass_count == $max_passes ) {
            local $" = ')(';
            Warn(<<EOM);
I'm tired. We seem to be in an infinite loop trying to expand aliases.
Here are the raw options;
(rraw_options)
EOM
            my $num = @new_argv;
            if ( $num < 50 ) {
                Warn(<<EOM);
After $max_passes passes here is ARGV
(@new_argv)
EOM
            }
            else {
                Warn(<<EOM);
After $max_passes passes ARGV has $num entries
EOM
            }

            if ($config_file) {
                Die(<<"DIE");
Please check your configuration file $config_file for circular-references. 
To deactivate it, use -npro.
DIE
            }
            else {
                Die(<<'DIE');
Program bug - circular-references in the %expansion hash, probably due to
a recent program change.
DIE
            }
        }    # end of check for circular references
    }    # end of loop over all passes
    return;
}

# Debug routine -- this will dump the expansion hash
sub dump_short_names {
    my $rexpansion = shift;
    print STDOUT <<EOM;
List of short names.  This list shows how all abbreviations are
translated into other abbreviations and, eventually, into long names.
New abbreviations may be defined in a .perltidyrc file.  
For a list of all long names, use perltidy --dump-long-names (-dln).
--------------------------------------------------------------------------
EOM
    foreach my $abbrev ( sort keys %$rexpansion ) {
        my @list = @{ $rexpansion->{$abbrev} };
        print STDOUT "$abbrev --> @list\n";
    }
    return;
}

sub check_vms_filename {

    # given a valid filename (the perltidy input file)
    # create a modified filename and separator character
    # suitable for VMS.
    #
    # Contributed by Michael Cartmell
    #
    my $filename = shift;
    my ( $base, $path ) = fileparse($filename);

    # remove explicit ; version
    $base =~ s/;-?\d*$//

      # remove explicit . version ie two dots in filename NB ^ escapes a dot
      or $base =~ s/(          # begin capture $1
                  (?:^|[^^])\. # match a dot not preceded by a caret
                  (?:          # followed by nothing
                    |          # or
                    .*[^^]     # anything ending in a non caret
                  )
                )              # end capture $1
                \.-?\d*$       # match . version number
              /$1/x;

    # normalise filename, if there are no unescaped dots then append one
    $base .= '.' unless $base =~ /(?:^|[^^])\./;

    # if we don't already have an extension then we just append the extension
    my $separator = ( $base =~ /\.$/ ) ? "" : "_";
    return ( $path . $base, $separator );
}

sub Win_OS_Type {

    # TODO: are these more standard names?
    # Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003

    # Returns a string that determines what MS OS we are on.
    # Returns win32s,95,98,Me,NT3.51,NT4,2000,XP/.Net,Win2003
    # Returns blank string if not an MS system.
    # Original code contributed by: Yves Orton
    # We need to know this to decide where to look for config files

    my $rpending_complaint = shift;
    my $os                 = "";
    return $os unless $^O =~ /win32|dos/i;    # is it a MS box?

    # Systems built from Perl source may not have Win32.pm
    # But probably have Win32::GetOSVersion() anyway so the
    # following line is not 'required':
    # return $os unless eval('require Win32');

    # Use the standard API call to determine the version
    my ( $undef, $major, $minor, $build, $id );
    eval { ( $undef, $major, $minor, $build, $id ) = Win32::GetOSVersion() };

    #
    #    NAME                   ID   MAJOR  MINOR
    #    Windows NT 4           2      4       0
    #    Windows 2000           2      5       0
    #    Windows XP             2      5       1
    #    Windows Server 2003    2      5       2

    return "win32s" unless $id;    # If id==0 then its a win32s box.
    $os = {                        # Magic numbers from MSDN
                                   # documentation of GetOSVersion
        1 => {
            0  => "95",
            10 => "98",
            90 => "Me"
        },
        2 => {
            0  => "2000",          # or NT 4, see below
            1  => "XP/.Net",
            2  => "Win2003",
            51 => "NT3.51"
        }
    }->{$id}->{$minor};

    # If $os is undefined, the above code is out of date.  Suggested updates
    # are welcome.
    unless ( defined $os ) {
        $os = "";

        # Deactivated this message 20180322 because it was needlessly
        # causing some test scripts to fail.  Need help from someone
        # with expertise in Windows to decide what is possible with windows.
        ${$rpending_complaint} .= <<EOS if (0);
Error trying to discover Win_OS_Type: $id:$major:$minor Has no name of record!
We won't be able to look for a system-wide config file.
EOS
    }

    # Unfortunately the logic used for the various versions isn't so clever..
    # so we have to handle an outside case.
    return ( $os eq "2000" && $major != 5 ) ? "NT4" : $os;
}

sub is_unix {
    return
         ( $^O !~ /win32|dos/i )
      && ( $^O ne 'VMS' )
      && ( $^O ne 'OS2' )
      && ( $^O ne 'MacOS' );
}

sub look_for_Windows {

    # determine Windows sub-type and location of
    # system-wide configuration files
    my $rpending_complaint = shift;
    my $is_Windows         = ( $^O =~ /win32|dos/i );
    my $Windows_type;
    $Windows_type = Win_OS_Type($rpending_complaint) if $is_Windows;
    return ( $is_Windows, $Windows_type );
}

sub find_config_file {

    # look for a .perltidyrc configuration file
    # For Windows also look for a file named perltidy.ini
    my ( $is_Windows, $Windows_type, $rconfig_file_chatter,
        $rpending_complaint ) = @_;

    ${$rconfig_file_chatter} .= "# Config file search...system reported as:";
    if ($is_Windows) {
        ${$rconfig_file_chatter} .= "Windows $Windows_type\n";
    }
    else {
        ${$rconfig_file_chatter} .= " $^O\n";
    }

    # sub to check file existence and record all tests
    my $exists_config_file = sub {
        my $config_file = shift;
        return 0 unless $config_file;
        ${$rconfig_file_chatter} .= "# Testing: $config_file\n";
        return -f $config_file;
    };

    # Sub to search upward for config file
    my $resolve_config_file = sub {

        # resolve <dir>/.../<file>, meaning look upwards from directory
        my $config_file = shift;
        if ($config_file) {
            if ( my ( $start_dir, $search_file ) =
                ( $config_file =~ m{^(.*)\.\.\./(.*)$} ) )
            {
                ${$rconfig_file_chatter} .=
                  "# Searching Upward: $config_file\n";
                $start_dir = '.' if !$start_dir;
                $start_dir = Cwd::realpath($start_dir);
                if ( my $found_file =
                    find_file_upwards( $start_dir, $search_file ) )
                {
                    $config_file = $found_file;
                    ${$rconfig_file_chatter} .= "# Found: $config_file\n";
                }
            }
        }
        return $config_file;
    };

    my $config_file;

    # look in current directory first
    $config_file = ".perltidyrc";
    return $config_file if $exists_config_file->($config_file);
    if ($is_Windows) {
        $config_file = "perltidy.ini";
        return $config_file if $exists_config_file->($config_file);
    }

    # Default environment vars.
    my @envs = qw(PERLTIDY HOME);

    # Check the NT/2k/XP locations, first a local machine def, then a
    # network def
    push @envs, qw(USERPROFILE HOMESHARE) if $^O =~ /win32/i;

    # Now go through the environment ...
    foreach my $var (@envs) {
        ${$rconfig_file_chatter} .= "# Examining: \$ENV{$var}";
        if ( defined( $ENV{$var} ) ) {
            ${$rconfig_file_chatter} .= " = $ENV{$var}\n";

            # test ENV{ PERLTIDY } as file:
            if ( $var eq 'PERLTIDY' ) {
                $config_file = "$ENV{$var}";
                $config_file = $resolve_config_file->($config_file);
                return $config_file if $exists_config_file->($config_file);
            }

            # test ENV as directory:
            $config_file = catfile( $ENV{$var}, ".perltidyrc" );
            $config_file = $resolve_config_file->($config_file);
            return $config_file if $exists_config_file->($config_file);

            if ($is_Windows) {
                $config_file = catfile( $ENV{$var}, "perltidy.ini" );
                $config_file = $resolve_config_file->($config_file);
                return $config_file if $exists_config_file->($config_file);
            }
        }
        else {
            ${$rconfig_file_chatter} .= "\n";
        }
    }

    # then look for a system-wide definition
    # where to look varies with OS
    if ($is_Windows) {

        if ($Windows_type) {
            my ( $os, $system, $allusers ) =
              Win_Config_Locs( $rpending_complaint, $Windows_type );

            # Check All Users directory, if there is one.
            # i.e. C:\Documents and Settings\User\perltidy.ini
            if ($allusers) {

                $config_file = catfile( $allusers, ".perltidyrc" );
                return $config_file if $exists_config_file->($config_file);

                $config_file = catfile( $allusers, "perltidy.ini" );
                return $config_file if $exists_config_file->($config_file);
            }

            # Check system directory.
            # retain old code in case someone has been able to create
            # a file with a leading period.
            $config_file = catfile( $system, ".perltidyrc" );
            return $config_file if $exists_config_file->($config_file);

            $config_file = catfile( $system, "perltidy.ini" );
            return $config_file if $exists_config_file->($config_file);
        }
    }

    # Place to add customization code for other systems
    elsif ( $^O eq 'OS2' ) {
    }
    elsif ( $^O eq 'MacOS' ) {
    }
    elsif ( $^O eq 'VMS' ) {
    }

    # Assume some kind of Unix
    else {

        $config_file = "/usr/local/etc/perltidyrc";
        return $config_file if $exists_config_file->($config_file);

        $config_file = "/etc/perltidyrc";
        return $config_file if $exists_config_file->($config_file);
    }

    # Couldn't find a config file
    return;
}

sub Win_Config_Locs {

    # In scalar context returns the OS name (95 98 ME NT3.51 NT4 2000 XP),
    # or undef if its not a win32 OS.  In list context returns OS, System
    # Directory, and All Users Directory.  All Users will be empty on a
    # 9x/Me box.  Contributed by: Yves Orton.

    # Original coding:
    # my $rpending_complaint = shift;
    # my $os = (@_) ? shift : Win_OS_Type();

    my ( $rpending_complaint, $os ) = @_;
    if ( !$os ) { $os = Win_OS_Type(); }

    return unless $os;

    my $system   = "";
    my $allusers = "";

    if ( $os =~ /9[58]|Me/ ) {
        $system = "C:/Windows";
    }
    elsif ( $os =~ /NT|XP|200?/ ) {
        $system = ( $os =~ /XP/ ) ? "C:/Windows/" : "C:/WinNT/";
        $allusers =
          ( $os =~ /NT/ )
          ? "C:/WinNT/profiles/All Users/"
          : "C:/Documents and Settings/All Users/";
    }
    else {

        # This currently would only happen on a win32s computer.  I don't have
        # one to test, so I am unsure how to proceed.  Suggestions welcome!
        ${$rpending_complaint} .=
"I dont know a sensible place to look for config files on an $os system.\n";
        return;
    }
    return wantarray ? ( $os, $system, $allusers ) : $os;
}

sub dump_config_file {
    my ( $fh, $config_file, $rconfig_file_chatter ) = @_;
    print STDOUT "$$rconfig_file_chatter";
    if ($fh) {
        print STDOUT "# Dump of file: '$config_file'\n";
        while ( my $line = $fh->getline() ) { print STDOUT $line }
        eval { $fh->close() };
    }
    else {
        print STDOUT "# ...no config file found\n";
    }
    return;
}

sub read_config_file {

    my ( $fh, $config_file, $rexpansion ) = @_;
    my @config_list = ();

    # file is bad if non-empty $death_message is returned
    my $death_message = "";

    my $name = undef;
    my $line_no;
    my $opening_brace_line;
    while ( my $line = $fh->getline() ) {
        $line_no++;
        chomp $line;
        ( $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;

        my $body = $line;

        # Look for complete or partial abbreviation definition of the form
        #     name { body }   or  name {   or    name { body
        # See rules in perltidy's perldoc page
        # Section: Other Controls - Creating a new abbreviation
        if ( $line =~ /^((\w+)\s*\{)(.*)?$/ ) {
            my $oldname = $name;
            ( $name, $body ) = ( $2, $3 );

            # Cannot start new abbreviation unless old abbreviation is complete
            last if ($opening_brace_line);

            $opening_brace_line = $line_no unless ( $body && $body =~ s/\}$// );

            # handle a new alias definition
            if ( ${$rexpansion}{$name} ) {
                local $" = ')(';
                my @names = sort keys %$rexpansion;
                $death_message =
                    "Here is a list of all installed aliases\n(@names)\n"
                  . "Attempting to redefine alias ($name) in config file $config_file line $.\n";
                last;
            }
            ${$rexpansion}{$name} = [];
        }

        # leading opening braces not allowed
        elsif ( $line =~ /^{/ ) {
            $opening_brace_line = undef;
            $death_message =
              "Unexpected '{' at line $line_no in config file '$config_file'\n";
            last;
        }

        # Look for abbreviation closing:    body }   or    }
        elsif ( $line =~ /^(.*)?\}$/ ) {
            $body = $1;
            if ($opening_brace_line) {
                $opening_brace_line = undef;
            }
            else {
                $death_message =
"Unexpected '}' at line $line_no in config file '$config_file'\n";
                last;
            }
        }

        # Now store any parameters
        if ($body) {

            my ( $rbody_parts, $msg ) = parse_args($body);
            if ($msg) {
                $death_message = <<EOM;
Error reading file '$config_file' at line number $line_no.
$msg
Please fix this line or use -npro to avoid reading this file
EOM
                last;
            }

            if ($name) {

                # remove leading dashes if this is an alias
                foreach ( @{$rbody_parts} ) { s/^\-+//; }
                push @{ ${$rexpansion}{$name} }, @{$rbody_parts};
            }
            else {
                push( @config_list, @{$rbody_parts} );
            }
        }
    }

    if ($opening_brace_line) {
        $death_message =
"Didn't see a '}' to match the '{' at line $opening_brace_line in config file '$config_file'\n";
    }
    eval { $fh->close() };
    return ( \@config_list, $death_message );
}

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 );
    }

    # handle case of no quotes
    elsif ( $instr !~ /['"]/ ) {

        # 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 );
    }

    # handle comments and quotes
    my $outstr     = "";
    my $quote_char = "";
    while (1) {

        # looking for ending quote character
        if ($quote_char) {
            if ( $instr =~ /\G($quote_char)/gc ) {
                $quote_char = "";
                $outstr .= $1;
            }
            elsif ( $instr =~ /\G(.)/gc ) {
                $outstr .= $1;
            }

            # error..we reached the end without seeing the ending quote char
            else {
                $msg = <<EOM;
Error reading file $config_file at line number $line_no.
Did not see ending quote character <$quote_char> in this text:
$instr
Please fix this line or use -npro to avoid reading this file
EOM
                last;
            }
        }

        # accumulating characters and looking for start of a quoted string
        else {
            if ( $instr =~ /\G([\"\'])/gc ) {
                $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;
            }
            elsif ( $instr =~ /\G(.)/gc ) {
                $outstr .= $1;
            }
            else {
                last;
            }
        }
    }
    return ( $outstr, $msg );
}

sub parse_args {

    # Parse a command string containing multiple string with possible
    # quotes, into individual commands.  It might look like this, for example:
    #
    #    -wba=" + - "  -some-thing -wbb='. && ||'
    #
    # There is no need, at present, to handle escaped quote characters.
    # (They are not perltidy tokens, so needn't be in strings).

    my ($body)     = @_;
    my @body_parts = ();
    my $quote_char = "";
    my $part       = "";
    my $msg        = "";
    while (1) {

        # looking for ending quote character
        if ($quote_char) {
            if ( $body =~ /\G($quote_char)/gc ) {
                $quote_char = "";
            }
            elsif ( $body =~ /\G(.)/gc ) {
                $part .= $1;
            }

            # error..we reached the end without seeing the ending quote char
            else {
                if ( length($part) ) { push @body_parts, $part; }
                $msg = <<EOM;
Did not see ending quote character <$quote_char> in this text:
$body
EOM
                last;
            }
        }

        # accumulating characters and looking for start of a quoted string
        else {
            if ( $body =~ /\G([\"\'])/gc ) {
                $quote_char = $1;
            }
            elsif ( $body =~ /\G(\s+)/gc ) {
                if ( length($part) ) { push @body_parts, $part; }
                $part = "";
            }
            elsif ( $body =~ /\G(.)/gc ) {
                $part .= $1;
            }
            else {
                if ( length($part) ) { push @body_parts, $part; }
                last;
            }
        }
    }
    return ( \@body_parts, $msg );
}

sub dump_long_names {

    my @names = @_;
    print STDOUT <<EOM;
# Command line long names (passed to GetOptions)
#---------------------------------------------------------------
# here is a summary of the Getopt codes:
# <none> does not take an argument
# =s takes a mandatory string
# :s takes an optional string
# =i takes a mandatory integer
# :i takes an optional integer
# ! does not take an argument and may be negated
#  i.e., -foo and -nofoo are allowed
# a double dash signals the end of the options list
#
#---------------------------------------------------------------
EOM

    foreach my $name ( sort @names ) { print STDOUT "$name\n" }
    return;
}

sub dump_defaults {
    my @defaults = @_;
    print STDOUT "Default command line options:\n";
    foreach my $line ( sort @defaults ) { print STDOUT "$line\n" }
    return;
}

sub readable_options {

    # return options for this run as a string which could be
    # put in a perltidyrc file
    my ( $rOpts, $roption_string ) = @_;
    my %Getopt_flags;
    my $rGetopt_flags    = \%Getopt_flags;
    my $readable_options = "# Final parameter set for this run.\n";
    $readable_options .=
      "# See utility 'perltidyrc_dump.pl' for nicer formatting.\n";
    foreach my $opt ( @{$roption_string} ) {
        my $flag = "";
        if ( $opt =~ /(.*)(!|=.*)$/ ) {
            $opt  = $1;
            $flag = $2;
        }
        if ( defined( $rOpts->{$opt} ) ) {
            $rGetopt_flags->{$opt} = $flag;
        }
    }
    foreach my $key ( sort keys %{$rOpts} ) {
        my $flag   = $rGetopt_flags->{$key};
        my $value  = $rOpts->{$key};
        my $prefix = '--';
        my $suffix = "";
        if ($flag) {
            if ( $flag =~ /^=/ ) {
                if ( $value !~ /^\d+$/ ) { $value = '"' . $value . '"' }
                $suffix = "=" . $value;
            }
            elsif ( $flag =~ /^!/ ) {
                $prefix .= "no" unless ($value);
            }
            else {

                # shouldn't happen
                $readable_options .=
                  "# ERROR in dump_options: unrecognized flag $flag for $key\n";
            }
        }
        $readable_options .= $prefix . $key . $suffix . "\n";
    }
    return $readable_options;
}

sub show_version {
    print STDOUT <<"EOM";
This is perltidy, v$VERSION 

Copyright 2000-2019, 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.

Complete documentation for perltidy can be found using 'man perltidy'
or on the internet at http://perltidy.sourceforge.net.
EOM
    return;
}

sub usage {

    print STDOUT <<EOF;
This is perltidy version $VERSION, a perl script indenter.  Usage:

    perltidy [ options ] file1 file2 file3 ...
            (output goes to file1.tdy, file2.tdy, file3.tdy, ...)
    perltidy [ options ] file1 -o outfile
    perltidy [ options ] file1 -st >outfile
    perltidy [ options ] <infile >outfile

Options have short and long forms. Short forms are shown; see
man pages for long forms.  Note: '=s' indicates a required string,
and '=n' indicates a required integer.

I/O control
 -h      show this help
 -o=file name of the output file (only if single input file)
 -oext=s change output extension from 'tdy' to s
 -opath=path  change path to be 'path' for output files
 -b      backup original to .bak and modify file in-place
 -bext=s change default backup extension from 'bak' to s
 -q      deactivate error messages (for running under editor)
 -w      include non-critical warning messages in the .ERR error output
 -syn    run perl -c to check syntax (default under unix systems)
 -log    save .LOG file, which has useful diagnostics
 -f      force perltidy to read a binary file
 -g      like -log but writes more detailed .LOG file, for debugging scripts
 -opt    write the set of options actually used to a .LOG file
 -npro   ignore .perltidyrc configuration command file 
 -pro=file   read configuration commands from file instead of .perltidyrc 
 -st     send output to standard output, STDOUT
 -se     send all error output to standard error output, STDERR
 -v      display version number to standard output and quit

Basic Options:
 -i=n    use n columns per indentation level (default n=4)
 -t      tabs: use one tab character per indentation level, not recommended
 -nt     no tabs: use n spaces per indentation level (default)
 -et=n   entab leading whitespace n spaces per tab; not recommended
 -io     "indent only": just do indentation, no other formatting.
 -sil=n  set starting indentation level to n;  use if auto detection fails
 -ole=s  specify output line ending (s=dos or win, mac, unix)
 -ple    keep output line endings same as input (input must be filename)

Whitespace Control
 -fws    freeze whitespace; this disables all whitespace changes
           and disables the following switches:
 -bt=n   sets brace tightness,  n= (0 = loose, 1=default, 2 = tight)
 -bbt    same as -bt but for code block braces; same as -bt if not given
 -bbvt   block braces vertically tight; use with -bl or -bli
 -bbvtl=s  make -bbvt to apply to selected list of block types
 -pt=n   paren tightness (n=0, 1 or 2)
 -sbt=n  square bracket tightness (n=0, 1, or 2)
 -bvt=n  brace vertical tightness, 
         n=(0=open, 1=close unless multiple steps on a line, 2=always close)
 -pvt=n  paren vertical tightness (see -bvt for n)
 -sbvt=n square bracket vertical tightness (see -bvt for n)
 -bvtc=n closing brace vertical tightness: 
         n=(0=open, 1=sometimes close, 2=always close)
 -pvtc=n closing paren vertical tightness, see -bvtc for n.
 -sbvtc=n closing square bracket vertical tightness, see -bvtc for n.
 -ci=n   sets continuation indentation=n,  default is n=2 spaces
 -lp     line up parentheses, brackets, and non-BLOCK braces
 -sfs    add space before semicolon in for( ; ; )
 -aws    allow perltidy to add whitespace (default)
 -dws    delete all old non-essential whitespace 
 -icb    indent closing brace of a code block
 -cti=n  closing indentation of paren, square bracket, or non-block brace: 
         n=0 none, =1 align with opening, =2 one full indentation level
 -icp    equivalent to -cti=2
 -wls=s  want space left of tokens in string; i.e. -nwls='+ - * /'
 -wrs=s  want space right of tokens in string;
 -sts    put space before terminal semicolon of a statement
 -sak=s  put space between keywords given in s and '(';
 -nsak=s no space between keywords in s and '('; i.e. -nsak='my our local'

Line Break Control
 -fnl    freeze newlines; this disables all line break changes
            and disables the following switches:
 -anl    add newlines;  ok to introduce new line breaks
 -bbs    add blank line before subs and packages
 -bbc    add blank line before block comments
 -bbb    add blank line between major blocks
 -kbl=n  keep old blank lines? 0=no, 1=some, 2=all
 -mbl=n  maximum consecutive blank lines to output (default=1)
 -ce     cuddled else; use this style: '} else {'
 -cb     cuddled blocks (other than 'if-elsif-else')
 -cbl=s  list of blocks to cuddled, default 'try-catch-finally'
 -dnl    delete old newlines (default)
 -l=n    maximum line length;  default n=80
 -bl     opening brace on new line 
 -sbl    opening sub brace on new line.  value of -bl is used if not given.
 -bli    opening brace on new line and indented
 -bar    opening brace always on right, even for long clauses
 -vt=n   vertical tightness (requires -lp); n controls break after opening
         token: 0=never  1=no break if next line balanced   2=no break
 -vtc=n  vertical tightness of closing container; n controls if closing
         token starts new line: 0=always  1=not unless list  1=never
 -wba=s  want break after tokens in string; i.e. wba=': .'
 -wbb=s  want break before tokens in string
 -wn     weld nested: combines opening and closing tokens when both are adjacent

Following Old Breakpoints
 -kis    keep interior semicolons.  Allows multiple statements per line.
 -boc    break at old comma breaks: turns off all automatic list formatting
 -bol    break at old logical breakpoints: or, and, ||, && (default)
 -bom    break at old method call breakpoints: ->
 -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
         n=2 break only if a one-line container cannot be formed
         n=3 do not treat commas after => specially at all

Comment controls
 -ibc    indent block comments (default)
 -isbc   indent spaced block comments; may indent unless no leading space
 -msc=n  minimum desired spaces to side comment, default 4
 -fpsc=n fix position for side comments; default 0;
 -csc    add or update closing side comments after closing BLOCK brace
 -dcsc   delete closing side comments created by a -csc command
 -cscp=s change closing side comment prefix to be other than '## end'
 -cscl=s change closing side comment to apply to selected list of blocks
 -csci=n minimum number of lines needed to apply a -csc tag, default n=6
 -csct=n maximum number of columns of appended text, default n=20 
 -cscw   causes warning if old side comment is overwritten with -csc

 -sbc    use 'static block comments' identified by leading '##' (default)
 -sbcp=s change static block comment identifier to be other than '##'
 -osbc   outdent static block comments

 -ssc    use 'static side comments' identified by leading '##' (default)
 -sscp=s change static side comment identifier to be other than '##'

Delete selected text
 -dac    delete all comments AND pod
 -dbc    delete block comments     
 -dsc    delete side comments  
 -dp     delete pod

Send selected text to a '.TEE' file
 -tac    tee all comments AND pod
 -tbc    tee block comments       
 -tsc    tee side comments       
 -tp     tee pod           

Outdenting
 -olq    outdent long quoted strings (default) 
 -olc    outdent a long block comment line
 -ola    outdent statement labels
 -okw    outdent control keywords (redo, next, last, goto, return)
 -okwl=s specify alternative keywords for -okw command

Other controls
 -mft=n  maximum fields per table; default n=40
 -x      do not format lines before hash-bang line (i.e., for VMS)
 -asc    allows perltidy to add a ';' when missing (default)
 -dsm    allows perltidy to delete an unnecessary ';'  (default)

Combinations of other parameters
 -gnu     attempt to follow GNU Coding Standards as applied to perl
 -mangle  remove as many newlines as possible (but keep comments and pods)
 -extrude  insert as many newlines as possible

Dump and die, debugging
 -dop    dump options used in this run to standard output and quit
 -ddf    dump default options to standard output and quit
 -dsn    dump all option short names to standard output and quit
 -dln    dump option long names to standard output and quit
 -dpro   dump whatever configuration file is in effect to standard output
 -dtt    dump all token types to standard output and quit

HTML
 -html write an html file (see 'man perl2web' for many options)
       Note: when -html is used, no indentation or formatting are done.
       Hint: try perltidy -html -css=mystyle.css filename.pl
       and edit mystyle.css to change the appearance of filename.html.
       -nnn gives line numbers
       -pre only writes out <pre>..</pre> code section
       -toc places a table of contents to subs at the top (default)
       -pod passes pod text through pod2html (default)
       -frm write html as a frame (3 files)
       -text=s extra extension for table of contents if -frm, default='toc'
       -sext=s extra extension for file content if -frm, default='src'

A prefix of "n" negates short form toggle switches, and a prefix of "no"
negates the long forms.  For example, -nasc means don't add missing
semicolons.  

If you are unable to see this entire text, try "perltidy -h | more"
For more detailed information, and additional options, try "man perltidy",
or go to the perltidy home page at http://perltidy.sourceforge.net
EOF

    return;
}

sub process_this_file {

    my ( $tokenizer, $formatter ) = @_;

    while ( my $line = $tokenizer->get_line() ) {
        $formatter->write_line($line);
    }
    my $severe_error = $tokenizer->report_tokenization_errors();
    eval { $formatter->finish_formatting($severe_error) };

    return;
}

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, ($istream, $ostream),
    # we do the following:
    # - check syntax of the input file
    # - if bad, all done (could be an incomplete code snippet)
    # - if infile syntax ok, then check syntax of the output file;
    #   - 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 ( $istream, $ostream, $logger_object, $rOpts ) = @_;
    my $infile_syntax_ok = 0;
    my $line_of_dashes   = '-' x 42 . "\n";

    my $flags = $rOpts->{'perl-syntax-check-flags'};

    # be sure we invoke perl with -c
    # note: perl will accept repeated flags like '-c -c'.  It is safest
    # to append another -c than try to find an interior bundled c, as
    # in -Tc, because such a 'c' might be in a quoted string, for example.
    if ( $flags !~ /(^-c|\s+-c)/ ) { $flags .= " -c" }

    # be sure we invoke perl with -x if requested
    # same comments about repeated parameters applies
    if ( $rOpts->{'look-for-hash-bang'} ) {
        if ( $flags !~ /(^-x|\s+-x)/ ) { $flags .= " -x" }
    }

    # this shouldn't happen unless a temporary file couldn't be made
    if ( $istream eq '-' ) {
        $logger_object->write_logfile_entry(
            "Cannot run perl -c on STDIN and STDOUT\n");
        return $infile_syntax_ok;
    }

    $logger_object->write_logfile_entry(
        "checking input file syntax with perl $flags\n");

    # Not all operating systems/shells support redirection of the standard
    # error output.
    my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1';

    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/ ) {
        $infile_syntax_ok = 1;
        $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);
        $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 $ostream !\n"
            );
            $logger_object->warning(
                "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
            $logger_object->write_logfile_entry( $^V . "\n" );
        }
    }
    else {

        # 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\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);
        $infile_syntax_ok = -1;
        $logger_object->write_logfile_entry($line_of_dashes);
        $logger_object->write_logfile_entry(
"The output file will not be checked because of input file problems\n"
        );
    }
    return $infile_syntax_ok;
}

sub do_syntax_check {

    # This should not be called; the syntax check is deactivated
    Die("Unexpected call for syntax check-shouldn't happen\n");
    return;
}

1;