Hello community, here is the log from the commit of package perl-IO-Pager for openSUSE:Factory checked in at 2020-06-10 00:47:59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-IO-Pager (Old) and /work/SRC/openSUSE:Factory/.perl-IO-Pager.new.3606 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-IO-Pager" Wed Jun 10 00:47:59 2020 rev:26 rq:812687 version:1.02 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-IO-Pager/perl-IO-Pager.changes 2019-10-18 14:35:48.123869271 +0200 +++ /work/SRC/openSUSE:Factory/.perl-IO-Pager.new.3606/perl-IO-Pager.changes 2020-06-10 00:48:01.650883979 +0200 @@ -1,0 +2,34 @@ +Mon Jun 8 03:11:41 UTC 2020 - Tina Müller <[email protected]> + +- updated to 1.02 + see /usr/share/doc/packages/perl-IO-Pager/CHANGES + + 1.02 Sun Jun 07 2020 + Fix warning for undefined PAGER RT#132658 + + Fix flipped operands for cmp_ok in test 11. + + Fix synthetic warning in test 9. + + Win32 path fixes (git pull #6) + + Remove deprecated POD content that some parsers carped about RT#131437 + + ::Perl Add --tail mode to tp + + ::Perl Implement reflow for toggleable line numbering and folding. + + ::Perl Add support for bookmarks. + + ::Perl Add and document environment variable + switch processing to tp. + + ::Perl Rename visualBeep to visuaBell, but keep visualBeep as an alias. + + ::Perl Rename done() to close(), but keep done() as an alias. + + ::Perl Remove some debugging status updates. + + ::Perl More fixes for interactive test 16. + + +------------------------------------------------------------------- Old: ---- IO-Pager-1.01.tgz New: ---- IO-Pager-1.02.tgz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-IO-Pager.spec ++++++ --- /var/tmp/diff_new_pack.gF5EYI/_old 2020-06-10 00:48:02.314885716 +0200 +++ /var/tmp/diff_new_pack.gF5EYI/_new 2020-06-10 00:48:02.318885727 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-IO-Pager # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2020 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,13 +17,13 @@ Name: perl-IO-Pager -Version: 1.01 +Version: 1.02 Release: 0 %define cpan_name IO-Pager -Summary: Select a pager and pipe text to it if destination is a TTY +Summary: Select a pager (possibly perl-based) & pipe it text if a TTY License: Artistic-1.0 OR GPL-1.0-or-later Group: Development/Libraries/Perl -Url: https://metacpan.org/release/%{cpan_name} +URL: https://metacpan.org/release/%{cpan_name} Source0: https://cpan.metacpan.org/authors/id/J/JP/JPIERCE/%{cpan_name}-%{version}.tgz Source1: cpanspec.yml BuildArch: noarch @@ -50,7 +50,7 @@ %prep %setup -q -n %{cpan_name}-%{version} -find . -type f ! -name \*.pl -print0 | xargs -0 chmod 644 +find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644 %build perl Makefile.PL INSTALLDIRS=vendor ++++++ IO-Pager-1.01.tgz -> IO-Pager-1.02.tgz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/CHANGES new/IO-Pager-1.02/CHANGES --- old/IO-Pager-1.01/CHANGES 2019-10-09 00:16:23.000000000 +0200 +++ new/IO-Pager-1.02/CHANGES 2020-06-07 19:58:22.000000000 +0200 @@ -1,9 +1,36 @@ Revision history for Perl extension IO::Pager. +1.02 Sun Jun 07 2020 + Fix warning for undefined PAGER RT#132658 + + Fix flipped operands for cmp_ok in test 11. + + Fix synthetic warning in test 9. + + Win32 path fixes (git pull #6) + + Remove deprecated POD content that some parsers carped about RT#131437 + + ::Perl Add --tail mode to tp + + ::Perl Implement reflow for toggleable line numbering and folding. + + ::Perl Add support for bookmarks. + + ::Perl Add and document environment variable + switch processing to tp. + + ::Perl Rename visualBeep to visuaBell, but keep visualBeep as an alias. + + ::Perl Rename done() to close(), but keep done() as an alias. + + ::Perl Remove some debugging status updates. + + ::Perl More fixes for interactive test 16. + 1.01 Tue Oct 08 2019 - Add less.pm to MANIFEST + Add less.pm to MANIFEST. - Fix interactive test 16 + Fix interactive test 16. 1.00 Mon Oct 07 2019 Fork Term::Pager to IO::Pager::Perl, with many new features. @@ -31,7 +58,7 @@ Stringify version. RT#127342 - Add bignum dependency RT#130319 + Add bignum dependency. RT#130319 Add support for eventual Term::Pager v1.5 @@ -97,7 +124,7 @@ Undef $ENV{LESS} in interactive tests in case -E is set. - Robustify t/11 for Win32 RT#79950 + Robustify t/11 for Win32. RT#79950 0.31 Sat Apr 06 2013 @@ -114,7 +141,7 @@ Fixed tests under Win32 & cygwin RT#75181 Swap IO::Pager:new and ::open, alter subclass::open to - remove unnecessary level of subroutine calls + remove unnecessary level of subroutine calls. Return IO::Handle objects when not connected to a TTY for transparent use of IO::Pager when programming OO. @@ -129,32 +156,32 @@ 0.20 Sat Feb 11 2012 - Fixed RT#74691, add File::Which as dependency / skip test if missing + Fixed RT#74691, add File::Which as dependency / skip test if missing. - Fixed non-TTY/redirection behavior and added corresponding test + Fixed non-TTY/redirection behavior and added corresponding test. - Improve buffering sistuation in both ::Buffered and ::Unbuffered + Improve buffering sistuation in both ::Buffered and ::Unbuffered. - Auto-gensym scalar filehandles like perl's open + Auto-gensym scalar filehandles like perl's open. - Add OO interface + Add OO interface. Add alternate pagers 'lv', 'pg', - and system default '/etc/alternatives/pager' RT#74519 + and system default '/etc/alternatives/pager'. RT#74519 Add tests for initialization failure conditions (9-open.t) 0.16 Fri Feb 3 2012 - Require 5.8.0 or better + Require 5.8.0 or better. Removed Perl warning 'Use of tie on a handle without * is deprecated'. - No interactive questions during 'make test' RT#66718 + No interactive questions during 'make test'. RT#66718 Better handling of missing PAGER. - Look for more pagers: 'most' and 'w3m' RT#74519 + Look for more pagers: 'most' and 'w3m'. RT#74519 Documentation clean-up, light refactoring, more error checks. @@ -162,7 +189,7 @@ 0.10 Unreleased - Added support for encodings via binmode() RT#67930 + Added support for encodings via binmode(). RT#67930 Test: encoding, handle (glob, scalar, OO), interactive... @@ -173,7 +200,7 @@ Fixed several mis-coded segments that did not affect operation. - Added C<tell> in IO::Pager::Unbuffered to check size of buffered output. + Added C<tell> in IO::Pager::Buffered to check size of buffered output. Pager open error now sets $! instead of issuing a warning, to more closely emulate the C<open> experience. Check return value as before. @@ -185,7 +212,7 @@ 0.06 Wed Sep 21 2005 Fixed a stupid leftover using =~ for assignment that some perls ignored - RT14692. + RT#14692. Fixed other nits in t.pl and documentation. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/MANIFEST new/IO-Pager-1.02/MANIFEST --- old/IO-Pager-1.01/MANIFEST 2019-10-08 23:46:24.000000000 +0200 +++ new/IO-Pager-1.02/MANIFEST 2019-10-12 18:50:43.000000000 +0200 @@ -8,6 +8,7 @@ lib/IO/Pager/less.pm lib/IO/Pager/Perl.pm lib/IO/Pager/tp +eg/fib README TODO .proverc diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/META.json new/IO-Pager-1.02/META.json --- old/IO-Pager-1.01/META.json 2019-10-09 00:28:50.000000000 +0200 +++ new/IO-Pager-1.02/META.json 2020-06-07 20:02:08.000000000 +0200 @@ -47,12 +47,13 @@ "Term::ReadKey" : "0", "Text::Wrap" : "0", "Tie::Handle" : "0", - "base" : "0" + "base" : "0", + "perl" : "5.008000" } } }, "release_status" : "stable", - "version" : "1.01", + "version" : "1.02", "x_runtime" : { "recommends" : {} }, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/META.yml new/IO-Pager-1.02/META.yml --- old/IO-Pager-1.01/META.yml 2019-10-09 00:28:50.000000000 +0200 +++ new/IO-Pager-1.02/META.yml 2020-06-07 20:02:08.000000000 +0200 @@ -34,7 +34,8 @@ Text::Wrap: '0' Tie::Handle: '0' base: '0' -version: '1.01' + perl: '5.008000' +version: '1.02' x_runtime: recommends: {} x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/Makefile.PL new/IO-Pager-1.02/Makefile.PL --- old/IO-Pager-1.01/Makefile.PL 2019-10-05 16:03:19.000000000 +0200 +++ new/IO-Pager-1.02/Makefile.PL 2019-10-13 15:25:46.000000000 +0200 @@ -2,6 +2,7 @@ # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( + 'MIN_PERL_VERSION' => 5.8.0, 'NAME' => 'IO::Pager', 'VERSION_FROM' => 'lib/IO/Pager.pm', # finds $VERSION 'BUILD_REQUIRES' => { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/README new/IO-Pager-1.02/README --- old/IO-Pager-1.01/README 2019-10-08 02:16:51.000000000 +0200 +++ new/IO-Pager-1.02/README 2019-10-20 22:41:13.000000000 +0200 @@ -48,17 +48,16 @@ COPYRIGHT AND LICENSE -Copyright (C) 2003-2019 Jerrad Pierce +IO::Pager::Perl - Jerrad Pierce & Jeff Weisberg, Perl Artistic License - * Thou shalt not claim ownership of unmodified materials. +All Else - Copyright (C) 2003-2019 Jerrad Pierce: + * Thou shalt not claim ownership of unmodified materials. * Thou shalt not claim whole ownership of modified materials. - * Thou shalt grant the indemnity of the provider of materials. - * Thou shalt use and dispense freely without other restrictions. -Or, if you prefer: + Or, if you prefer: This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.0 or, at your diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/TODO new/IO-Pager-1.02/TODO --- old/IO-Pager-1.01/TODO 2019-10-09 00:22:51.000000000 +0200 +++ new/IO-Pager-1.02/TODO 2020-06-07 19:54:17.000000000 +0200 @@ -1,27 +1,90 @@ Important things here and in code flagged with XXX +OLD key debug +OLD why do some functions die? +OLD why does initial load hang? +OLD return 1 if not defined $char? +OLD +OLD Revert to previous fnc invocation scheme? Should not matter +OLD ! Check ref() eq 'CODE' before running +OLD +OLD Test bed with: +OLD outer loop +OLD Term::ReadKey +OLD +OLD ioctl() for cbreak? + + +1.02 +IPP Fix M-v? Is it TERM specific failure? e.g; hterm on ChromeOS + +IPP rename tp to ppp ("pure" perl pager)? (except stty/tput, and ReadKey) + +IPP M-{left,right} file jump +IPP tp: $me->mark(_txN, #) if eof +IPP M-right: push ($n=shift); jump $n +IPP M-left: unshift ($n=pop); jump $n + +IPP scroll left/right half-width? + +IPP "Minimal jump editing: ^G abort, delete"? + +IPP return if $Squeeze and $me->{_text}-[cur] eq '' and +IPP $me->{_text}->[prev] eq '' +IPP Document line numbering impacts?! (perf, RAM...) + +IPP Alt _fncRE join '' map {"^\Q$_\n"};//m + +IPP Term:Screen +IPP https://metacpan.org/release/Term-Screen/source/lib/Term/Screen.pm#L474 +IPP getch: reimplement (versus #use#, misalignments with forking) +IPP sysread vs. Term::ReadKey, as $^O alt for getc() in ReadMode()? +IPP +IPP get_fn_keys aliases +IPP PgUp (^[[5~ M-Up), PgDwn (^[[6 M-Down~), +IPP Home (^[[H C-M-Up), End (^[[F C-M-Down) + + +IPP WINCH reflow +IPP keep cursor at same content? +IPP _cursor = int(_cursor * oldCols / newCols)-1 + +IPP -rows makes smaller screen, but scrolling down fails. +IPP Scrollng back up seems fine(ish) though. + +IPP Display filename in status line? + +IPP Clear buffer for multiple files? OTOH, while different, +IPP all-in-one is kind of a unique and nifty feature. +IPP Discontinuous numbering? + +IPP Rearchitect around String::Tagged::Terminal? + 1.01 -IPP Add windows support via Win32::Console and Term::Size::Win32? +IPP Add Windows support? via Win32::Console or Win32::Console::ANSI or +IPP Term::ANSIScreen or Win10 1511+ ENABLE_VIRTUAL_TERMINAL_PROCESSING & +IPP TERM=vt100; also Term::Size::Win32 or Win32::Readch 1.00 -IPP Togglable wrap? ...with reflow -IPP remap left & right scroll to beep? iff unchanged lineNo +IPP If fold, remap left & right scroll to beep? + IPP Squeeze IPP Proper logical line numbering? IPP Togglable? ...with reflow -IPP #Consolidate _cursor+{rows} and _end?? -IPP _end -IPP !! line =$n pause ... then what?! -IPP down_lines -IPP _cursor+rows !!detect EOF!! -IPP !! if {pause} and _end < {rows}-1 skip -IPP line(_cursor++ +{rows}) - -IPP up_lines {end}-- NOOP, just keeping up -IPP jump _cursor+{rows} NOOP, just keeping up -IPP search _cursor+{rows} NOOP, just keeping up -IPP _cursor+{rows} NOOP, just keeping up +IPP #Consolidate _cursor+{rows} and _end?? +IPP resize 126 $me->{_end} = $me->{rows} - 1; #NOOP +IPP new 113 $me->{_end} = $me->{rows} - 1; #NOOP, just setting up +IPP line 507 $me->{_end} = $n; #Advance past pause!! +IPP down_ln 518 if( $me->{_end} >= $me->{_txtN}-1 ){ #detect EOF!! +IPP down_ln 522 if(length($me->{pause}) && $me->{_end}<$me->{rows}-1){ +IPP down_ln 523 print $t->Tgoto('cm', 0, $me->{_end}+1 ); } # move! +IPP down_ln 532 $me->line( ++$me->{_end} ); #print! +IPP up_line 552 $me->{_end}--; #NOOP, just keeping up +IPP jump 609 $me->{_end} = $me->{_cursor} + $me->{rows}; #NOOP +IPP search 671 $me->{_end} = $me->{_cursor} + $me->{rows}; # - 1; +IPP search 678 $me->{_end} -= $x; #NOOP, just keeping up + IPP Pause bugs IPP extra scroll forwards required after backed up over pauses @@ -31,10 +94,6 @@ IPP We get an extra chunk of output after menu closing -IPP Add mark ability? -IPP m _mark{getc()} = _cursor -IPP ' jump(_mark{getc()}) #special I<^> and I<$>, I<'>? - IPP Add more IO::Pager::Perl involved tests, scripted interaction? IPP read from pipe, file IPP navigation @@ -48,30 +107,19 @@ Can we make Pager::less into a self-contained forking implementation? Current forking design yields: - Failed to create PAGER FH at 16-PurePerl_interactive.t line 16 - stty: standard input: Inappropriate ioctl for device - stty: standard input: Inappropriate ioctl for device - print() on unopened filehandle STDOUT at Term/Pager.pm line 330 - print() on unopened filehandle STDOUT at Term/Pager.pm line 395 - print() on unopened filehandle STDOUT at Term/Pager.pm line 396 - print() on unopened filehandle STDOUT at Term/Pager.pm line 397 - print() on unopened filehandle STDOUT at Term/Pager.pm line 398 - print() on unopened filehandle STDOUT at Term/Pager.pm line 399 + Failed to create PAGER FH at 16-PurePerl_interactive.t line 16 + stty: standard input: Inappropriate ioctl for device + stty: standard input: Inappropriate ioctl for device + print() on unopened filehandle STDOUT at Term/Pager.pm line 330 + print() on unopened filehandle STDOUT at Term/Pager.pm line 395..399 + + Test functionality w/|w/o Term::ReadKey Fix IO::Pager and IO::Pager::less PODs (remove cuts) 0.40 Push previous versions to github - Functional fork for Term::Pager - Test functionality w/|w/o Term::ReadKey - As explicit and implicit PAGER - - make pipes & pager object - parent - event loop/interact - child - worker 0.35 Odd failure of test 11 under tcsh and win-bash because *reference* has extra trailing newline. @@ -83,7 +131,4 @@ and document location of each in matrix OR use table-driven tests? new/open each class scalar vs. glob vs. OO - (non-)fully qualified subclass name - -0.02 - Implement IO::Pager::Callback, just because it sounds cool? + (non-)fully qualified subclass name \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/eg/fib new/IO-Pager-1.02/eg/fib --- old/IO-Pager-1.01/eg/fib 1970-01-01 01:00:00.000000000 +0100 +++ new/IO-Pager-1.02/eg/fib 2019-10-12 18:50:29.000000000 +0200 @@ -0,0 +1,47 @@ +#!/usr/local/bin/perl +use strict; +use IO::Pager::Perl; +use Term::ReadKey; + +my($m, $n)=(1,1); +my $t = IO::Pager::Perl->new(pause=>"\cL", wrap=>1, pause=>"\cL", + text=> ["1\n", + sub{ ($m,$n)=($n,$m+$n); return "$m\n" } ] + ); +my($PIPE, @F); +#if( -t STDIN ){ +# @F = <ARGV> } +#else{ +# #Separate piped input from keyboard input +# open($PIPE, '<&=STDIN' ) or die $!; +# close(STDIN); +# open(STDIN, '<', '/dev/tty') or die $!; +#} + +eval{ + while( $t->more(RT=>.05) ){ +# my $X; +# defined($PIPE) ? +# do{ $t->add_text($X) if sysread($PIPE, $X, 1024) } : +# $t->add_text( splice(@F, 0, $t->rows()) ); + } +}; + +__END__ +=pod + +=head1 NAME + +fib - display Fibanocci sequence via callback with a pure perl pager + +=head1 SEE ALSO + +L<IO::Pager::Perl>, L<less(1)> + +=head1 AUTHORS + + Jerrad Pierce [email protected] + +=head1 LICENSE + +=cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/Buffered.pm new/IO-Pager-1.02/lib/IO/Pager/Buffered.pm --- old/IO-Pager-1.01/lib/IO/Pager/Buffered.pm 2018-10-13 18:31:49.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/Buffered.pm 2019-10-13 15:15:43.000000000 +0200 @@ -1,5 +1,5 @@ package IO::Pager::Buffered; -our $VERSION = 0.42; +our $VERSION = 1.02; use strict; use base qw( IO::Pager ); @@ -46,7 +46,7 @@ $self->SUPER::CLOSE(); } -*DESTROY = \&CLOSE; +{ no warnings 'once'; *DESTROY = \&CLOSE; } sub TELL { # Return the size of the buffer @@ -107,14 +107,14 @@ or not to pipe a filehandle's output to a program specified in I<PAGER>; determined and set by IO::Pager at runtime if not yet defined. -This subclass buffers all output for display until execution returns to the -parent scope or a manual L</flush> occurs.L<*|/close> If this is not what -you want look at another subclass such as L<IO::Pager::Unbuffered>. While -probably not common, this may be useful in some cases, such as buffering all -output to STDOUT while the process occurs so that warnings on STDERR are more +This subclass buffers all output for display until execution returns to +the parent scope or a manual flush occurs. If this is not what you want +look at another subclass such as L<IO::Pager::Unbuffered>. While probably +not common, this may be useful in some cases, such as buffering all output +to STDOUT while the process occurs so that warnings on STDERR are more visible, then displaying the less urgent output from STDOUT after. Or, -alternately, letting output to STDOUT slide by and defer warnings for later -perusal. +alternately, letting output to STDOUT slide by and defer warnings for +later perusal. =head1 METHODS @@ -124,7 +124,7 @@ Instantiate a new IO::Pager to paginate FILEHANDLE if necessary. I<Assign the return value to a scoped variable>. Output does not -occur until the filehandle is L</flush>ed or L</close>d. +occur until the filehandle is flushed or closed. =head2 new( [FILEHANDLE] ) @@ -135,7 +135,7 @@ Flushes the buffer to the pager and closes the filehandle for writing. Normally, when using a lexically or locally scoped variable to hold the -token supplied by L</open>, explicit calls to close are unnecessary. +token supplied by open, explicit calls to close are unnecessary. However, if you are using IO::Pager::Buffered with an unlocalized STDOUT or STDERR you close the filehandle to display the buffered content or wait for global garbage cleaning upon program termination. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/Page.pm new/IO-Pager-1.02/lib/IO/Pager/Page.pm --- old/IO-Pager-1.01/lib/IO/Pager/Page.pm 2018-10-11 04:44:56.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/Page.pm 2019-10-13 15:11:54.000000000 +0200 @@ -1,6 +1,8 @@ package IO::Pager::Page; +use strict; +use warnings; -our $VERSION = 0.32; +our $VERSION = 1.02; # The meat @@ -19,7 +21,7 @@ $SIG{PIPE} = 'IGNORE' if $opt{hush}; } -"Badee badee badee that's all folks!"; +local $_= "Badee badee badee that's all folks!"; __END__ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/Perl.pm new/IO-Pager-1.02/lib/IO/Pager/Perl.pm --- old/IO-Pager-1.01/lib/IO/Pager/Perl.pm 2019-10-09 00:23:49.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/Perl.pm 2020-06-07 19:51:13.000000000 +0200 @@ -1,5 +1,5 @@ package IO::Pager::Perl; -our $VERSION = '1.01'; +our $VERSION = '1.02'; use strict; use warnings; @@ -7,7 +7,7 @@ #Signal handling, only needs to be set once, and does not have access to object my($SP, $RT) = $|; -local $SIG{INT} = local $SIG{QUIT} = \&done; +local $SIG{INT} = local $SIG{QUIT} = \&close; #Stubs for ReadKey functions that we fill in with code refs if it's not loaded sub ReadMode; @@ -44,17 +44,34 @@ NOR => $t->Tputs('me'), # Normal ); + my $text; + if( defined( $param{text} ) ){ + my $ref = ref( $param{text} ); + if( $ref eq 'ARRAY' ){ + die "Invalid text, must be string, code ref, or [string, code ref]" + unless (scalar( @{$param{text}} ) ==2) and + ref( $param{text}->[0] ) eq '' and + ref( $param{text}->[1] ) eq 'CODE'; - my $text = delete($param{text}) if defined($param{text}); + $text = $param{text}->[0]; + $param{text} = $param{text}->[1] + } + elsif( $ref eq '' ){ + $text = delete( $param{text} ); + } + } + + $param{visualBell} = delete($param{visualBeep}) if + defined($param{visualBeep}) and not defined($param{visualBell}); my $me = bless { # default values _cursor => 0, _end => 0, _left => 0, _term => $t, _dumb => $dumb, _txtN => 0, _search => '', _statCols => 0, _lineNo=>[0], - lineNo => 0, pause => 0, #pause=>"\cL" #more + lineNo => 0, pause => '', #pause=>"\cL" #more raw => 0, statusCol => 0, squeeze=>0, - visualBeep=>0, wrap=>0, + visualBell=>0, fold=>0, %dims, # if the termcap entries don't exist, nothing bad will happen @@ -77,7 +94,7 @@ bottom=> 'Bottom', prompt=> "<h>=help \000<space>=down <b>=back <q>=quit", continue=> 'press any key to continue', - help=> <<'EOH' + help=> <<EOH q quit \000 h help r C-l refresh \000 / search \000 ? search backwards @@ -87,29 +104,43 @@ d half page down \000 u half page up g < goto top \000 G > goto bottom <- scroll left \000 -> scroll right - # Line numbering \000 \d+\n jump to line \d+ + m mark position \000 ' return to mark + # line numbering \000 \\d+\\n jump to line \\d+ + C toogle raw \000 S toggle folding EOH }; - $me->{_fnc} = { - 'q' => \&done, 'h' => \&help, - '/' => \&search, '?' => \&hcraes, - 'n' => \&next_match, 'P' => \&prev_match, - 'p' => \&prev_match, 'N' => \&prev_match, - 'r' => \&refresh, "\cL" => \&refresh, - ' ' => \&downpage, "\cC" => \&downpage, - "\n"=> \&downline, "\e[B" => \&downline, - 'd' => \&downhalf, 'u' => \&uphalf, - 'b' => \&uppage, "\ev" => \&uppage, - 'y' => \&upline, "\e[A" => \&upline, - '<' => \&to_top, - '>' => \&to_bott, '$' => \&to_bott, - "\e[D" => \&move_left, "\e[C" => \&move_right, - '#' => \&toggle_numbering, - '/(\d+)/'=>1 #jump to line - }; - $me->{_end} = $me->{rows} - 1; +# $me->{_fnc} = { + $me->add_func( + 'q' => \&close, 'h' => \&help, + '/' => \&search, '?' => \&hcraes, + 'n' => \&next_match, 'P' => \&prev_match, + 'p' => \&prev_match, 'N' => \&prev_match, + 'r' => \&refresh, "\cL" => \&refresh, + ' ' => \&downpage, "\cv" => \&downpage, #"\e\[5~"=>\&downpage, #M-down + "\n"=> \&downline, "\e[B" => \&downline, + 'd' => \&downhalf, 'u' => \&uphalf, + 'b' => \&uppage, "\eV" => \&uppage, #"\e\[6~"=>\&uppage, #M-up + 'y' => \&upline, "\e[A" => \&upline, + '<' => \&to_top, "\e[H" => \&to_top, 'g' => \&to_top, +#"\e\[1;3C"=>\&to_top, #PGUP? +#"\e\[1;3D"=>\&to_bott,#PGDN? + '>' => \&to_bott, '$' => \&to_bott, 'G' => \&to_bott, + "\e0E" => \&to_bott, "\e0W" => \&to_bott, + "\e[D" => \&move_left, "\e[C" => \&move_right, + 'm' => \&save_mark, "'" => \&goto_mark, + '#' => \&toggle_numbering, + 'C' => \&toggle_raw, + 'S' => \&toggle_fold, + '/(\d+)/'=>1 #jump to line + ); #}; + #Mise-en-place; prepare to cook some characters + #\000-\010\013-\037/@A-HK-Z[\\]^_/ + $me->{_raw}->{chr($_)} = chr(64+$_) foreach (0..8, 11..31); + + $me->{_end} = $me->{rows} - 1; + $SIG{WINCH} = sub{ $me->resize() }; $me; @@ -123,7 +154,7 @@ $me->{_end} = $me->{rows} - 1; - $me->refresh(); + $me->{fold} ? $me->reflow() : $me->refresh(); $me->prompt(); $me->{WINCH}->() if ref($me->{WINCH}) eq 'CODE'; @@ -178,7 +209,7 @@ #Split on new lines, preserving internal blanks my @F = split(/\n/, $_, -1); - if( $me->{wrap} ){ + if( $me->{fold} ){ #Two expressions to avoid lame single-use warning local $Text::Wrap::columns; $Text::Wrap::columns = $me->{cols} - @@ -218,19 +249,38 @@ push @{$me->{_text}}, @F; $me->{_txtN} = @{ $me->{_text} }; #-1; - $me->refresh() if $shown <= $me->{rows}; +#XXX fix this expression?! shoud not be rows, but instead cursor +#warn $shown; + $me->refresh(); # if $shown <= $me->{rows}; # + $me->{_cursor}; +} + +sub reflow { + my $me = shift; + my($prevLine, @text) = 0; + while( scalar @{$me->{_text}} ){ + my $curLine = shift @{$me->{_lineNo}}; + if( $curLine == $prevLine ){ + $text[-1] .= ' ' . (shift @{$me->{_text}}||''); } + else{ + push @text, shift @{$me->{_text}}; } + $prevLine = $curLine; + } + $me->{_lineNo}=[]; + $me->{_txtN}=0; + $me->add_text( join($/, @text) ); } + sub more { my $me = shift; my %param = @_; $RT = $me->{RT} = $param{RT}; - if( $me->{wrap} ){ + if( $me->{fold} ){ eval "use Text::Wrap"; $me->dialog("Text::Wrap unavailable, disabling wrap mode\n\n$@") if $@; } - if( $@ or not $me->{wrap} ){ + if( $@ or not $me->{fold} ){ sub wrap {@_} } @@ -243,44 +293,71 @@ else{ print $me->{NOR}; + + #INPUT LOOP, revised with inspiration from Term::Screen::getch() + my $input=''; while( 1 ){ $me->prompt(); # status line + my $exit = undef; - my $exit; - my $q = ReadKey($param{RT}); - # Catch arrow keys. NOTE: Escape would enter this too - #...requiring an extra input if no ReadKey - if( defined($q) and ord($q) == 27 ){ - $q.=ReadKey(0); - $q.=ReadKey(0) if $q eq "\e["; + my $char = ReadKey($param{RT}); + #Fall back to parent loop, obviating need for callbacks to implement + #tail functionality and for cleaner startup (no preload on piped input) + #next unless defined($char); + return 1 unless defined($char); + $input .= $char; + unless( ($input=~ /^\e/ and index($me->{_fncRE}, $input)>0 ) + || $input =~ /^\d+/ + || defined($me->{_fnc}->{$input}) ){ + #&beep(); + $me->beep($input); + $input =''; + next; + } + + if( $me->{_fnc}->{$input} ){ + $input =~ s/\e/^\[/; + use B 'svref_2object'; + my $n = $me->{_fnc}->{$input}; + $n = svref_2object($n)->GV->NAME; +#DEBUG $me->dialog(quotemeta($input)." $n",1); + $exit = $me->{_fnc}->{$input}->($me); + $input=''; } - if( defined($q) and $q =~ /\d/ and $me->{_fnc}->{'/(\d+)/'} ){ - $me->{_I18N}{status} = $q; - $me->prompt(); - while( defined($_ = ReadKey(0)) ){ - last unless /\d/; - $q .= $_; - $me->{_I18N}{status} = $q; + #Line-number input + elsif( $me->{_fnc}->{'/(\d+)/'} and $input =~ /^\d+/ ){ + if( $char eq "\cH" or ord($char)==127 ){ + chop($input); chop($input); + } + elsif( $char eq "\cG" ){ + $me->{_I18N}{status} = $input = ''; $me->prompt(); + return 1; } - #Commit on enter, anything else aborts - if( $_ eq "\n" ){ - $q<$me->{_txtN} ? $me->jump($q) : $me->to_bott(); + if( $input =~ /^\d+\n$/ ){ + chomp($input); + $exit = $input < $me->{_txtN} ? $me->jump($input) : $me->to_bott(); + $me->{_I18N}{status} = $input = ''; + $me->prompt(); + next; + } + else{ + $me->{_I18N}{status} = $input; + $me->prompt(); } - $me->{_I18N}{status} = ''; - next; } - if( defined $q ){ - my $f = $me->{_fnc}->{$q} || \&beep; - # $me->{_I18N}{status} = $q; #input debugging - $exit = ref($f->($me)); - } - return 1 if $param{RT} or $exit; +## if( defined $q ){ +## my $f = $me->{_fnc}->{$q} || \&beep; +## # $me->{_I18N}{status} = $q; #input debugging +## $exit = ref($f->($me)); +## } + #XXX DOH! need to expand this condition to only trip if full key has been read + return 1 if $param{RT} && defined($exit); } - } - $me->done(); + } + $me->close(); } *less = \&more; *page = \&more; #Avid lame single-use warning @@ -297,7 +374,7 @@ BEGIN{ #Install generic accessors no strict 'refs'; - foreach my $method ( qw(eof lineNo pause raw statusCol visualBeep) ){ + foreach my $method ( qw(eof lineNo pause raw statusCol visualBell) ){ *{$method} = sub{ $_[0]->{$method}=$_[1] if defined($_[1]); $_[0]->{$method} } } @@ -313,11 +390,18 @@ while( my($k, $v) = each %param ){ $me->{_fnc}{$k} = $v; } + #RegExp::Trie, RegExp::Optimize, List::RegExp + $me->{_fncRE} = join '|', #map { quotemeta($_) } + sort keys %{ $me->{_fnc} }; + #$me->{_fncRE} = qr/^($me->{_fncRE})/; } sub beep { print "\a"; - print $_[0]->{_term}->Tputs('vb') if $_[0]->{visualBeep}; + my $scan = $_[1]; + $scan =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge; + $_[0]->dialog("Unrecognized command: $scan", 1); + print $_[0]->{_term}->Tputs('vb') if $_[0]->{visualBell}; } # display a prompt, etc @@ -337,7 +421,8 @@ print $me->{_term}->Tgoto('cm', 0, $me->{rows}); # bottom left print $me->{_term}->Tputs('ce'); # clear line my $prompt = $me->{_I18N}{prompt}; - my $pN = $me->{cols} - 2 - length($p) - length($me->{_I18N}{prompt}); + (my $pSansCodes = $p) =~ s/\e\[[\d;]*[a-zA-Z]//g; + my $pN = $me->{cols} - 2 - length($pSansCodes) - length($me->{_I18N}{prompt}); $p .= ' ' x ($pN > 1 ? $pN : 1); $prompt = $pN>2 ? $prompt : do {$prompt =~ s/\000.+//; $prompt }; print $me->{REV}; # reverse video @@ -345,7 +430,7 @@ print $me->{NOR}; # normal video } -sub done { +sub close { ReadMode 0; print "\n"; $| = $SP || 0; @@ -353,6 +438,12 @@ $RT ? die : return \"foo"; } +{ + no warnings 'once'; + *done = \&close; +} + + # provide help to user sub help { my $me = shift; @@ -419,16 +510,14 @@ sub remove_menu { my $me = shift; -#XXX now fails if at bottom of text - my $s = $me->{rows} - $me->{_menuRows}; #Allow wipe of incomplete/paused output. #XXX "Bug" in that we get an extra chunk of output after menu closing my $pause = $me->{pause}; - $me->{pause} = ''; + $me->{pause} = undef; - $me->I18N('status', $s."..".$me->rows()); $me->prompt(); + #$me->I18N('status', $s."..".$me->rows()); $me->prompt(); # Fractional restoration instead of full refresh foreach my $n ($s .. $me->{rows}){ @@ -458,17 +547,24 @@ my $me = shift; my $n = shift; local $_ = $me->{_text}[$n]||''; +# my $prev = $me->{_text}[$n-1]||''; #!! ORDER OF OPERATIONS ON OUTPUT PROCESSING AND DECORATION MATTERS +# #Squeeze... this identifies lines, but just gives a blank line, still +# code elsewhere iterates over rows and advances down screen... +# we need to intervene in each of those instances and: +# not progress another line of display then add another iteration +# return if $me->{squeeze} && $_ eq '' && $prev eq ''; + #Breaks? - my $pause =1 if length($me->{pause}) && defined && /$me->{pause}/; + my $pausey = 1 if length($me->{pause}) && defined && /$me->{pause}/; #Crop if no folding my $len = length(); - unless( $me->{wrap} ){ - $_ = ($len-$me->{_statCols}) < $me->{_left} ? '' : substr($_, - $me->{_statCols} + $me->{_left},$me->{cols}-$me->{_statCols}); + unless( $me->{fold} ){ + $_ = ($len-$me->{_statCols}) < $me->{_left} ? '' : + substr($_, $me->{_left}, $me->{cols}-$me->{_statCols}); if( $len - $me->{_left} > $me->{cols} ){ substr($_, -1, 1, "\$"); } @@ -476,9 +572,9 @@ #Cook control characters unless( $me->{raw} ){ - #XXX Specially protect escape sequences, so we can wrap controls in REV? - s/(?=[\000-\010\013-\037])/^/g; - tr/\000-\010\013-\037/@A-HK-Z[\\]^_/; +# s/(?=[\000-\010\013-\037])/^/g; +# tr/\000-\010\013-\037/@A-HK-Z[\\]^_/; + s/([\000-\010\013-\037])/$me->{REV}^$me->{_raw}->{$1}$me->{NOR}/g; } #Search @@ -489,7 +585,7 @@ my $info = $me->{statusCol} && !$me->{lineNo} ? ($matched ? '*' : ' ') :''; $info = sprintf("% 8s", - $me->{wrap} ? ($me->{_lineNo}->[$n]||-1) : + $me->{fold} ? ($me->{_lineNo}->[$n]||-1) : (defined($me->{_text}[$n]) ? $n+1 : '') ) if $me->{lineNo}; $_ = ($me->{statusCol} && $matched ? $me->{REV} : ''). @@ -500,7 +596,7 @@ print; - if( $pause ){ + if( $pausey ){ $me->{_end} = $n; #Advance past pause no warnings 'exiting'; last; } @@ -513,11 +609,18 @@ for (1 .. $n){ if( $me->{_end} >= $me->{_txtN}-1 ){ - exit if $me->{eof}; - &beep; last; } - else{ + exit if $me->{eof} && ref($me->{text}) ne 'CODE'; + if( ref($me->{text}) eq 'CODE' ){ + $me->add_text( $me->{text}->() ); + } + else{ + &beep; last; + } + } +# else{ #Switch to two statements to allow callback + if( $me->{_end} < $me->{_txtN}-1 ){ if( length($me->{pause}) && $me->{_end} < $me->{rows}-1 ){ - print $t->Tgoto('cm', 0, $me->{_end}+1 ); } # move + print $t->Tgoto('cm', 0, $me->{_end}+1 ); } # move else{ # why? because some terminals have bugs... print $t->Tgoto('cm', 0, $me->{rows} ); # move @@ -532,7 +635,12 @@ } } sub downhalf { $_[0]->down_lines( $_[0]->{rows} / 2 ); } -sub downpage { $_[0]->down_lines( $_[0]->{rows} ); } +sub downpage { $_[0]->down_lines( $_[0]->{rows} ); + #WTF?! add_text in tp's while-loop cannot be reached if there's + #no delay here until something other than downpage is called?! + select(undef, undef, undef, .1); #XXX WTF?! +# warn "\n\n", map{$_[0]->{$_}."\n"} qw/rows _cursor _end/; +} sub downline { $_[0]->down_lines( 1 ); } sub up_lines { @@ -563,6 +671,42 @@ $me->jump( $me->{rows}>$me->{_txtN} ? 0 : $me->{_txtN}-$me->{rows} ); } +sub save_mark{ + my $me = shift; + + $me->I18N('status', $me->{BLD}.'*Mark name?*'.$me->{NOR}.$me->{REV}); + $me->prompt(); + $me->{_term}->Tgoto('cm', + length('[tp] 100% Bottom Mark name?')+1, + $me->{rows}); + my $mark = ReadKey(); + next if $mark eq "'"; + $me->{_mark}->{$mark} = $me->{_cursor}; + $me->I18N('status', ''); + $me->prompt(); +} + +sub goto_mark{ + my $me = shift; + + my $mark = ReadKey(); + my $jump = $me->{_mark}->{$mark}; + if( $mark eq '^' ){ + $jump = 0; + } + elsif( $mark eq '$' ){ + $jump = $me->{_txtN} - $me->{rows}; + } + elsif( $mark eq '"' ){ + my $marks = join("\n", map {"$_ = $me->{_mark}->{$_}"} + sort keys %{ $me->{_mark} } ); + $me->dialog($marks); + return; + } + $me->{_mark}->{"'"} = $me->{_cursor}; + $me->jump( $jump ); +} + sub jump { my $me = shift; @@ -676,9 +820,23 @@ sub toggle_numbering{ my $me = shift; $me->{lineNo} = not $me->{lineNo}; +# $me->reflow(); $me->refresh(); } +sub toggle_raw{ + my $me = shift; + $me->{raw} = not $me->{raw}; + $me->reflow(); +} + +sub toggle_fold{ + my $me = shift; + $me->{fold} = not $me->{fold}; + $me->{_lineNo} = [1 .. $me->{_txtN}] if $me->{fold}; + $me->reflow(); +} + sub dumb_mode { my $me = shift; my $end = 0; @@ -736,13 +894,13 @@ =item I<rows> =E<gt>25? The number of rows on your terminal. The terminal is queried directly -with Term::ReadKey if loaded or C<stty> or C<tput>, and if these fail +with L<Term::ReadKey> if loaded or C<stty> or C<tput>, and if these fail it defaults to 25. =item I<cols> =E<gt>80? The number of columns on your terminal. The terminal is queried directly -with Term::ReadKey if loaded or C<stty> or C<tput>, and if these fail it +with L<Term::ReadKey> if loaded or C<stty> or C<tput>, and if these fail it defaults to 80. =item I<speed> =E<gt>38400? @@ -783,7 +941,7 @@ Add a column with markers indicating which row match a search expression. -=item I<visualBeep> =E<gt>0 +=item I<visualBell> =E<gt>0 Flash the screen when beeping. @@ -794,8 +952,8 @@ There are accessors for all of the above properties, however those for rows, cols, speed, fold and squeeze are read only. - #Is visualBeep set? - $t->visualBeep(); + #Is visualBell set? + $t->visualBell(); #Enable line numbering $t->lineNo(1); @@ -832,6 +990,21 @@ NOTE: If Term::ReadKey is not loaded but RT is true, screen updates will only occur on keypress. +=head3 Callback + +You can also pass a code reference to the I<text> attribute of the constructor +which will be called when reaching the "end of file"; consequently, it is not +possible to set the I<eof> flag to exit at end of fie if doing so. + + $t->new( text=>sub{ } ); #eof=>0 is implied + +Alternatively, you may supply a reference to a two element array. The first is +an initial chunk of text to load, and the second the callback. + + #Fibonacci + my($m, $n)=(1,1); + $t->new( text=> ["1\n", sub{ ($m,$n)=($n,$m+$n); return "$n\n"} ] ); + =head2 Adding Functionality and Internationalization (I18N) It is possible to extend the features of IO::Pager::Perl by supplying the @@ -840,7 +1013,7 @@ represents Alt-? The existing pairings are: 'h' => \&help, - 'q' => \&done, + 'q' => \&close, 'r' => \&refresh, #also "\cL" "\n"=> \&downline, #also "\e[B" ' ' => \&downpage, #also "\cv" @@ -856,6 +1029,8 @@ 'p' => \&prev_match, #also 'N' "\e[D" => \&move_left, "\e[C" => \&move_right, + 'm' => \&save_mark, + "'" => \&goto_mark, '#' => \&toggle_numbering, And a special sequence of a number followed by enter analogous to: @@ -909,11 +1084,29 @@ Similarly, the status text will be cropped at a null character for narrow displays. +=head2 User Interface + +=head3 Marks + +There are multiple special marks + +=over 4 + +=item ^ Beginning of file + +=item $ End of file + +=item ' Previous location + +=item " List user-created marks + +=back + =head1 CAVEATS =head2 UN*X -This modules currently only works in UN*X-like environment. +This modules currently only works in a UN*X-like environment. =head2 Performance diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/Unbuffered.pm new/IO-Pager-1.02/lib/IO/Pager/Unbuffered.pm --- old/IO-Pager-1.01/lib/IO/Pager/Unbuffered.pm 2018-10-13 19:29:53.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/Unbuffered.pm 2019-10-13 15:10:40.000000000 +0200 @@ -1,7 +1,8 @@ package IO::Pager::Unbuffered; -our $VERSION = 0.42; +our $VERSION = 10.02; use strict; +use warnings; use base qw( IO::Pager ); use SelectSaver; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/less.pm new/IO-Pager-1.02/lib/IO/Pager/less.pm --- old/IO-Pager-1.01/lib/IO/Pager/less.pm 2019-10-09 00:25:33.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/less.pm 2020-06-07 17:07:29.000000000 +0200 @@ -1,7 +1,8 @@ package IO::Pager::less; -our $VERSION = 1.01; +our $VERSION = 1.02; use strict; +use warnings; use base qw( IO::Pager::Unbuffered ); BEGIN{ @@ -47,8 +48,8 @@ $!=$@, return 0 if $@ =~ 'pipe'; my $self = tie *$tied_fh, $class, $tied_fh or return 0; - use Data::Dumper; print Dumper 'TIED: ', $$, $self; - CORE::print {$self->{real_fh}} "BOO!"; +#XXX use Data::Dumper; print Dumper 'TIED: ', $$, $self; +#XXX CORE::print {$self->{real_fh}} "BOO!"; { # Truly unbuffered my $saver = SelectSaver->new($self->{real_fh}); $|=1; @@ -68,6 +69,10 @@ join('', @args) ) or die "Could not print to PAGER: $!\n"; } +sub flush { + $_[0]->refresh(); +} + sub _pipe_to_fork ($) { pipe(my $READ, my $WRITE=shift) or die; { # Unbuffer! diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager/tp new/IO-Pager-1.02/lib/IO/Pager/tp --- old/IO-Pager-1.01/lib/IO/Pager/tp 2019-10-08 02:08:57.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager/tp 2019-10-17 04:59:15.000000000 +0200 @@ -1,13 +1,71 @@ #!/usr/local/bin/perl use strict; +use warnings; use IO::Pager::Perl; use Term::ReadKey; +use Getopt::Long; -my $t = IO::Pager::Perl->new(pause=>"\cL", wrap=>1, pause=>"\cL"); +my %Opts = (fold=>1); +(my $LESS = $ENV{LESS}) =~ s/P.+(?:\$|$)//; +$Opts{eof} = 1 if $LESS =~ /e/; +$Opts{statusCol} = 1 if $LESS =~ /J/; +$Opts{lineNo} = 1 if $LESS =~ /N/; +$Opts{raw} = 1 if $LESS =~ /r/; +$Opts{squeeze} = 1 if $LESS =~ /s/; +$Opts{fold} = 0 if $LESS =~ /S/; +$Opts{pause} = "\cL" if $ENV{MORE} =~ /l/; + +my %Long; +#Custom argument processing +{ + no warnings 'uninitialized'; + $Long{shift} = -(grep { /^-\d+$/ } @ARGV)[-1]; + ($Long{jump} = (grep { /^\+\d+$/ } @ARGV)[-1]) =~ s/^\+//; + ($Long{search} = (grep { /^\+\// } @ARGV)[-1]) =~ s%\+/=%%; +} +@ARGV = grep { $_ !~ /^[-+]\d+$|^\+\// } @ARGV; +Getopt::Long::Configure("no_ignore_case"); +GetOptions(\%Long, + (map { "$_!" } split//, 'JSenrs'), # bare + (map { "$_=s" } qw'j p cols'), # args ##rows + 'l:s', + ); +$Long{l} = "\cL" if defined($Long{l}) && $Long{l} eq ''; + +$Opts{eof} = $Long{e} if defined($Long{e}); +$Opts{statusCol} = $Long{J} if defined($Long{J}); +$Opts{pause} = $Long{l} if defined($Long{l}); +$Opts{lineNo} = $Long{n} if defined($Long{n}); +$Opts{raw} = $Long{r} if defined($Long{r}); +$Opts{squeeze} = $Long{s} if defined($Long{s}); +$Opts{shift} = $Long{shift} if defined($Long{shift}); +#$Opts{rows} = $Long{rows} if defined($Long{rows}); +$Opts{cols} = $Long{cols} if defined($Long{cols}); +$Opts{fold} = not $Long{S} if defined($Long{S}); +$Opts{jump} = ($Long{j}||$Long{jump}) + if defined($Long{j})||defined($Long{jump}); +$Opts{search} = $Long{p}||$Long{search} + if defined($Long{p})||defined($Long{search}); + +#use Data::Dumper; print Dumper \%Opts; exit 0; + +my $t = IO::Pager::Perl->new(%Opts); my($PIPE, @F); if( -t STDIN ){ - @F = <ARGV> } +# @F = <ARGV> } + if( scalar(@ARGV) == 1){ + @F = <ARGV> } + else{ + foreach my $file ( @ARGV ){ + my $err; + open(FILE, '<', $file) or $err = $!; + push @F, '='x8 ." $file ".'='x8 ." $err\n", <FILE>; + $F[-1] .= $/ unless $F[-1] =~ /\n$/; + close(FILE); + } + } +} else{ #Separate piped input from keyboard input open($PIPE, '<&=STDIN' ) or die $!; @@ -27,12 +85,145 @@ __END__ =pod -=head1 SEE ALSO - =head1 NAME tp - a pure perl pager +=head1 SYNOPSIS + + tp -[JSenrs] [-cols] [-l[STR]] [-j|+ #] [-p|+/ STR] + +=head1 OPTIONS + +=over 4 + +=item -e + +Exit at end of file. + +=item -f[STR] + +If defined, the pager will pause when the character sequence specified +by STR is encountered in the input text. The default value when enabled +is formfeed i.e; ^L; in order to mimic traditional behavior of L<more/1>. + +You might also supply a regular expression as STR e.g; + + tp -f '[ie]t' + +=item -J + +Add a column with markers indicating which row match a search expression. + +=item -n + +Display line numbering. +Toggleable at run time with I<#>. + +=item -r + +Send raw control characters from input unadulterated to the terminal. +By default, chracters other than tab and newline will be converted to +caret notation e.g; ^@ for null or ^L for form feed. + +=item -s + +Squeeze multiple blank lines into one. + +=item -S + +Do not fold long lines. + +=cut + +=# item -rows + +Set the number of rows for the pager. + +If absent, the terminal is queried directly with L<Term::ReadKey> if +loaded or C<stty> or C<tput>, and if these fail it defaults to 25. + +=pod + +=item -cols + +Set the number of columns for the pager. + +If absent, the terminal is queried directly with L<Term::ReadKey> if +loaded or C<stty> or C<tput>, and if these fail it defaults to 80. + +=back + +=head1 User Interface + +=over + +=item h - help + +=item q - close + +=item r or C-l - refresh + +=item ENTER or down arrow - scroll down one line + +=item d - scroll down one half page + +=item SPACE or C-v - scroll down one page + +=item b or M-v - scroll up one page + +=item u - scroll up one half page + +=item y or up arrow - scroll up one line + +=item g or < - scroll to top + +=item G or > - scroll to bottom + +=item \d+ - jump to line number + +=item left arrow - scroll left + +=item right arrow - scroll right + +=item / - search forward + +=item ? - search backward + +=item n or P - next match + +=item p or N - previous match + +=item # - toggle line-numbering + +=item S - toggle folding + +=item C - toggle raw/cooked output + +=item m - save mark + +=item ' - goto mark + +Special marks + +=over 4 + +=item ^ Beginning of file + +=item $ End of file + +=item ' Previous location + +=item " List user-created marks + +=back + +=back + +=head1 ENVIRONMENT + +tp checks the I<LESS>, I<MORE>, I<TERM> and I<TERMCAP> variables. + =head1 SEE ALSO L<IO::Pager::Perl>, L<less(1)> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/lib/IO/Pager.pm new/IO-Pager-1.02/lib/IO/Pager.pm --- old/IO-Pager-1.01/lib/IO/Pager.pm 2019-10-09 00:24:02.000000000 +0200 +++ new/IO-Pager-1.02/lib/IO/Pager.pm 2020-06-07 17:38:05.000000000 +0200 @@ -1,8 +1,9 @@ package IO::Pager; -our $VERSION = "1.01"; #Untouched since 1.00 +our $VERSION = "1.02"; #Untouched since 1.02 use 5.008; #At least, for decent perlio, and other modernisms use strict; +use warnings; use base qw( Tie::Handle ); use Env qw( PAGER ); use File::Spec; @@ -20,7 +21,8 @@ #Permit explicit use of pure perl pager local $_ = 'IO::Pager::less'; - return $_ if $_[0] eq $_ or $PAGER eq $_; + return $_ if (defined($_[0]) && ($_[0] eq $_)) or + (defined($PAGER) && ($PAGER eq $_)); # Use File::Which if available (strongly recommended) my $which = eval { require File::Which }; @@ -75,7 +77,7 @@ return $io_pager; } -#Should have this as first block for clarity, but not with its use of a sub :-/ +#Should have this as first block for clarity, but not with its use of a sub BEGIN { # Set the $ENV{PAGER} to something reasonable $PAGER = find_pager(); @@ -161,7 +163,8 @@ # if( $tied_fh =~ /\*(?:\w+::)?STD(?:OUT|ERR)$/ ){ # open($dupe_fh, '>&', $tied_fh) or warn "Unable to dupe $tied_fh"; # } - if ( $child = CORE::open($real_fh, '|-', $PAGER) ){ + do{ no warnings; $child = CORE::open($real_fh, '|-', $PAGER) }; + if ( $child ){ my @oLayers = PerlIO::get_layers($tied_fh, details=>1, output=>1); my $layers = ''; for(my $i=0;$i<$#oLayers;$i+=3){ @@ -256,7 +259,7 @@ # *{$self->{tied_fh}} = *{$self->{dupe_fh}}; } -*DESTROY = \&CLOSE; +{ no warnings 'once'; *DESTROY = \&CLOSE; } #Non-IO methods @@ -280,7 +283,7 @@ =head1 NAME -IO::Pager - Select a pager and pipe text to it if destination is a TTY +IO::Pager - Select a pager (possibly perl-based) & pipe it text if a TTY =head1 SYNOPSIS @@ -543,12 +546,6 @@ =item 4. Term::Pager via IO::Pager::Perl -=cut - -If instantiating an IO::Pager object and Term::Pager version 1.5 or greater is -available, L<IO::Pager::Perl> will be used. - -=pod You may also set $ENV{PAGER} to Term::Pager to select this extensible, pure perl pager for display. @@ -590,7 +587,7 @@ =head1 COPYRIGHT AND LICENSE -Copyright (C) 2003-2019 Jerrad Pierce +Copyright (C) 2003-2020 Jerrad Pierce =over diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/t/08-redirect.t new/IO-Pager-1.02/t/08-redirect.t --- old/IO-Pager-1.01/t/08-redirect.t 2017-05-13 17:49:59.000000000 +0200 +++ new/IO-Pager-1.02/t/08-redirect.t 2020-06-06 17:39:01.000000000 +0200 @@ -12,7 +12,8 @@ #Print the heredoc in 08-redirect.pl to temp file via redirection my $q = q[']; $q = q["] if $^O =~ /MSWin32/; -system qq($^X -Mblib -MIO::Pager::Page -e $q require q[./t/08-redirect.pl]; print \$txt $q >$tempname); +my $blib = -e "blib" ? '-Mblib' : ''; +system qq("$^X" $blib -MIO::Pager::Page -e $q require q[./t/08-redirect.pl]; print \$txt $q >$tempname); open(TMP, $tempname) or die "Could not open tmpfile: $!\n"; my $slurp = do{ undef $/; <TMP> }; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/t/09-open.t new/IO-Pager-1.02/t/09-open.t --- old/IO-Pager-1.01/t/09-open.t 2017-04-26 02:00:32.000000000 +0200 +++ new/IO-Pager-1.02/t/09-open.t 2020-06-06 19:11:29.000000000 +0200 @@ -4,7 +4,6 @@ use Test::More 0.88; require './t/TestUtils.pm'; t::TestUtils->import(); -no warnings; $^W = 0; #Avoid: Can't exec "/dev/null": Permission denied use IO::Pager; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/t/11-redirect-oo.t new/IO-Pager-1.02/t/11-redirect-oo.t --- old/IO-Pager-1.01/t/11-redirect-oo.t 2019-09-30 15:15:07.000000000 +0200 +++ new/IO-Pager-1.02/t/11-redirect-oo.t 2020-06-06 18:48:43.000000000 +0200 @@ -27,7 +27,7 @@ skip_no_tty(); our $txt; require './t/08-redirect.pl'; - cmp_ok($txt, 'eq', $slurp, 'Redirection with OO') || $^O =~ /MSWin32/ && + cmp_ok($slurp, 'eq', $txt, 'Redirection with OO') || $^O =~ /MSWin32/ && diag("If this test fails on Windows and all others pass, things are probably good. CMD appends an extra newline to redirected output."); } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/IO-Pager-1.01/t/16-PurePerl_interactive.t new/IO-Pager-1.02/t/16-PurePerl_interactive.t --- old/IO-Pager-1.01/t/16-PurePerl_interactive.t 2019-10-09 00:28:12.000000000 +0200 +++ new/IO-Pager-1.02/t/16-PurePerl_interactive.t 2020-06-07 20:01:58.000000000 +0200 @@ -18,28 +18,19 @@ my $BOB = new IO::Pager local *STDOUT, 'less' or die "Failed to create PAGER FH $!"; isa_ok $BOB, 'IO::Pager::less'; - - $BOB->print("OO factory filehandle\n") foreach 1..25; + + #XXX No longer needed with return of control to host loop instead of + #XXX repeating input loop, but cannot hurt to preserve the instructions + warn "\n\nCurrent IO::Pager::Less is suboptimal \e[7;5m*** Press Ctrl-L to refresh ***\e[0m\n\n\n"; + + $BOB->print("This pager is implemented in perl\n") foreach 1..25; $BOB->print("\nEnd of text, try pressing 'Q' to exit.\n"); } select STDERR; - my $A1 = prompt("\nDid you see 'OO factory filehandle' in your pager? [Yn]"); + my $A1 = prompt("\nDid you see 'This pager is implemented in perl' in a pager? [Yn]"); ok is_yes($A1), 'OO, factory instantiation'; - { - my $BOB = new IO::Pager::less or die "Failed to create PAGER FH $!"; - - isa_ok $BOB, 'IO::Pager::less'; - - $BOB->say("OO subclass filehandle") foreach 1..25; - $BOB->say("\nEnd of text, try pressing 'Q' to exit."); - #XXX Close required because pager is not terminated on DESTROY - $BOB->close(); - } - - my $A2 = prompt("\nDid you see 'OO subclass filehandle' in your pager? [Yn]"); - ok is_yes($A2), 'OO, subclass instantiation'; } done_testing;
