Permalink
Browse files

replace pipe to ptee with pipe to Tee::App

  • Loading branch information...
xdg committed Dec 11, 2008
1 parent d483555 commit 9b846775a3ad37a63d2a4117d0c73c445bc8a022
Showing with 393 additions and 277 deletions.
  1. +4 −0 Changes
  2. +5 −5 MANIFEST
  3. +2 −8 Todo
  4. +20 −104 bin/ptee
  5. +44 −56 lib/Tee.pm
  6. +25 −22 lib/Tee.pod
  7. +155 −0 lib/Tee/App.pm
  8. +59 −0 lib/Tee/App.pod
  9. +78 −53 t/02_tee_script.t
  10. +1 −29 t/03_tee_function.t
View
@@ -2,6 +2,10 @@ Revision history for Perl module Tee
0.13_51
+ - moved guts of ptee to Tee::App; removed ptee seach logic from Tee.pm
+
+ - changed to the Apache License, version 2.0; (it's clearer, relicensable,
+ and is explicit about contributions)
0.13 Thu Aug 17 13:09:03 EDT 2006
- customize Makefile.PL for auto/Tee
View
@@ -4,15 +4,18 @@ Changes
inc/Module/Build/WikiDoc.pm
INSTALL
lib/Tee.pm
+lib/Tee.pod
+lib/Tee/App.pm
+lib/Tee/App.pod
LICENSE
+Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
+META.yml
README
t/01_Tee.t
t/02_tee_script.t
t/03_tee_function.t
-t/98_pod.t
-t/99_pod-coverage.t
t/Expected.pm
t/fatality.pl
t/helloworld.pl
@@ -23,6 +26,3 @@ xt/pod-coverage.t
xt/pod-format.t
xt/spelling.t
xt/stopwords.txt
-lib/Tee.pod
-Makefile.PL
-META.yml
View
10 Todo
@@ -1,9 +1,3 @@
-# Copyright (c) 2008 by David Golden. All rights reserved.
-# Licensed under Apache License, Version 2.0 (the "License").
-# You may not use this file except in compliance with the License.
-# A copy of the License was distributed with this file or you may obtain a
-# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+Todo for Tee
-- Write some code
-- Write some tests
-- Replace boilerplate docs with real documentation
+- nothing right now
View
124 bin/ptee
@@ -1,20 +1,17 @@
#!/usr/bin/perl
-
# ptee -- perl implementation of unix tee
+
$VERSION = '0.13_51';
use strict;
-use File::Basename qw/basename/;
-use Getopt::Long;
-use IO::File;
+use Tee::App qw/run/;
+run;
+
+__END__
=head1 NAME
ptee - emulate the GNU tee program with Perl
-=cut
-
-my $help_text = <<'=cut';
-
=head1 SYNOPSIS
ptee [OPTIONS]... [FILENAMES]...
@@ -30,65 +27,6 @@ my $help_text = <<'=cut';
--version or -V
print the version number of this program
-=cut
-
-$help_text =~ s/\A.+?( ptee.*)/$1/ms;
-
-#--------------------------------------------------------------------------#
-# process command line
-#--------------------------------------------------------------------------#
-
-my %opts;
-GetOptions( \%opts,
- 'version|V',
- 'help|h|?',
- 'append|a',
-);
-
-#--------------------------------------------------------------------------#
-# options
-#--------------------------------------------------------------------------#
-
-if ($opts{version}) {
- print basename($0), " $main::VERSION\n";
- exit 0;
-}
-
-if ($opts{help}) {
- print "Usage:\n$help_text";
- exit 1;
-}
-
-my $mode = $opts{append} ? ">>" : ">";
-
-#--------------------------------------------------------------------------#
-# Setup list of filehandles
-#--------------------------------------------------------------------------#
-
-my $stdout = IO::Handle->new->fdopen(fileno(STDOUT),"w");
-my @files = $stdout;
-
-for my $file ( @ARGV ) {
- my $f = IO::File->new("$mode $file")
- or die "Could't open '$file' for writing: $!'";
- push @files, $f;
-}
-
-#--------------------------------------------------------------------------#
-# Tee input to the filehandle list
-#--------------------------------------------------------------------------#
-
-my $buffer_size = 1024;
-my $buffer;
-
-while ( sysread( STDIN, $buffer, $buffer_size ) > 0 ) {
- for my $fh ( @files ) {
- syswrite $fh, $buffer;
- }
-}
-
-__END__
-
=head1 DESCRIPTION
C<ptee> is a pure Perl emulation of the standard GNU tool C<tee> and is
@@ -105,9 +43,8 @@ is not sufficiently portable.
=head1 BUGS
Please report any bugs or feature using the CPAN Request Tracker.
-Bugs can be submitted by email to C<bug-Tee@rt.cpan.org> or
-through the web interface at
-L<http:E<sol>E<sol>rt.cpan.orgE<sol>PublicE<sol>DistE<sol>Display.html?Name=Tee>
+Bugs can be submitted through the web interface at
+L<http://rt.cpan.org/Dist/Display.html?Queue=Tee>
When submitting a bug or request, please include a test-file or a patch to an
existing test-file that illustrates the bug or desired feature.
@@ -116,42 +53,21 @@ existing test-file that illustrates the bug or desired feature.
David A. Golden (DAGOLDEN)
-dagolden@cpan.org
-
-http:E<sol>E<sol>www.dagolden.orgE<sol>
-
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006 by David A. Golden
-
-This program is free software; you can redistribute
-it andE<sol>or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=head1 DISCLAIMER OF WARRANTY
-
-BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS ANDE<sol>OR OTHER PARTIES
-PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
-EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
-ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
-YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
-NECESSARY SERVICING, REPAIR, OR CORRECTION.
-
-IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY ANDE<sol>OR
-REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
-LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
-OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
-THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
+Copyright (c) 2006-2008 by David A. Golden. All rights reserved.
+Licensed under Apache License, Version 2.0 (the "License").
+You may not use this file except in compliance with the License.
+A copy of the License was distributed with this file or you may obtain a
+copy of the License from http:E<sol>E<sol>www.apache.orgE<sol>licensesE<sol>LICENSE-2.0
+Files produced as output though the use of this software, shall not be
+considered Derivative Works, but shall be considered the original work of the
+Licensor.
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.
View
@@ -1,57 +1,43 @@
-# Copyright (c) 2008 by David Golden. All rights reserved.
-# Licensed under Apache License, Version 2.0 (the "License").
-# You may not use this file except in compliance with the License.
-# A copy of the License was distributed with this file or you may obtain a
-# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
-
package Tee;
-use strict;
$Tee::VERSION = '0.13_51';
$Tee::VERSION = eval $Tee::VERSION; ## no critic
@Tee::ISA = qw (Exporter);
@Tee::EXPORT = qw (tee);
+use strict;
use Exporter ();
-use IO::File;
+use Probe::Perl;
+# use warnings; # only for Perl >= 5.6
+
+
+#--------------------------------------------------------------------------#
+# Platform independent ptee invocation
+#--------------------------------------------------------------------------#
+
+my $perl = Probe::Perl->find_perl_interpreter;
+my $ptee_cmd = "$perl -MTee::App -e run --";
+
+#--------------------------------------------------------------------------#
+# Functions
+#--------------------------------------------------------------------------#
sub tee {
my $command = shift;
my $options;
$options = shift if (ref $_[0] eq 'HASH');
-
- my $mode = $options->{append} ? ">>" : ">";
+ my $files = join(" ", @_);
my $redirect = $options->{stderr} ? " 2>&1 " : q{};
-
- my @files;
- for my $file ( @_ ) {
- my $f = IO::File->new("$mode $file")
- or die "Could't open '$file' for writing: $!'";
- push @files, $f;
- }
-
- local *COMMAND_FH;
- open COMMAND_FH, "$command $redirect |" or die;
- my $buffer;
- my $buffer_size = 1024;
- while ( sysread( COMMAND_FH, $buffer, $buffer_size ) > 0 ) {
- for my $fh ( *STDOUT, @files ) {
- syswrite $fh, $buffer;
- }
- }
-
- close COMMAND_FH; # to get $?
- my $status = $?;
- my $exit = $status ? 0 : 1;
-
- close for @files;
-
- return wantarray ? ($exit, $status) : $exit;
+ my $append = $options->{append} ? " -a " : q{};
+ system( "$command $redirect | $ptee_cmd $append $files" );
}
-1;
+1; # modules must be true
__END__
+#--------------------------------------------------------------------------#
+# main pod documentation
+#--------------------------------------------------------------------------#
=begin wikidoc
@@ -61,7 +47,7 @@ Tee - Pure Perl emulation of GNU tee
= VERSION
-This documentation describes version %%VERSION%%.
+This documentation refers to version %%VERSION%%
= SYNOPSIS
@@ -74,15 +60,17 @@ This documentation describes version %%VERSION%%.
= DESCRIPTION
-The {Tee} distribution provides a pure Perl emulation of the standard GNU tool
-{tee}. It is designed to be a platform-independent replacement for operating
-systems without a native {tee} program. As with {tee}, it passes input
-received on STDIN through to STDOUT while also writing a copy of the input to
-one or more files. By default, files will be overwritten.
+The {Tee} distribution provides the [ptee] program, a pure Perl emulation of
+the standard GNU tool {tee}. It is designed to be a platform-independent
+replacement for operating systems without a native {tee} program. As with
+{tee}, it passes input received on STDIN through to STDOUT while also writing a
+copy of the input to one or more files. By default, files will be overwritten.
-In addition to this module, the distribution also provides the [ptee] program
-for a command line replacement for {tee}. Unlike {tee}, {ptee} does not
-support ignoring interrupts, as signal handling is not sufficiently portable.
+Unlike {tee}, {ptee} does not support ignoring interrupts, as signal handling
+is not sufficiently portable.
+
+The {Tee} module provides a convenience function that may be used in place of
+{system()} to redirect commands through {ptee}.
= USAGE
@@ -91,10 +79,11 @@ support ignoring interrupts, as signal handling is not sufficiently portable.
tee( $command, @filenames );
tee( $command, \%options, @filenames );
-Executes the given command, teeing output to STDOUT and a list of files.
-Unlike with {system()}, the command must be a string as the command shell is
-used for redirection and piping. It returns true if the command has an exit
-status of zero and false otherwise. The exit status is preserved in {$?}.
+Executes the given command via {system()}, but pipes it through [ptee] to copy
+output to the list of files. Unlike with {system()}, the command must be a
+string as the command shell is used for redirection and piping. The return
+value of {system()} is passed through, but reflects the success of
+the {ptee} command, which isn't very useful.
The second argument may be a hash-reference of options. Recognized options
include:
@@ -111,6 +100,12 @@ portable alternative for capturing these streams from a command separately is
[IPC::Run3], though it does not allow passing it through to a terminal at the
same time.
+= SEE ALSO
+
+* [ptee]
+* IPC::Run3
+* IO::Tee
+
= BUGS
Please report any bugs or feature using the CPAN Request Tracker.
@@ -120,12 +115,6 @@ Bugs can be submitted through the web interface at
When submitting a bug or request, please include a test-file or a patch to an
existing test-file that illustrates the bug or desired feature.
-= SEE ALSO
-
-* [ptee]
-* IPC::Run3
-* IO::Tee
-
= AUTHOR
David A. Golden (DAGOLDEN)
@@ -152,4 +141,3 @@ limitations under the License.
=end wikidoc
=cut
-
Oops, something went wrong.

0 comments on commit 9b84677

Please sign in to comment.