File Coverage

blib/lib/PerlTidy/Run.pm

Criterion	Covered	Total	%
statement	40	55	72.7
branch	6	10	60.0
condition	4	6	66.6
subroutine	8	10	80.0
pod	0	3	0.0
total	58	84	69.0

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;