package PerlTidy::Run; # all interactions with Perl::Tidy are via this module use strict; use warnings; use Data::Dumper; use Log::Log4perl qw(get_logger); use Perl::Tidy; use TidyView::Options; sub execute { my (undef, %args) = @_; my ($fileToTidy) = @args{qw(file)}; my $options = TidyView::Options->assembleOptions(separator => "\n"); my $resultString = ""; my $argv = ""; # prevent perltidy from seeing our @ARGV my $stderrCapture = ""; # possible error output here Perl::Tidy::perltidy( argv => \$argv, stderr => \$stderrCapture, perltidyrc => \$options, source => $fileToTidy, destination => \$resultString ); return wantarray ? split(/^/m, $resultString) : $resultString; } # get all the option names, types, ranges and defaults from Perl::Tidy, and place them various data structures # for PerlTidy::Options to work with from then on sub collectOptionStructures { my (undef, %args) = @_; #cant create a logger - this function is called in an INIT block, so no initialisation has occurred my ($nameType, $nameSection, $nameRange, $nameDefault, $sectionNameType, $sectionList) = @args{qw(types sections ranges defaults sectionNameType sectionList ) }; my $stderrCapture = ""; my $argv = ""; # get the option names, ranges, types and defaults from Perl::Tidy Perl::Tidy::perltidy( dump_getopt_flags => $nameType, # gives the option => type map dump_options_category => $nameSection, # gives the option => section map dump_options_range => $nameRange, # gives the option => range map dump_options => $nameDefault, # gives the option => default map dump_options_type => 'full', # get map for all options, not just parsed ones stderr => \$stderrCapture, argv => \$argv, ); die "error calling Perl::Tidy::perltidy :: $stderrCapture" if $stderrCapture; # extract the sections foreach my $name (keys %$nameSection) { # we need to ignore a few options for now - eventually these kind of policy decisions may be inside Perl::Tidy::perltidy() next if $name =~ m/^(?:entab-leading-whitespace | starting-indentation-level | output-line-ending | tabs | preserve-line-endings )/x; my $type; unless (exists $nameType->{$name}) { warn( "Unknown value type for option $name" ); } else { $type = $nameType->{$name}; } if (exists $nameRange->{$name} and defined $nameRange->{$name} and ref($nameRange->{$name}) =~ m/^ARRAY$/) { # replace with the more specific range type $sectionNameType->{$nameSection->{$name}}->{$name} = $nameRange->{$name}; } else { $sectionNameType->{$nameSection->{$name}}->{$name} = $type; } } { no warnings 'numeric'; # we take advantage of the fact that sections have the form "number. name" @$sectionList = sort {$a <=> $b} keys %$sectionNameType; } # delete from sections list as that appears inthe GUI, but dont delete from sectionNameType as we # use that to test if a parsed option is unsupported shift @$sectionList; # drop off first section "I/O control" pop @$sectionList; # drop off last section "Debugging" } # given a file handle, ask Perl::Tidy to parse the file and report on any problems sub parseConfig { my (undef, %args) = @_; my ($fileHandle, $destination, ) = @args{qw(handle destination)}; my $stderrCapture = ""; # try to capture error messages my $argv = ""; # do not let perltidy see our @ARGV Perl::Tidy::perltidy( perltidyrc => $fileHandle, dump_options => $destination, stderr => \$stderrCapture, argv => \$argv, ); return $stderrCapture; } 1;