Merge branch 'blead' of ssh://perl5.git.perl.org/gitroot/perl into blead

9 files changed, 235 insertions, 139 deletions

diff --git a/MANIFEST b/MANIFEST
index 92efe61391..449b5904dc 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3479,8 +3479,9 @@ dist/Storable/t/weak.t			Can Storable store weakrefs
 dist/Term-Complete/lib/Term/Complete.pm	A command completion subroutine
 dist/Term-Complete/t/Complete.t		See if Term::Complete works
 dist/Term-ReadLine/lib/Term/ReadLine.pm		Stub readline library
+dist/Term-ReadLine/t/AE.t			See if Term::ReadLine works
+dist/Term-ReadLine/t/AETk.t			See if Term::ReadLine works
 dist/Term-ReadLine/t/ReadLine.t			See if Term::ReadLine works
-dist/Term-ReadLine/t/TkExternal.t	Test Tk
 dist/Term-ReadLine/t/Tk.t			See if Term::ReadLine works
 dist/Text-Abbrev/lib/Text/Abbrev.pm		An abbreviation table builder
 dist/Text-Abbrev/t/Abbrev.t		Test Text::Abbrev
diff --git a/Porting/corelist-perldelta.pl b/Porting/corelist-perldelta.pl
index 15b63f1175..44b6ea7ddc 100755
--- a/Porting/corelist-perldelta.pl
+++ b/Porting/corelist-perldelta.pl
@@ -6,7 +6,29 @@ use lib 'Porting';
 use Maintainers qw/%Modules/;
 use Module::CoreList;
 use Getopt::Long;
-require Algorithm::Diff;
+
+=head1 USAGE
+
+  # generate the module changes for the Perl you are currently building
+  ./perl Porting/corelist-perldelta.pl
+  
+  # generate a diff between the corelist sections of two perldelta* files:
+  perl Porting/corelist-perldelta.pl --mode=check 5.17.1 5.17.2 <perl5172delta.pod
+
+=head1 ABOUT
+
+corelist-perldelta.pl is a bit schizophrenic. The part to generate the
+new Perldelta text does not need Algorithm::Diff, but wants to be
+run with the freshly built Perl.
+
+The part to check the diff wants to be run with a Perl that has an up-to-date
+L<Module::CoreList>, but needs the outside L<Algorithm::Diff>.
+
+Ideally, the program will be split into two separate programs, one
+to generate the text and one to show the diff between the 
+corelist sections of the last perldelta and the next perldelta.
+
+=cut
 
 my %sections = (
   new     => qr/New Modules and Pragma(ta)?/,
@@ -158,6 +180,7 @@ sub do_check {
 
     printf $ck->[0] . ":\n";
 
+    require Algorithm::Diff;
     my $diff = Algorithm::Diff->new(map {
       [map { join q{ } => grep defined, @{ $_ } } @{ $_ }]
     } \@delta, \@corelist);
diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
index 7262596a50..f1b1419891 100644
--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
@@ -111,12 +111,48 @@ additional methods:
 
 =item C<tkRunning>
 
-makes Tk's event loop run when waiting for user input (i.e., during
-the C<readline> method).
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method).
 
-Term::ReadLine supports any event loop, including unpubished ones and
-simple IO::Select loops without the need to rewrite existing code for
-any particular framework.  See IN(), print_prompt(), and get_line().
+=item C<event_loop>
+
+Registers call-backs to wait for user input (i.e., during C<readline>
+method).  This supercedes tkRunning.
+
+The first call-back registered is the call back for waiting.  It is
+expected that the callback will call the current event loop until
+there is something waiting to get on the input filehandle.  The parameter
+passed in is the return value of the second call back.
+
+The second call-back registered is the call back for registration.  The
+input filehandle (often STDIN, but not necessarily) will be passed in.
+
+For example, with AnyEvent:
+
+  $term->event_loop(sub {
+    my $data = shift;
+    $data->[1] = AE::cv();
+    $data->[1]->recv();
+  }, sub {
+    my $fh = shift;
+    my $data = [];
+    $data->[0] = AE::io($fh, 0, sub { $data->[1]->send() });
+    $data;
+  });
+
+The second call-back is optional if the call back is registered prior to
+the call to $term-E<gt>readline.
+
+Deregistration is done in this case by calling event_loop with C<undef>
+as its parameter:
+
+    $term->event_loop(undef);
+
+This will cause the data array ref to be removed, allowing normal garbage
+collection to clean it up.  With AnyEvent, that will cause $data->[0] to
+be cleaned up, and AnyEvent will automatically cancel the watcher at that
+time.  If another loop requires more than that to clean up a file watcher,
+that will be up to the caller to handle.
 
 =item C<ornaments>
 
