IO-Interactive-0.0.6000755000765000024 011277165332 13665 5ustar00brianstaff000000000000Changes000444000765000024 173611277165332 15245 0ustar00brianstaff000000000000IO-Interactive-0.0.6Revision history for IO-Interactive 0.05 - Wed Jan 14 22:54:13 2009 * Happy 2009! There aren't any code changes, but I needed to make the version in the Pod match the code version. 0.04 - Sun Aug 31 13:54:27 2008 * Fixes include: * #24823: is_interactive() and command line arguments * #38660: "null" filehandle is a memory leak * #20689: IO::Interactive leaks temp files 0.03_01 - Sun Aug 24 21:53:11 2008 * Cleaning up old tickets: + #20689 Now that we don't use a scalar filehandle, no extra temp files under 5.6.2 + #24823 Applied Schwern's patch to ignore command line arguments + #38660 Fix memory link (same fix for #20689, not printing to a scalar * Maintainer is now brian d foy 0.0.1 Thu Mar 17 04:56:55 2005 Initial release. 0.0.2 Sun May 22 05:41:14 2005 - added dependency on version.pm 0.0.3 Fri Feb 17 15:57:54 2006 - Fixed is_interactive to default to currently selected filehandle, rather than to *STDOUT. Makefile.PL000444000765000024 104411277165332 15714 0ustar00brianstaff000000000000IO-Interactive-0.0.6use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'IO::Interactive', AUTHOR => 'Damian Conway ', VERSION_FROM => 'lib/IO/Interactive.pm', ABSTRACT_FROM => 'lib/IO/Interactive.pm', LICENSE => 'perl', PREREQ_PM => { 'Test::More' => '0', 'version' => '0', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'IO-Interactive-* _build Build' }, ); MANIFEST000444000765000024 32211277165332 15051 0ustar00brianstaff000000000000IO-Interactive-0.0.6Changes examples/interactive.pl examples/memory_test.pl lib/IO/Interactive.pm Makefile.PL MANIFEST MANIFEST.SKIP README t/00.load.t t/busy.t t/interactive.t t/is_interactive.t t/pod-coverage.t t/pod.t META.yml MANIFEST.SKIP000444000765000024 20111277165332 15612 0ustar00brianstaff000000000000IO-Interactive-0.0.6\.git _build blib pm_to_blib \.bak$ Build \.DS_Store \.orig$ \.rej$ \.new$ Makefile$ Makefile.old \.gz$ META.yml .releaserc ^IO- META.yml000444000765000024 67211277165332 15201 0ustar00brianstaff000000000000IO-Interactive-0.0.6--- name: IO-Interactive version: 0.0.6 author: - 'Damian Conway ' abstract: Utilities for interactive I/O license: perl resources: license: http://dev.perl.org/licenses/ requires: Test::More: 0 version: 0 provides: IO::Interactive: file: lib/IO/Interactive.pm version: 0.0.6 generated_by: Module::Build version 0.33 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 README000444000765000024 146111277165332 14625 0ustar00brianstaff000000000000IO-Interactive-0.0.6IO::Interactive version 0.0.3 This module provides three utility subroutines that make it easier to develop interactive applications: is_interactive() - tests if the process is interactive interactive() - returns a filehandle that prints only if interactive busy() - intercepts interactions whilst executing a block INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES None. COPYRIGHT AND LICENCE Copyright (C) 2005, Damian Conway This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. examples000755000765000024 011277165332 15424 5ustar00brianstaff000000000000IO-Interactive-0.0.6interactive.pl000444000765000024 23611277165332 20414 0ustar00brianstaff000000000000IO-Interactive-0.0.6/examples#!/usr/bin/perl -w use IO::Interactive qw(is_interactive); if( is_interactive() ) { print "interactive\n\n"; } else { print "NOT interactive\n\n"; }memory_test.pl000444000765000024 25211277165332 20444 0ustar00brianstaff000000000000IO-Interactive-0.0.6/examples#!/usr/bin/perl use IO::Interactive; print "Testing memory consumption as process $$\n"; $SIG{INT} = sub { exit }; while( 1 ) { print { interactive } 'a' x 4096; }lib000755000765000024 011277165332 14354 5ustar00brianstaff000000000000IO-Interactive-0.0.6IO000755000765000024 011277165332 14663 5ustar00brianstaff000000000000IO-Interactive-0.0.6/libInteractive.pm000444000765000024 1717011277165332 17661 0ustar00brianstaff000000000000IO-Interactive-0.0.6/lib/IOpackage IO::Interactive; use version; $VERSION = qv('0.0.6'); use warnings; use strict; use Carp; use Scalar::Util qw( openhandle ); sub is_interactive { my ($out_handle) = (@_, select); # Default to default output handle # Not interactive if output is not to terminal... return 0 if not -t $out_handle; # If *ARGV is opened, we're interactive if... if (openhandle *ARGV) { # ...it's currently opened to the magic '-' file return -t *STDIN if defined $ARGV && $ARGV eq '-'; # ...it's at end-of-file and the next file is the magic '-' file return @ARGV>0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV; # ...it's directly attached to the terminal return -t *ARGV; } # If *ARGV isn't opened, it will be interactive if *STDIN is attached # to a terminal. else { return -t *STDIN; } } local (*DEV_NULL, *DEV_NULL2); my $dev_null; BEGIN { pipe *DEV_NULL, *DEV_NULL2 or die "Internal error: can't create null filehandle"; $dev_null = \*DEV_NULL; } sub interactive { my ($out_handle) = (@_, \*STDOUT); # Default to STDOUT return &is_interactive ? $out_handle : $dev_null; } sub _input_pending_on { my ($fh) = @_; my $read_bits = ""; my $bit = fileno($fh); return if $bit < 0; vec($read_bits, fileno($fh), 1) = 1; select $read_bits, undef, undef, 0.1; return $read_bits; } sub busy (&) { my ($block_ref) = @_; # Non-interactive busy-ness is easy...just do it if (!is_interactive()) { $block_ref->(); open my $fh, '<', \""; return $fh; } # Otherwise fork off an interceptor process... my ($read, $write); pipe $read, $write; my $child = fork; # Within that interceptor process... if (!$child) { # Prepare to send back any intercepted input... use IO::Handle; close $read; $write->autoflush(1); # Intercept that input... while (1) { if (_input_pending_on(\*ARGV)) { # Read it... my $res = ; # Send it back to the parent... print {$write} $res; # Admonish them for not waiting... print {*STDERR} "That input was ignored. ", "Please don't press any keys yet.\n"; } } exit; } # Meanwhile, back in the parent... close $write; # Temporarily close the input... local *ARGV; open *ARGV, '<', \""; # Do the job... $block_ref->(); # Take down the interceptor... kill 9, $child; wait; # Return whatever the interceptor caught... return $read; } use Carp; sub import { my ($package) = shift; my $caller = caller; # Export each sub if it's requested... for my $request ( @_ ) { no strict 'refs'; my $impl = *{$package.'::'.$request}{CODE}; croak "Unknown subroutine ($request()) requested" if !$impl || $request =~ m/\A _/xms; *{$caller.'::'.$request} = $impl; } } 1; # Magic true value required at end of module __END__ =head1 NAME IO::Interactive - Utilities for interactive I/O =head1 VERSION This document describes IO::Interactive version 0.0.6 =head1 SYNOPSIS use IO::Interactive qw(is_interactive interactive busy); if ( is_interactive() ) { print "Running interactively\n"; } # or... print {interactive} "Running interactively\n"; $fh = busy { do_noninteractive_stuff(); } =head1 DESCRIPTION This module provides three utility subroutines that make it easier to develop interactive applications... =over =item C This subroutine returns true if C<*ARGV> and the currently selected filehandle (usually C<*STDOUT>) are connected to the terminal. The test is considerably more sophisticated than: -t *ARGV && -t *STDOUT as it takes into account the magic behaviour of C<*ARGV>. You can also pass C a writable filehandle, in which case it requires that filehandle be connected to a terminal (instead of the currently selected). The usual suspect here is C<*STDERR>: if ( is_interactive(*STDERR) ) { carp $warning; } =item C This subroutine returns C<*STDOUT> if C is true. If C is false, C returns a filehandle that does not print. This makes it easy to create applications that print out only when the application is interactive: print {interactive} "Please enter a value: "; my $value = <>; You can also pass C a writable filehandle, in which case it writes to that filehandle if it is connected to a terminal (instead of writinbg to C<*STDOUT>). Once again, the usual suspect is C<*STDERR>: print {interactive(*STDERR)} $warning; =item C This subroutine takes a block as its single argument and executes that block. Whilst the block is executed, C<*ARGV> is temporarily replaced by a closed filehandle. That is, no input from C<*ARGV> is possible in a C block. Furthermore, any attempts to send input into the C block through C<*ARGV> is intercepted and a warning message is printed to C<*STDERR>. The C call returns a filehandle that contains the intercepted input. A C block is therefore useful to prevent attempts at input when the program is busy at some non-interactive task. =back =head1 DIAGNOSTICS =over =item Unknown subroutine (%s) requested This module only exports the three subroutines described above. You asked for something else. Maybe you misspelled the subroutine you wanted. =back =head1 CONFIGURATION AND ENVIRONMENT IO::Interactive requires no configuration files or environment variables. =head1 DEPENDENCIES This module requires the C subroutine from the Scalar::Util module. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS No bugs have been reported. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Damian Conway C<< >> Currently maintained by brian d foy C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2005, Damian Conway C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =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 AND/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 AND/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. =cut t000755000765000024 011277165332 14051 5ustar00brianstaff000000000000IO-Interactive-0.0.600.load.t000444000765000024 20111277165332 15501 0ustar00brianstaff000000000000IO-Interactive-0.0.6/tuse Test::More tests => 1; BEGIN { use_ok( 'IO::Interactive' ); } diag( "Testing IO::Interactive $IO::Interactive::VERSION" ); busy.t000444000765000024 24111277165332 15332 0ustar00brianstaff000000000000IO-Interactive-0.0.6/tuse IO::Interactive qw( busy ); print "1..2\n"; *ARGV = *DATA; my $fh = busy { print "ok 1\n"; sleep 3; }; print <$fh>; print ; __DATA__ ok 2 interactive.t000444000765000024 46611277165332 16676 0ustar00brianstaff000000000000IO-Interactive-0.0.6/tuse IO::Interactive qw( interactive ); print "1..2\n"; if (-t *STDIN && -t *STDOUT ) { print {interactive} "ok 1\n"; print {interactive(*STDOUT)} "ok 2\n"; } else { print {interactive} "not "; print "ok 1\n"; print {interactive(*STDOUT)} "not "; print "ok 2\n"; } is_interactive.t000444000765000024 156311277165332 17410 0ustar00brianstaff000000000000IO-Interactive-0.0.6/t#!/usr/bin/perl -w use Test::More 'no_plan'; use IO::Interactive qw( is_interactive ); # Tests which depend on not being connected to a terminal SKIP: { skip "connected to a terminal", 2 if -t *STDIN && -t *STDOUT; ok !is_interactive(); ok !is_interactive(*STDOUT); } # Tests which depend on being connected to a terminal. SKIP: { skip "not connected to a terminal", 7 unless -t *STDIN && -t *STDOUT; ok is_interactive(); ok is_interactive(*STDOUT); { ok open my $manifest_fh, '<', "MANIFEST"; # any ol file will do. ok !is_interactive($manifest_fh); my $old_fh = select $manifest_fh; ok !is_interactive(), 'defaults to selected filehandle'; select $old_fh; } { local @ARGV = qw(-); ok is_interactive(); @ARGV = (1,2,3); ok is_interactive(); } } pod-coverage.t000444000765000024 25411277165332 16727 0ustar00brianstaff000000000000IO-Interactive-0.0.6/t#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); pod.t000444000765000024 21411277165332 15132 0ustar00brianstaff000000000000IO-Interactive-0.0.6/t#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();