Re: [PATCH] Make the 'sort' pragma lexically scoped
[p5sagit/p5-mst-13.2.git] / lib / Pod / Parser.pm
index 85551fa..a5fde84 100644 (file)
@@ -10,7 +10,7 @@
 package Pod::Parser;
 
 use vars qw($VERSION);
-$VERSION = 1.13;  ## Current version of this package
+$VERSION = 1.32;  ## Current version of this package
 require  5.005;    ## requires this Perl version or later
 
 #############################################################################
@@ -788,13 +788,15 @@ sub parse_text {
         ## Look for the beginning of a sequence
         if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
             ## Push a new sequence onto the stack of those "in-progress"
-            ($cmd, $ldelim) = ($1, $2);
+            my $ldelim_orig;
+            ($cmd, $ldelim_orig) = ($1, $2);
+            ($ldelim = $ldelim_orig) =~ s/\s+$//;
+            ($rdelim = $ldelim) =~ tr/</>/;
             $seq = Pod::InteriorSequence->new(
                        -name   => $cmd,
-                       -ldelim => $ldelim,  -rdelim => '',
+                       -ldelim => $ldelim_orig,  -rdelim => $rdelim,
                        -file   => $file,    -line   => $line
                    );
-            $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
             (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
             push @seq_stack, $seq;
         }
@@ -827,9 +829,13 @@ sub parse_text {
                 $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
                                                    : $seq);
                 ## Remember the current cmd-name and left-delimiter
-                $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
-                $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
-                $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
+                if(@seq_stack > 1) {
+                    $cmd = $seq_stack[-1]->name;
+                    $ldelim = $seq_stack[-1]->ldelim;
+                    $rdelim = $seq_stack[-1]->rdelim;
+                } else {
+                    $cmd = $ldelim = $rdelim = '';
+                }
             }
         }
         elsif (length) {
@@ -1060,7 +1066,6 @@ sub parse_from_filehandle {
     while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
         $textline = $self->preprocess_line($textline, ++$nlines);
         next  unless ((defined $textline)  &&  (length $textline));
-        $_ = $paragraph;  ## save previous contents
 
         if ((! length $paragraph) && ($textline =~ /^==/)) {
             ## '==' denotes a one-line command paragraph
@@ -1140,6 +1145,8 @@ performed). If the special output filename ">&STDERR" is given then the
 STDERR filehandle is used for output (and no open or close is
 performed). If no output filehandle is currently in use and no output
 filename is specified, then "-" is implied.
+Alternatively, an L<IO::String> object is also accepted as an output
+file handle.
 
 This method does I<not> usually need to be overridden by subclasses.
 
@@ -1149,24 +1156,29 @@ sub parse_from_file {
     my $self = shift;
     my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
     my ($infile, $outfile) = @_;
-    my ($in_fh,  $out_fh) = (gensym, gensym)  if ($] < 5.6);
+    my ($in_fh,  $out_fh) = (gensym(), gensym())  if ($] < 5.006);
     my ($close_input, $close_output) = (0, 0);
     local *myData = $self;
-    local $_;
+    local *_;
 
     ## Is $infile a filename or a (possibly implied) filehandle
-    $infile  = '-'  unless ((defined $infile)  && (length $infile));
-    if (($infile  eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
-        ## Not a filename, just a string implying STDIN
-        $myData{_INFILE} = "<standard input>";
-        $in_fh = \*STDIN;
-    }
-    elsif (ref $infile) {
+    if (defined $infile && ref $infile) {
+        if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
+            croak "Input from $1 reference not supported!\n";
+        }
         ## Must be a filehandle-ref (or else assume its a ref to an object
         ## that supports the common IO read operations).
         $myData{_INFILE} = ${$infile};
         $in_fh = $infile;
     }
+    elsif (!defined($infile) || !length($infile) || ($infile eq '-')
+        || ($infile =~ /^<&(?:STDIN|0)$/i))
+    {
+        ## Not a filename, just a string implying STDIN
+        $infile ||= '-';
+        $myData{_INFILE} = "<standard input>";
+        $in_fh = \*STDIN;
+    }
     else {
         ## We have a filename, open it for reading
         $myData{_INFILE} = $infile;
@@ -1180,38 +1192,54 @@ sub parse_from_file {
     ## the entire document (but *not* if this is an included file). We
     ## determine this by seeing if the input stream stack has been set-up
     ## already
-    ## 
-    unless ((defined $outfile) && (length $outfile)) {
-        (defined $myData{_TOP_STREAM}) && ($out_fh  = $myData{_OUTPUT})
-                                       || ($outfile = '-');
-    }
-    ## Is $outfile a filename or a (possibly implied) filehandle
-    if ((defined $outfile) && (length $outfile)) {
-        if (($outfile  eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
-            ## Not a filename, just a string implying STDOUT
-            $myData{_OUTFILE} = "<standard output>";
-            $out_fh  = \*STDOUT;
+
+    ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
+    if (ref $outfile) {
+        ## we need to check for ref() first, as other checks involve reading
+        if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
+            croak "Output to $1 reference not supported!\n";
         }
-        elsif ($outfile =~ /^>&(STDERR|2)$/i) {
-            ## Not a filename, just a string implying STDERR
-            $myData{_OUTFILE} = "<standard error>";
-            $out_fh  = \*STDERR;
+        elsif (ref($outfile) eq 'SCALAR') {
+#           # NOTE: IO::String isn't a part of the perl distribution,
+#           #       so probably we shouldn't support this case...
+#           require IO::String;
+#           $myData{_OUTFILE} = "$outfile";
+#           $out_fh = IO::String->new($outfile);
+            croak "Output to SCALAR reference not supported!\n";
         }
-        elsif (ref $outfile) {
+        else {
             ## Must be a filehandle-ref (or else assume its a ref to an
             ## object that supports the common IO write operations).
             $myData{_OUTFILE} = ${$outfile};
             $out_fh = $outfile;
         }
+    }
+    elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
+        || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
+    {
+        if (defined $myData{_TOP_STREAM}) {
+            $out_fh = $myData{_OUTPUT};
+        }
         else {
-            ## We have a filename, open it for writing
-            $myData{_OUTFILE} = $outfile;
-            (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
-            open($out_fh, "> $outfile")  or
-                 croak "Can't open $outfile for writing: $!\n";
-            $close_output = 1;
+            ## Not a filename, just a string implying STDOUT
+            $outfile ||= '-';
+            $myData{_OUTFILE} = "<standard output>";
+            $out_fh  = \*STDOUT;
         }
     }
+    elsif ($outfile =~ /^>&(STDERR|2)$/i) {
+        ## Not a filename, just a string implying STDERR
+        $myData{_OUTFILE} = "<standard error>";
+        $out_fh  = \*STDERR;
+    }
+    else {
+        ## We have a filename, open it for writing
+        $myData{_OUTFILE} = $outfile;
+        (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
+        open($out_fh, "> $outfile")  or
+             croak "Can't open $outfile for writing: $!\n";
+        $close_output = 1;
+    }
 
     ## Whew! That was a lot of work to set up reasonably/robust behavior
     ## in the case of a non-filename for reading and writing. Now we just
@@ -1758,6 +1786,8 @@ causing any namespace clashes due to multiple inheritance.
 
 =head1 AUTHOR
 
+Please report bugs using L<http://rt.cpan.org>.
+
 Brad Appleton E<lt>bradapp@enteract.comE<gt>
 
 Based on code for B<Pod::Text> written by
@@ -1766,3 +1796,4 @@ Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
 =cut
 
 1;
+# vim: ts=4 sw=4 et