@@ -131,59 +167,11 @@ standout, last two to make the input line standout.
 takes two arguments which are input filehandle and output filehandle.
 Switches to use these filehandles.
 
-=item C<print_prompt>
-
-prints a prompt and returns immediately.  readline() uses it to print
-its prompt before calling get_line().  See L</"Using Event Loops"> for
-an example of its use.
-
-=item C<get_line>
-
-gets a line of input from the terminal.  If Tk is used and tkRunning()
-has been set, then get_line() will dispatch Tk events while waiting
-for a line of input.  The full readline() API is a print_prompt() call
-followed immediately by get_input().  See L</"Using Event Loops">.
-
 =back
 
 One can check whether the currently loaded ReadLine package supports
 these methods by checking for corresponding C<Features>.
 
-=head1 Using Event Loops
-
-Term::ReadLine provides IN(), print_prompt(), and get_line() so that
-it may be used by any event loop that can watch for input on a file
-handle.  This includes most event loops including ones that haven't
-been published.
-
-Term::ReadLine's readline() method prints a prompt and returns a line
-of input got from its input filehandle:
-
-  sub readline {
-    my ($self,$prompt) = @_;
-    $self->print_prompt($prompt);
-    $self->get_line();
-  }
-
-A Tk readline function may be implemented by having Tk dispatch its
-own events between the time the prompt is printed and the line is got.
-This example function dispatches Tk events while Term::ReadLine waits
-for console input.  It can completely replace Term::ReadLine's
-existing Tk support.
-
-  sub tk_read_line {
-    my ($term, $prompt) = @_;
-    $term->print_prompt($prompt);
-
-    my $got_input;
-    Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
-    Tk::DoOneEvent(0) until $got_input;
-
-    return $term->get_line();
-  }
-
-Other event loops are equally possible.
-
 =head1 EXPORTS
 
 None
@@ -202,8 +190,8 @@ be C<o=0> or C<ornaments=0>.  The head should be as described above, say
 If the variable is not set, or if the head of space-separated list is
 empty, the best available package is loaded.
 
-  export "PERL_RL=Perl o=0"	# Use Perl ReadLine without ornaments
-  export "PERL_RL= o=0"		# Use best available ReadLine without ornaments
+  export "PERL_RL=Perl o=0" # Use Perl ReadLine sans ornaments
+  export "PERL_RL= o=0"     # Use best available ReadLine sans ornaments
 
 (Note that processing of C<PERL_RL> for ornaments is in the discretion of the 
 particular used C<Term::ReadLine::*> package).
@@ -219,17 +207,25 @@ $DB::emacs = $DB::emacs;	# To peacify -w
 our @rl_term_set;
 *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
 
-sub print_prompt {
-  my ($self, $prompt) = @_;
-  my $out = $self->[1];
-  print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
-}
+sub PERL_UNICODE_STDIN () { 0x0001 }
 
 sub ReadLine {'Term::ReadLine::Stub'}
 sub readline {
-  my ($self,$prompt) = @_;
-  $self->print_prompt($prompt);
-  $self->get_line();
+  my $self = shift;
+  my ($in,$out,$str) = @$self;
+  my $prompt = shift;
+  print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2]; 
+  $self->register_Tk 
+     if not $Term::ReadLine::registered and $Term::ReadLine::toloop;
+  #$str = scalar <$in>;
+  $str = $self->get_line;
+  utf8::upgrade($str)
+      if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) &&
+         utf8::valid($str);
+  print $out $rl_term_set[3]; 
+  # bug in 5.000: chomping empty string creats length -1:
+  chomp $str if defined $str;
+  $str;
 }
 sub addhistory {}
 
@@ -331,7 +327,7 @@ sub Features { \%features }
 
 package Term::ReadLine;		# So late to allow the above code be defined?
 
