Plack-App-MCCS
view release on metacpan or search on metacpan
local/lib/perl5/Perl/Tidy.pm view on Meta::CPAN
# opt_encoding => value of -enc flag: 'utf8', 'none', or 'guess'
# opt_encode_output => value of -eos flag: 'eos' or 'neos'
# opt_max_iterations => value of --iterations=n
# file_count => number of files processed in this call
# If multiple files are processed, then the following values will be for
# the last file only:
# input_name => name of the input stream
# output_name => name of the output stream
# The following two variables refer to Perl's two internal string modes,
# and have the values 0 for 'byte' mode and 1 for 'char' mode:
# char_mode_source => true if source is in 'char' mode. Will be false
# unless we received a source string ref with utf8::is_utf8() set.
# char_mode_used => true if text processed by perltidy in 'char' mode.
# Normally true for text identified as utf8, otherwise false.
# This tells if Unicode::GCString was used
# gcs_used => true if -gcs and Unicode::GCString found & used
# These variables tell what utf8 decoding/encoding was done:
# input_decoded_as => non-blank if perltidy decoded the source text
# output_encoded_as => non-blank if perltidy encoded before return
# These variables are related to iterations and convergence testing:
# iteration_count => number of iterations done
# ( can be from 1 to opt_max_iterations )
# converged => true if stopped on convergence
# ( can only happen if opt_max_iterations > 1 )
# blinking => true if stopped on blinking states
# ( i.e., unstable formatting, should not happen )
$rstatus = {
file_count => 0,
opt_format => EMPTY_STRING,
opt_encoding => EMPTY_STRING,
opt_encode_output => EMPTY_STRING,
opt_max_iterations => EMPTY_STRING,
input_name => EMPTY_STRING,
output_name => EMPTY_STRING,
char_mode_source => 0,
char_mode_used => 0,
input_decoded_as => EMPTY_STRING,
output_encoded_as => EMPTY_STRING,
gcs_used => 0,
iteration_count => 0,
converged => 0,
blinking => 0,
};
# Fix for issue git #57
$Warn_count = 0;
# don't overwrite callers ARGV
# Localization of @ARGV could be avoided by calling GetOptionsFromArray
# instead of GetOptions, but that is not available before perl 5.10
local @ARGV = @ARGV;
local *STDERR = *STDERR;
if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
local $LIST_SEPARATOR = ')(';
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
}
}
local/lib/perl5/Perl/Tidy.pm view on Meta::CPAN
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);
}
} ## end sub process_command_line
# (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;
if ( eval { $glc = Getopt::Long::Configure(); 1 } ) {
my $ok = eval { Getopt::Long::ConfigDefaults(); 1 };
if ( !$ok && DEVEL_MODE ) {
Fault("Failed call to Getopt::Long::ConfigDefaults: $EVAL_ERROR\n");
}
}
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 @raw_options = ();
my $config_file = EMPTY_STRING;
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: $ERRNO\n");
$config_file = EMPTY_STRING;
}
}
local/lib/perl5/Perl/Tidy.pm view on Meta::CPAN
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} = EMPTY_STRING;
$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
dump-block-summary
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] ) };
( run in 2.325 seconds using v1.01-cache-2.11-cpan-5e09290becf )