allow a module call to capture any .DEBUG stream and .TEE stream

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 8aebc8c97e1ece526767588c76201722a322133f..bc2b12673446fac1044e3bebfba8e67a56324628 100644 (file)
--- 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 4107a0115c284a2836ba01a824ad28b3dfd55ef7..803912a2176b11cffb2ff2fa88e88cd7ca113fc1 100644 (file)
--- 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<teefile> 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<debugfile> 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<argv> parameter is given, it will be used instead of the

diff --git a/t/atee.t b/t/atee.t
new file mode 100644 (file)
index 0000000..39d0359
--- /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 "<<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 );
+}