Bug #32816 for Shell-Base: [PATCH] accept Term::ReadLine::Perl besides T::RL::Gnu

Hi, Darren. You find attached a patch with a few changes which should improve the count of passing tests of Shell-Base distribution as seen at: http://cpantesters.perl.org/show/Shell-Base.html#Shell-Base-0.05 This is what the patch does: * replaces Term::Size (which has a horrible record of failures on CPAN Testers too - http://cpantesters.perl.org/show/Term-Size.html#Term-Size-0.2) by Term::Size::Any (which builds and tests cleanly in both Unix and Windows - http://cpantesters.perl.org/show/Term-Size-Any.html - and you might like to see the pages of Term-Size-Perl and Term-Size-Win32 as well). * After studied a code for a while, I discovered its dependency on Term::ReadLine::Gnu (as you have found yourself at http://rt.cpan.org/Public/Bug/Display.html?id=19649) was not that essential. So I coded around the gnu-isms of your code and ended up with a version which works with Term::Size::Perl as well. I also tweaked the tests to get rid of some Gnu particularities as well. You may find out that it works ok in a machine with both Term::Size::Gnu and Term::Size::Perl installed by doing $ perl Makefile.PL $ make test # will use Term::ReadLine::Gnu as the preferred option $ PERL_RL=Perl make test # will use Term::ReadLine::Perl as requested explicitly (Well, there may arise a bunch of warnings when using Term::ReadLine::Perl like Unable to get Terminal Size. The TIOCGWINSZ ioctl didn't work. The COLUMNS and LINES environment variables didn't work. The resize program didn't work. at /usr/lib/perl5/Term/ReadKey.pm line 362. but that's not Shell::Base fault.) So I leave this to your appreciation. Kind regards, Adriano Ferreira diff -ru Shell-Base-0.05/Base.pm Shell-Base/Base.pm --- Shell-Base-0.05/Base.pm 2004-09-21 08:14:03.000000000 -0300 +++ Shell-Base/Base.pm 2008-01-30 20:04:52.000000000 -0200 @@ -19,7 +19,7 @@ use Env qw($PAGER $SHELL $COLUMNS); use IO::File; use File::Basename qw(basename); -use Term::Size qw(chars); +use Term::Size::Any qw(chars); use Text::Shellwords qw(shellwords); $VERSION = 0.05; # $Date: 2004/08/26 20:01:47 $ @@ -130,6 +130,56 @@ } # ---------------------------------------------------------------------- +# _read_history($histfile) +# +# Adds the content of $histfile to the history list +# of the Term::ReadLine instance. +# +# For Term::ReadLine::Gnu, it only delegates to ReadHistory() +# method. +# +# For other Term::ReadLine::* which support SetHistory(), +# the file is read and the history set in this method. +# +# ---------------------------------------------------------------------- +sub _read_history { + my ($self, $h) = @_; + if ( $self->term->can('ReadHistory') ) { # T::RL::Gnu does + $self->term->ReadHistory($h); + } else { + if ( -e $h ) { + require File::Slurp; + my @h = File::Slurp::read_file($h); + $self->term->SetHistory(@h); + } + } + +# ---------------------------------------------------------------------- +# _write_history($histfile) +# +# Writes the current history to $histfile. +# +# For Term::ReadLine::Gnu, it only delegates to WriteHistory() +# method. +# +# For other Term::ReadLine::* which support GetHistory(), +# the history is got and the writing is done in this method. +# +# ---------------------------------------------------------------------- +sub _write_history { + my ($self, $h) = @_; + if ( $self->term->can('WriteHistory') ) { # T::RL::Gnu does + $self->term->WriteHistory($h); + } else { + require File::Slurp; + my @h = $self->term->GetHistory(); + File::Slurp::write_file($h, @h); + } +} + + +# ---------------------------------------------------------------------- # init_rl(\%args) # # Initialize Term::ReadLine. Subclasses can override this method if @@ -150,7 +200,7 @@ if (my $histfile = $args->{ HISTFILE }) { $self->histfile($histfile); - $term->ReadHistory($histfile); + $self->_read_history($histfile); } return $self; @@ -451,7 +501,7 @@ if (my $h = $self->histfile) { # XXX Can this be better encapsulated? - $self->term->WriteHistory($h); + $self->_write_history($h); } exit($status); @@ -519,7 +569,7 @@ # ---------------------------------------------------------------------- sub prompt_no { my $self = shift; - return $self->term->where_history(); + return scalar $self->term->GetHistory(); } # -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- diff -ru Shell-Base-0.05/Changes Shell-Base/Changes --- Shell-Base-0.05/Changes 2004-09-21 08:08:29.000000000 -0300 +++ Shell-Base/Changes 2008-01-30 20:12:43.000000000 -0200 @@ -5,6 +5,17 @@ # ---------------------------------------------------------------------- # ---------------------------------------------------------------------- +# Version ?? +# ---------------------------------------------------------------------- + +* dependency on Term::Size replaced by Term::Size::Any + (which works at Unix and Windows) +* removed the gnu-isms of code, allowing other Term::ReadLine::* + packages to be used (if they support GetHistory and SetHistory) +* added a dependency on File::Slurp for reading/writing + history files + +# ---------------------------------------------------------------------- # Version 0.05 September 21, 2004 # ---------------------------------------------------------------------- diff -ru Shell-Base-0.05/Makefile.PL Shell-Base/Makefile.PL --- Shell-Base-0.05/Makefile.PL 2004-09-21 08:16:17.000000000 -0300 +++ Shell-Base/Makefile.PL 2008-01-30 20:05:38.000000000 -0200 @@ -13,9 +13,10 @@ 'Env' => 0, 'IO::File' => 0, 'Term::ReadLine' => 0, - 'Term::Size' => 0.2, + 'Term::Size::Any' => 0, 'Text::Shellwords' => 0, 'Text::Wrap' => 0, + 'File::Slurp' => 0, # needed only with T::RL::Perl ); my %clean = ( diff -ru Shell-Base-0.05/t/init_rl.t Shell-Base/t/init_rl.t --- Shell-Base-0.05/t/init_rl.t 2003-02-14 18:38:34.000000000 -0200 +++ Shell-Base/t/init_rl.t 2008-01-30 19:45:10.000000000 -0200 @@ -23,7 +23,8 @@ # If history is enabled, then the history_length attribute will # be set. -is($sh->term->{'history_length'}, wc($histfile), +my $history_length = $sh->term->GetHistory; +is($history_length, wc($histfile), "history file was loaded correctly"); sub wc { diff -ru Shell-Base-0.05/t/term.t Shell-Base/t/term.t --- Shell-Base-0.05/t/term.t 2003-02-14 18:38:34.000000000 -0200 +++ Shell-Base/t/term.t 2008-01-30 20:06:55.000000000 -0200 @@ -13,4 +13,13 @@ my $shell = Shell::Base->new; my $term = $shell->term; ok(defined $term, '$self->term() returns something useful'); -ok($term->isa("Term::ReadLine"), '$self->term() returns something readline-ish'); + +# It would be nice if a Term::ReadLine::* instance +# could be tested only by asking if $term->isa('Term::ReadLine') +# but it not that simple. It works for Term::ReadLine::Gnu +# but not for Term::ReadLine::Perl. +# That explains the convoluted test below. + +like(ref $term, '/\ATerm::ReadLine/', '$self->term() returns something readline-ish'); +# this might help failure diagnostics +diag( "using ", $term->ReadLine );