Skip to content

Commit

Permalink
replace pipe to ptee with pipe to Tee::App
Browse files Browse the repository at this point in the history
  • Loading branch information
@xdg
xdg committed Dec 11, 2008
1 parent d483555 commit 9b84677
Show file tree
Hide file tree
Showing 10 changed files with 393 additions and 277 deletions.
4 changes: 4 additions & 0 deletions Changes
View file
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions MANIFEST
View file
Expand Up @@ -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
Expand All @@ -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
10 changes: 2 additions & 8 deletions Todo
View file
@@ -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
124 changes: 20 additions & 104 deletions bin/ptee
View file
@@ -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]...
Expand All @@ -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
Expand All @@ -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.
Expand All @@ -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.
100 changes: 44 additions & 56 deletions lib/Tee.pm
View file
@@ -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
Expand All @@ -61,7 +47,7 @@ Tee - Pure Perl emulation of GNU tee
= VERSION
This documentation describes version %%VERSION%%.
This documentation refers to version %%VERSION%%
= SYNOPSIS
Expand All @@ -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
Expand All @@ -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:
Expand All @@ -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.
Expand All @@ -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)
Expand All @@ -152,4 +141,3 @@ limitations under the License.
=end wikidoc
=cut

0 comments on commit 9b84677

Please sign in to comment.