From 228fdedc54dab886d18146db512c606987740b1c Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 1 May 2020 07:44:28 -0700 Subject: [PATCH] allow a module call to capture any .DEBUG stream and .TEE stream --- lib/Perl/Tidy.pm | 30 ++++++++++++++-- lib/Perl/Tidy.pod | 14 ++++++++ t/atee.t | 88 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 129 insertions(+), 3 deletions(-) create mode 100644 t/atee.t diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 8aebc8c9..bc2b1267 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3,7 +3,7 @@ # # perltidy - a perl script indenter and formatter # -# Copyright (c) 2000-2019 by Steve Hancock +# 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 @@ -358,6 +358,8 @@ sub perltidy { formatter => undef, logfile => undef, errorfile => undef, + teefile => undef, + debugfile => undef, perltidyrc => undef, source => undef, stderr => undef, @@ -412,6 +414,8 @@ EOM 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'}; @@ -802,6 +806,14 @@ EOM # 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 @@ -1143,6 +1155,7 @@ EOM # the 'sink_object' knows how to write the output file my $tee_file = $fileroot . $dot . "TEE"; + if ($teefile_stream) { $tee_file = $teefile_stream } my $line_separator = $rOpts->{'output-line-ending'}; if ( $rOpts->{'preserve-line-endings'} ) { @@ -1198,9 +1211,10 @@ EOM #--------------------------------------------------------------- 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( $fileroot . $dot . "DEBUG", - $is_encoded_data ); + Perl::Tidy::Debugger->new( $debug_file, $is_encoded_data ); } #--------------------------------------------------------------- @@ -1231,6 +1245,16 @@ EOM # source, not an intermediate result, and # (2) we need to know if there are errors so we can stop the # iterations early if necessary. + + # Programming note: ideally, we would also only save any .TEE file + # on iteration pass 1, but unfortunately the .TEE stream is + # combined in the sink object with the main output stream. The + # programming actually works as is, with the .TEE file being + # written and rewritten on each iteration. This even works if we + # are deleting comments or pod in the same run. But this + # complexity could cause future bugs so it would be best to + # eventually split the tee output into a completely separate stream + # to just save it on pass 1 and avoid this complexity. if ( $iter > 1 ) { $debugger_object = undef; $logger_object = undef; diff --git a/lib/Perl/Tidy.pod b/lib/Perl/Tidy.pod index 4107a011..803912a2 100644 --- a/lib/Perl/Tidy.pod +++ b/lib/Perl/Tidy.pod @@ -14,6 +14,8 @@ Perl::Tidy - Parses and beautifies perl source perltidyrc => $perltidyrc, logfile => $logfile, errorfile => $errorfile, + teefile => $teefile, + debugfile => $debugfile, formatter => $formatter, # callback object (see below) dump_options => $dump_options, dump_options_type => $dump_options_type, @@ -116,6 +118,18 @@ This stream is only created if requested with a B<-g> parameter. It contains detailed diagnostic information about a script which may be useful for debugging. +=item teefile + +The B parameter allows the calling program to capture the tee stream. +This stream is only created if requested with one of the 'tee' parameters, +a B<--tee-pod> , B<--tee-block-comments>, B<--tee-side-commnts>, or B<--tee-all-comments>. + +=item debugfile + +The B parameter allows the calling program to capture the stream +produced by the B<--DEBUG> parameter. This parameter is mainly used for +debugging perltidy itself. + =item argv If the B parameter is given, it will be used instead of the diff --git a/t/atee.t b/t/atee.t new file mode 100644 index 00000000..39d03598 --- /dev/null +++ b/t/atee.t @@ -0,0 +1,88 @@ +use strict; +use Test; +use Carp; +use Perl::Tidy; + +BEGIN { + plan tests => 2; +} + +my $sname = 'atee.t'; + +my $source = <<'EOM'; +# block comment +=pod +some pod +=cut + +print "hello world\n"; +$xx++; # side comment +EOM + + +my $expect = <<'EOM'; + +print "hello world\n"; +$xx++; +EOM + +my $teefile_expect = <<'EOM'; +# block comment +=pod +some pod +=cut +$xx++; # side comment +EOM + +# Test capturing the .LOG, .DEBUG, .TEE outputs to strings. +# In this test we delete all comments and pod in the test script and send them +# to a .TEE file also save .DEBUG and .LOG output +my $params = "-dac -tac -D -g"; + +# Verify correctness of the formatted output and the .TEE output +# (.DEBUG and .LOG have been verified to work but are not checked here because +# they may change over time, making work for maintaining this test file) + +my $output; +my $teefile; +my $debugfile; +my $stderr_string; +my $errorfile_string; +my $logfile_string; +my $debugfile_string; +my $err = Perl::Tidy::perltidy( + source => \$source, + destination => \$output, + perltidyrc => \$params, + argv => '', # for safety; hide any ARGV from perltidy + stderr => \$stderr_string, + errorfile => \$errorfile_string, # not used when -se flag is set + teefile => \$teefile, + debugfile => \$debugfile_string, + logfile => \$logfile_string, +); + +if ( $err || $stderr_string || $errorfile_string ) { + if ($err) { + print STDERR "This error received calling Perl::Tidy with '$sname'\n"; + ok( !$err ); + } + if ($stderr_string) { + print STDERR "---------------------\n"; + print STDERR "<>\n$stderr_string\n"; + print STDERR "---------------------\n"; + print STDERR "This error received calling Perl::Tidy with '$sname''\n"; + ok( !$stderr_string ); + } + if ($errorfile_string) { + print STDERR "---------------------\n"; + print STDERR "<<.ERR file>>\n$errorfile_string\n"; + print STDERR "---------------------\n"; + print STDERR "This error received calling Perl::Tidy with '$sname''\n"; + ok( !$errorfile_string ); + } +} +else { + ok( $output, $expect ); + ok( $teefile, $teefile_expect ); +} -- 2.39.5