-our $VERSION = '1.08';
+our $VERSION = '1.09';
 
 my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
 if ($which) {
@@ -407,22 +403,35 @@ package Term::ReadLine::Tk;
 # the$term->IN() accessor becomes ready for reading.  It's assumed
 # that the diamond operator will return a line of input immediately at
 # that point.
-#
-# Any event loop can use $term-IN() and $term->readline() directly
-# without adding code for any event loop specifically to this.
 
 my ($giveup);
 
 # maybe in the future the Tk-specific aspects will be removed.
 sub Tk_loop{
-    Tk::DoOneEvent(0) until $giveup;
-    $giveup = 0;
+    if (ref $Term::ReadLine::toloop)
+    {
+        $Term::ReadLine::toloop->[0]->($Term::ReadLine::toloop->[2]);
+    }
+    else
+    {
+        Tk::DoOneEvent(0) until $giveup;
+        $giveup = 0;
+    }
 };
 
 sub register_Tk {
     my $self = shift;
-    $Term::ReadLine::registered++
-        or Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+    unless ($Term::ReadLine::registered++)
+    {
+        if (ref $Term::ReadLine::toloop)
+        {
+            $Term::ReadLine::toloop->[2] = $Term::ReadLine::toloop->[1]->($self->IN) if $Term::ReadLine::toloop->[1];
+        }
+        else
+        {
+            Tk->fileevent($self->IN,'readable',sub { $giveup = 1});
+        }
+    }
 };
 
 sub tkRunning {
@@ -430,6 +439,25 @@ sub tkRunning {
   $Term::ReadLine::toloop;
 }
 
+sub event_loop {
+    shift;
+
+    # T::RL::Gnu and T::RL::Perl check that this exists, if not,
+    # it doesn't call the loop.  Those modules will need to be
+    # fixed before this can be removed.
+    if (not defined &Tk::DoOneEvent)
+    {
+        *Tk::DoOneEvent = sub {
+            die "what?"; # this shouldn't be called.
+        }
+    }
+
+    # store the callback in toloop, again so that other modules will
+    # recognise it and call us for the loop.
+    $Term::ReadLine::toloop = [ @_ ] if @_ > 1;
+    $Term::ReadLine::toloop;
+}
+
 sub PERL_UNICODE_STDIN () { 0x0001 }
 
 sub get_line {
diff --git a/dist/Term-ReadLine/t/AE.t b/dist/Term-ReadLine/t/AE.t
new file mode 100644
index 0000000000..8fccecb587
--- /dev/null
+++ b/dist/Term-ReadLine/t/AE.t
@@ -0,0 +1,43 @@
+#!perl
+
+use Test::More;
+
+eval "use AnyEvent; 1" or
+    plan skip_all => "AnyEvent is not installed.";
+
+# seeing as the entire point of this test is to test the event handler,
+# we need to mock as little as possible.  To keep things tightly controlled,
+# we'll use the Stub directly.
+BEGIN {
+    $ENV{PERL_RL} = 'Stub o=0';
+}
+plan tests => 3;
+
+# need to delay this so that AE is loaded first.
+require Term::ReadLine;
+use File::Spec;
+
+my $t = Term::ReadLine->new('AE');
+ok($t, "Created object");
+is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
+
+my ($cv, $fe);
+$t->event_loop(
+               sub {
+                   $cv = AE::cv();
+                   $cv->recv();
+               }, sub {
+                   my $fh = shift;
+                   $fe ||= AE::io($fh, 0, sub { $cv->send() });
+               }
+              );
+
+my $text = 'some text';
+my $T = $text . "\n";
+my $w = AE::timer(0,1,sub { 
+pass("Event loop called");
+exit 0;
+});
+
+my $result = $t->readline('Do not press enter>');
+fail("Should not get here.");
diff --git a/dist/Term-ReadLine/t/AETk.t b/dist/Term-ReadLine/t/AETk.t
new file mode 100644
index 0000000000..80bab63a94
--- /dev/null
+++ b/dist/Term-ReadLine/t/AETk.t
@@ -0,0 +1,52 @@
+#!perl
+
+use Test::More;
+
+eval "use Tk; use AnyEvent; 1" or
+    plan skip_all => "AnyEvent and/or Tk is not installed.";
+
+# seeing as the entire point of this test is to test the event handler,
+# we need to mock as little as possible.  To keep things tightly controlled,
+# we'll use the Stub directly.
+BEGIN {
+    $ENV{PERL_RL} = 'Stub o=0';
+    # ensure AE uses Tk.
+    $ENV{PERL_ANYEVENT_MODEL} = 'Tk';
+}
+
+eval {
+    use File::Spec;
+    my $mw = MainWindow->new(); $mw->withdraw();
+    1;
+} or plan skip_all => "Tk can't start. DISPLAY not set?";
+
+plan tests => 3;
+
+# need to delay this so that AE is loaded first.
+require Term::ReadLine;
+use File::Spec;
+
+my $t = Term::ReadLine->new('AE/Tk');
+ok($t, "Created object");
+is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
+my ($cv, $fe);
+$t->event_loop(
+               sub {
+                   $cv = AE::cv();
+                   $cv->recv();
+               }, sub {
+                   my $fh = shift;
+                   $fe ||= AE::io($fh, 0, sub { $cv->send() });
+               }
+              );
+
+
+my $text = 'some text';
+my $T = $text . "\n";
+my $w = AE::timer(0,1,sub { 
+pass("Event loop called");
+exit 0;
+});
+
+my $result = $t->readline('Do not press enter>');
+fail("Should not get here.");
diff --git a/dist/Term-ReadLine/t/TkExternal.t b/dist/Term-ReadLine/t/TkExternal.t
deleted file mode 100644
index 7c4cf69773..0000000000
--- a/dist/Term-ReadLine/t/TkExternal.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!perl
-
-use Test::More;
-
-eval "use Tk; 1" or
-    plan skip_all => "Tk is not installed.";
-
-# seeing as the entire point of this test is to test the event handler,
-# we need to mock as little as possible.  To keep things tightly controlled,
-# we'll use the Stub directly.
-BEGIN {
-    $ENV{PERL_RL} = 'Stub o=0';
-}
-
-my $mw;
-eval {
-    use File::Spec;
-    $mw = MainWindow->new(); $mw->withdraw();
-    1;
-} or plan skip_all => "Tk can't start. DISPLAY not set?";
-
-# need to delay this so that Tk is loaded first.
-require Term::ReadLine;
-
-plan tests => 3;
-
-my $t = Term::ReadLine->new('Tk');
-ok($t, "Created object");
-is($t->ReadLine, 'Term::ReadLine::Stub', 'Correct type');
-
-# This test will dispatch Tk events externally.
-$t->tkRunning(0);
-
-my $text = 'some text';
-my $T = $text . "\n";
-
-my $w = Tk::after($mw,0,
-                  sub {
-                      pass("Event loop called");
-                      exit 0;
-                  });
-
-my $result = tk_readline($t, 'Do not press enter>');
-fail("Should not get here.");
-
-# A Tk-dispatching readline that doesn't require Tk (or any other
-# event loop) support to be hard-coded into Term::ReadLine.
-
-sub tk_readline {
-  my ($term, $prompt) = @_;
-
-  $term->print_prompt($prompt);
-
-  my $got_input;
-  Tk->fileevent($term->IN, 'readable', sub { $got_input = 1 });
-  Tk::DoOneEvent(0) until $got_input;
-
-  return $term->get_line();
-}
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index 8fc74a439b..c16b6573e7 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -325,7 +325,16 @@ sub pod2html {
             or die "$0: error open $Dircache for writing: $!\n";
 
         print $cache join(":", @Podpath) . "\n$Podroot\n";
+        my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/);
         foreach my $key (keys %Pages) {
+            if($_updirs_only) {
+              my $_dirlevel = $Podroot;
+              while($_dirlevel =~ /\.\./) {
+                $_dirlevel =~ s/\.\.//;
+                # Assume $Pages{$key} has '/' separators (html dir separators).
+                $Pages{$key} =~ s/^[\w\s\-]+\///;
+              }
+            }
             print $cache "$key $Pages{$key}\n";
         }
 
diff --git a/ext/Pod-Html/t/pod2html-lib.pl b/ext/Pod-Html/t/pod2html-lib.pl
index 0327e2bde3..b7067daaec 100644
--- a/ext/Pod-Html/t/pod2html-lib.pl
+++ b/ext/Pod-Html/t/pod2html-lib.pl
@@ -33,11 +33,11 @@ sub convert_n_test {
     my $cwd = Cwd::cwd();
     my ($vol, $dir) = splitpath($cwd, 1);
     my $relcwd = substr($dir, length(File::Spec->rootdir()));
-	
-    my $new_dir  = catdir $cwd, "t";
-    my $infile   = catfile $new_dir, "$podfile.pod";
-    my $outfile  = catfile $new_dir, "$podfile.html";
-    
+
+    my $new_dir  = catdir $dir, "t";
+    my $infile   = catpath $vol, $new_dir, "$podfile.pod";
+    my $outfile  = catpath $vol, $new_dir, "$podfile.html";
+
     # To add/modify args to p2h, use @p2h_args
     Pod::Html::pod2html(
         "--infile=$infile",
diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat
index 4046d3a60b..2270d9f6b9 100644
--- a/t/porting/known_pod_issues.dat
+++ b/t/porting/known_pod_issues.dat
@@ -1,4 +1,4 @@
-# This file is the data file for t/porting/podcheck.t.
+# This file is the data file for porting/podcheck.t.
 # There are three types of lines.
 # Comment lines are white-space only or begin with a '#', like this one.  Any
 #   changes you make to the comment lines will be lost when the file is
@@ -172,7 +172,6 @@ dist/safe/safe.pm	Verbatim line length including indents exceeds 79 by	1
 dist/safe/safe.pm	empty section in previous paragraph	1
 dist/selfloader/lib/selfloader.pm	Verbatim line length including indents exceeds 79 by	13
 dist/storable/storable.pm	Verbatim line length including indents exceeds 79 by	4
-dist/term-readline/lib/term/readline.pm	Verbatim line length including indents exceeds 79 by	1
 dist/thread-queue/lib/thread/queue.pm	Verbatim line length including indents exceeds 79 by	4
 dist/threads/lib/threads.pm	Verbatim line length including indents exceeds 79 by	3
 dist/tie-file/lib/tie/file.pm	Verbatim line length including indents exceeds 79 by	3