diff options
| author | Sawyer X <xsawyerx@cpan.org> | 2019-05-24 20:40:11 +0300 |
|---|---|---|
| committer | Sawyer X <xsawyerx@cpan.org> | 2019-05-24 20:40:11 +0300 |
| commit | a0d36fc4a29370286677b7fe0567add310f42e9a (patch) | |
| tree | f7caa3aa37278c96f5f4314942803b529e2b8a7e /cpan/Pod-Simple | |
| parent | 5612cc92a54e1bd02633cf3e6944b5ac15e01401 (diff) | |
| download | perl-a0d36fc4a29370286677b7fe0567add310f42e9a.tar.gz | |
Revert "Bump Pod::Simple from 3.35 to 3.36"
This reverts commit 314f4963bff4d23e773eee5559e5fd1de2dc6cbc.
This is causing testing failures on FreeBSD-11, raised by Jim Keenan.
Diffstat (limited to 'cpan/Pod-Simple')
45 files changed, 407 insertions, 2310 deletions
diff --git a/cpan/Pod-Simple/lib/Pod/Simple.pm b/cpan/Pod-Simple/lib/Pod/Simple.pm index a9db8c2a68..20924153b6 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple.pm @@ -18,7 +18,7 @@ use vars qw( ); @ISA = ('Pod::Simple::BlackBox'); -$VERSION = '3.36'; +$VERSION = '3.35'; @Known_formatting_codes = qw(I B C L E F S X Z); %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); @@ -74,9 +74,6 @@ else { # EBCDIC on early Perl. We know what the values are for the code #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ __PACKAGE__->_accessorize( - '_output_is_for_JustPod', # For use only by Pod::Simple::JustPod, - # If non-zero, don't expand Z<> E<> S<> L<>, - # and count how many brackets in format codes 'nbsp_for_S', # Whether to map S<...>'s to \xA0 characters 'source_filename', # Filename of the source, for use in warnings 'source_dead', # Whether to consider this parser's source dead @@ -171,7 +168,6 @@ sub encoding { BEGIN { *pretty = \&Pod::Simple::BlackBox::pretty; *stringify_lol = \&Pod::Simple::BlackBox::stringify_lol; - *my_qr = \&Pod::Simple::BlackBox::my_qr; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@ -343,9 +339,10 @@ sub unaccept_targets { # XXX Probably it is an error that the digit '9' is excluded from these re's. # Broken for early Perls on EBCDIC -my $xml_name_re = my_qr('[^-.0-8:A-Z_a-z[:^ascii:]]', '9'); -$xml_name_re = qr/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/ - unless $xml_name_re; +my $xml_name_re = eval "qr/[^-.0-8:A-Z_a-z[:^ascii:]]/"; +if (! defined $xml_name_re) { + $xml_name_re = qr/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/; +} sub accept_code { shift->accept_codes(@_) } # alias @@ -655,13 +652,12 @@ sub _make_treelet { $treelet = $self->_treelet_from_formatting_codes(@_); } - if( ! $self->{'_output_is_for_JustPod'} # Retain these as-is for pod output - && $self->_remap_sequences($treelet) ) - { + if( $self->_remap_sequences($treelet) ) { $self->_treat_Zs($treelet); # Might as well nix these first $self->_treat_Ls($treelet); # L has to precede E and S $self->_treat_Es($treelet); $self->_treat_Ss($treelet); # S has to come after E + $self->_wrap_up($treelet); # Nix X's and merge texties } else { @@ -1084,14 +1080,9 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences # By here, $treelet->[$i] is definitely an L node my $ell = $treelet->[$i]; - DEBUG > 1 and print STDERR "Ogling L node " . pretty($ell) . "\n"; + DEBUG > 1 and print STDERR "Ogling L node $ell\n"; - # bitch if it's empty or is just '/' - if (@{$ell} == 3 and $ell->[2] =~ m!\A\s*/\s*\z!) { - $self->whine( $start_line, "L<> contains only '/'" ); - $treelet->[$i] = 'L</>'; # just make it a text node - next; # and move on - } + # bitch if it's empty if( @{$ell} == 2 or (@{$ell} == 3 and $ell->[2] eq '') ) { @@ -1298,7 +1289,6 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences $section_name = [splice @ell_content]; $section_name->[ 0] =~ s/^\"//s; $section_name->[-1] =~ s/\"$//s; - $ell->[1]{'~tolerated'} = 1; } # Turn L<Foo Bar> into L</Foo Bar>. @@ -1306,8 +1296,8 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences and grep !ref($_) && m/ /s, @ell_content ) { $section_name = [splice @ell_content]; - $ell->[1]{'~deprecated'} = 1; # That's support for the now-deprecated syntax. + # (Maybe generate a warning eventually?) # Note that it deliberately won't work on L<...|Foo Bar> } @@ -1357,7 +1347,7 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences # And update children to be the link-text: @$ell = (@$ell[0,1], defined($link_text) ? splice(@$link_text) : ''); - DEBUG > 2 and print STDERR "End of L-parsing for this node " . pretty($treelet->[$i]) . "\n"; + DEBUG > 2 and print STDERR "End of L-parsing for this node $treelet->[$i]\n"; unshift @stack, $treelet->[$i]; # might as well recurse } @@ -1517,7 +1507,6 @@ sub _accessorize { # A simple-minded method-maker $Carp::CarpLevel = 1, Carp::croak( "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" ) unless (@_ == 1 or @_ == 2) and ref $_[0]; - (@_ == 1) ? $_[0]->{$attrname} : ($_[0]->{$attrname} = $_[1]); }; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm index 7f30052b0d..9fe3f702ef 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm @@ -22,36 +22,8 @@ use integer; # vroom! use strict; use Carp (); use vars qw($VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; #use constant DEBUG => 7; - -sub my_qr ($$) { - - # $1 is a pattern to compile and return. Older perls compile any - # syntactically valid property, even if it isn't legal. To cope with - # this, return an empty string unless the compiled pattern also - # successfully matches $2, which the caller furnishes. - - my ($input_re, $should_match) = @_; - # XXX could have a third parameter $shouldnt_match for extra safety - - my $use_utf8 = ($] le 5.006002) ? 'use utf8;' : ""; - - my $re = eval "no warnings; $use_utf8 qr/$input_re/"; - #print STDERR __LINE__, ": $input_re: $@\n" if $@; - return "" if $@; - - my $matches = eval "no warnings; $use_utf8 '$should_match' =~ /$re/"; - #print STDERR __LINE__, ": $input_re: $@\n" if $@; - return "" if $@; - - #print STDERR __LINE__, ": SUCCESS: $re\n" if $matches; - return $re if $matches; - - #print STDERR __LINE__, ": $re: didn't match\n"; - return ""; -} - BEGIN { require Pod::Simple; *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG @@ -60,37 +32,8 @@ BEGIN { # Matches a character iff the character will have a different meaning # if we choose CP1252 vs UTF-8 if there is no =encoding line. # This is broken for early Perls on non-ASCII platforms. -my $non_ascii_re = my_qr('[[:^ascii:]]', "\xB6"); -$non_ascii_re = qr/[\x80-\xFF]/ unless $non_ascii_re; - -# Use patterns understandable by Perl 5.6, if possible -my $cs_re = my_qr('\p{IsCs}', "\x{D800}"); -my $cn_re = my_qr('\p{IsCn}', "\x{09E4}"); # <reserved> code point unlikely - # to get assigned -my $rare_blocks_re = my_qr('[\p{InIPAExtensions}\p{InSpacingModifierLetters}]', - "\x{250}"); -$rare_blocks_re = my_qr('[\x{0250}-\x{02FF}]', "\x{250}") unless $rare_blocks_re; - -my $script_run_re = eval 'no warnings "experimental::script_run"; - qr/(*script_run: ^ .* $ )/x'; -my $latin_re = my_qr('[\p{IsLatin}\p{IsInherited}\p{IsCommon}]', "\x{100}"); -unless ($latin_re) { - # This was machine generated to be the ranges of the union of the above - # three properties, with things that were undefined by Unicode 4.1 filling - # gaps. That is the version in use when Perl advanced enough to - # successfully compile and execute the above pattern. - $latin_re = my_qr('[\x00-\x{02E9}\x{02EC}-\x{0374}\x{037E}\x{0385}\x{0387}\x{0485}\x{0486}\x{0589}\x{060C}\x{061B}\x{061F}\x{0640}\x{064B}-\x{0655}\x{0670}\x{06DD}\x{0951}-\x{0954}\x{0964}\x{0965}\x{0E3F}\x{10FB}\x{16EB}-\x{16ED}\x{1735}\x{1736}\x{1802}\x{1803}\x{1805}\x{1D00}-\x{1D25}\x{1D2C}-\x{1D5C}\x{1D62}-\x{1D65}\x{1D6B}-\x{1D77}\x{1D79}-\x{1DBE}\x{1DC0}-\x{1EF9}\x{2000}-\x{2125}\x{2127}-\x{27FF}\x{2900}-\x{2B13}\x{2E00}-\x{2E1D}\x{2FF0}-\x{3004}\x{3006}\x{3008}-\x{3020}\x{302A}-\x{302D}\x{3030}-\x{3037}\x{303C}-\x{303F}\x{3099}-\x{309C}\x{30A0}\x{30FB}\x{30FC}\x{3190}-\x{319F}\x{31C0}-\x{31CF}\x{3220}-\x{325F}\x{327F}-\x{32CF}\x{3358}-\x{33FF}\x{4DC0}-\x{4DFF}\x{A700}-\x{A716}\x{FB00}-\x{FB06}\x{FD3E}\x{FD3F}\x{FE00}-\x{FE6B}\x{FEFF}-\x{FF65}\x{FF70}\x{FF9E}\x{FF9F}\x{FFE0}-\x{FFFD}\x{10100}-\x{1013F}\x{1D000}-\x{1D1DD}\x{1D300}-\x{1D7FF}]', "\x{100}"); -} - -my $every_char_is_latin_re = my_qr("^(?:$latin_re)*\\z", "A"); - -# Latin script code points not in the first release of Unicode -my $later_latin_re = my_qr('[^\P{IsLatin}\p{IsAge=1.1}]', "\x{1F6}"); - -# If this perl doesn't have the Deprecated property, there's only one code -# point in it that we need be concerned with. -my $deprecated_re = my_qr('\p{IsDeprecated}', "\x{149}"); -$deprecated_re = qr/\x{149}/ unless $deprecated_re; +my $non_ascii_re = eval "qr/[[:^ascii:]]/"; +$non_ascii_re = qr/[\x80-\xFF]/ if ! defined $non_ascii_re; my $utf8_bom; if (($] ge 5.007_003)) { @@ -114,10 +57,10 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) my $cut_handler = $self->{'cut_handler'}; my $wl_handler = $self->{'whiteline_handler'}; $self->{'line_count'} ||= 0; - + my $scratch; - DEBUG > 4 and + DEBUG > 4 and print STDERR "# Parsing starting at line ", $self->{'line_count'}, ".\n"; DEBUG > 5 and @@ -128,17 +71,9 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # paragraph buffer. Because we need to defer processing of =over # directives and verbatim paragraphs. We call _ponder_paragraph_buffer # to process this. - + $self->{'pod_para_count'} ||= 0; - # An attempt to match the pod portions of a line. This is not fool proof, - # but is good enough to serve as part of the heuristic for guessing the pod - # encoding if not specified. - my $format_codes = join "", '[', grep { / ^ [A-Za-z] $/x } - keys %{$self->{accept_codes}}; - $format_codes .= ']'; - my $pod_chars_re = qr/ ^ = [A-Za-z]+ | $format_codes < /x; - my $line; foreach my $source_line (@_) { if( $self->{'source_dead'} ) { @@ -162,7 +97,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) ($line = $source_line) =~ tr/\n\r//d; # If we don't have two vars, we'll end up with that there # tr/// modding the (potentially read-only) original source line! - + } else { DEBUG > 2 and print STDERR "First line: [$source_line]\n"; @@ -171,7 +106,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) $self->_handle_encoding_line( "=encoding utf8" ); delete $self->{'_processed_encoding'}; $line =~ tr/\n\r//d; - + } elsif( $line =~ s/^\xFE\xFF//s ) { DEBUG and print STDERR "Big-endian UTF-16 BOM seen. Aborting parsing.\n"; $self->scream( @@ -195,7 +130,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) next; # TODO: implement somehow? - + } else { DEBUG > 2 and print STDERR "First line is BOM-less.\n"; ($line = $source_line) =~ tr/\n\r//d; @@ -209,8 +144,8 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) my $encoding; - # No =encoding line, and we are at the first pod line in the input that - # contains a non-ascii byte, that is, one whose meaning varies depending + # No =encoding line, and we are at the first line in the input that + # contains a non-ascii byte, that is one whose meaning varies depending # on whether the file is encoded in UTF-8 or CP1252, which are the two # possibilities permitted by the pod spec. (ASCII is assumed if the # file only contains ASCII bytes.) In order to process this line, we @@ -227,28 +162,22 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # without conflict. CP 1252 uses most of them for graphic characters. # # Note that all ASCII-range bytes represent their corresponding code - # points in both CP1252 and UTF-8. In ASCII platform UTF-8, all other - # code points require multiple (non-ASCII) bytes to represent. (A - # separate paragraph for EBCDIC is below.) The multi-byte - # representation is quite structured. If we find an isolated byte that - # would require multiple bytes to represent in UTF-8, we know that the - # encoding is not UTF-8. If we find a sequence of bytes that violates - # the UTF-8 structure, we also can presume the encoding isn't UTF-8, and - # hence must be 1252. + # points in CP1252 and UTF-8. In ASCII platform UTF-8 all other code + # points require multiple (non-ASCII) bytes to represent. (A separate + # paragraph for EBCDIC is below.) The multi-byte representation is + # quite structured. If we find an isolated byte that requires multiple + # bytes to represent in UTF-8, we know that the encoding is not UTF-8. + # If we find a sequence of bytes that violates the UTF-8 structure, we + # also can presume the encoding isn't UTF-8, and hence must be 1252. # # But there are ambiguous cases where we could guess wrong. If so, the # user will end up having to supply an =encoding line. We use all # readily available information to improve our chances of guessing # right. The odds of something not being UTF-8, but still passing a # UTF-8 validity test go down very rapidly with increasing length of the - # sequence. Therefore we look at all non-ascii sequences on the line. - # If any of the sequences can't be UTF-8, we quit there and choose - # CP1252. If all could be UTF-8, we see if any of the code points - # represented are unlikely to be in pod. If so, we guess CP1252. If - # not, we check if the line is all in the same script; if not guess - # CP1252; otherwise UTF-8. For perls that don't have convenient script - # run testing, see if there is both Latin and non-Latin. If so, CP1252, - # otherwise UTF-8. + # sequence. Therefore we look at all the maximal length non-ascii + # sequences on the line. If any of the sequences can't be UTF-8, we + # quit there and choose CP1252. If all could be UTF-8, we guess UTF-8. # # On EBCDIC platforms, the situation is somewhat different. In # UTF-EBCDIC, not only do ASCII-range bytes represent their code points, @@ -259,188 +188,51 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # very unlikely to be in pod text. So if we encounter one of them, it # means that it is quite likely CP1252 and not UTF-8. The net result is # the same code below is used for both platforms. - # - # XXX probably if the line has E<foo> that evaluates to illegal CP1252, - # then it is UTF-8. But we haven't processed E<> yet. - - goto set_1252 if $] lt 5.006_000; # No UTF-8 on very early perls - - my $copy; - - no warnings 'utf8'; - - if ($] ge 5.007_003) { - $copy = $line; - - # On perls that have this function, we can use it to easily see if the - # sequence is valid UTF-8 or not; if valid it turns on the UTF-8 flag - # needed below for script run detection - goto set_1252 if ! utf8::decode($copy); - } - elsif (ord("A") != 65) { # Early EBCDIC, assume UTF-8. What's a windows - # code page doing here anyway? - goto set_utf8; - } - else { # ASCII, no decode(): do it ourselves using the fundamental - # characteristics of UTF-8 - use if $] le 5.006002, 'utf8'; - - my $char_ord; - my $needed; # How many continuation bytes to gobble up - - # Initialize the translated line with a dummy character that will be - # deleted after everything else is done. This dummy makes sure that - # $copy will be in UTF-8. Doing it now avoids the bugs in early perls - # with upgrading in the middle - $copy = chr(0x100); - - # Parse through the line - for (my $i = 0; $i < length $line; $i++) { - my $byte = substr($line, $i, 1); - - # ASCII bytes are trivially dealt with - if ($byte !~ $non_ascii_re) { - $copy .= $byte; - next; - } - - my $b_ord = ord $byte; - - # Now figure out what this code point would be if the input is - # actually in UTF-8. If, in the process, we discover that it isn't - # well-formed UTF-8, we guess CP1252. - # - # Start the process. If it is UTF-8, we are at the first, start - # byte, of a multi-byte sequence. We look at this byte to figure - # out how many continuation bytes are needed, and to initialize the - # code point accumulator with the data from this byte. - # - # Normally the minimum continuation byte is 0x80, but in certain - # instances the minimum is a higher number. So the code below - # overrides this for those instances. - my $min_cont = 0x80; - - if ($b_ord < 0xC2) { # A start byte < C2 is malformed - goto set_1252; - } - elsif ($b_ord <= 0xDF) { - $needed = 1; - $char_ord = $b_ord & 0x1F; - } - elsif ($b_ord <= 0xEF) { - $min_cont = 0xA0 if $b_ord == 0xE0; - $needed = 2; - $char_ord = $b_ord & (0x1F >> 1); + while ($line =~ m/($non_ascii_re+)/g) { + my $non_ascii_seq = $1; + + if (length $non_ascii_seq == 1) { + $encoding = 'CP1252'; + goto guessed; + } elsif ($] ge 5.007_003) { + + # On Perls that have this function, we can see if the sequence is + # valid UTF-8 or not. + my $is_utf8; + { + no warnings 'utf8'; + $is_utf8 = utf8::decode($non_ascii_seq); } - elsif ($b_ord <= 0xF4) { - $min_cont = 0x90 if $b_ord == 0xF0; - $needed = 3; - $char_ord = $b_ord & (0x1F >> 2); + if (! $is_utf8) { + $encoding = 'CP1252'; + goto guessed; } - else { # F4 is the highest start byte for legal Unicode; higher is - # unlikely to be in pod. - goto set_1252; + } elsif (ord("A") == 65) { # An early Perl, ASCII platform + + # Without utf8::decode, it's a lot harder to do a rigorous check + # (though some early releases had a different function that + # accomplished the same thing). Since these are ancient Perls, not + # likely to be in use today, we take the easy way out, and look at + # just the first two bytes of the sequence to see if they are the + # start of a UTF-8 character. In ASCII UTF-8, continuation bytes + # must be between 0x80 and 0xBF. Start bytes can range from 0xC2 + # through 0xFF, but anything above 0xF4 is not Unicode, and hence + # extremely unlikely to be in a pod. + if ($non_ascii_seq !~ /^[\xC2-\xF4][\x80-\xBF]/) { + $encoding = 'CP1252'; + goto guessed; } - # ? not enough continuation bytes available - goto set_1252 if $i + $needed >= length $line; - - # Accumulate the ordinal of the character from the remaining - # (continuation) bytes. - while ($needed-- > 0) { - my $cont = substr($line, ++$i, 1); - $b_ord = ord $cont; - goto set_1252 if $b_ord < $min_cont || $b_ord > 0xBF; - - # In all cases, any next continuation bytes all have the same - # minimum legal value - $min_cont = 0x80; - - # Accumulate this byte's contribution to the code point - $char_ord <<= 6; - $char_ord |= ($b_ord & 0x3F); - } - - # Here, the sequence that formed this code point was valid UTF-8, - # so add the completed character to the output - $copy .= chr $char_ord; - } # End of loop through line - - # Delete the dummy first character - $copy = substr($copy, 1); - } - - # Here, $copy is legal UTF-8. - - # If it can't be legal CP1252, no need to look further. (These bytes - # aren't valid in CP1252.) This test could have been placed higher in - # the code, but it seemed wrong to set the encoding to UTF-8 without - # making sure that the very first instance is well-formed. But what if - # it isn't legal CP1252 either? We have to choose one or the other, and - # It seems safer to favor the single-byte encoding over the multi-byte. - goto set_utf8 if ord("A") == 65 && $line =~ /[\x81\x8D\x8F\x90\x9D]/; - - # The C1 controls are not likely to appear in pod - goto set_1252 if ord("A") == 65 && $copy =~ /[\x80-\x9F]/; - - # Nor are surrogates nor unassigned, nor deprecated. - DEBUG > 8 and print STDERR __LINE__, ": $copy: surrogate\n" if $copy =~ $cs_re; - goto set_1252 if $cs_re && $copy =~ $cs_re; - DEBUG > 8 and print STDERR __LINE__, ": $copy: unassigned\n" if $cn_re && $copy =~ $cn_re; - goto set_1252 if $cn_re && $copy =~ $cn_re; - DEBUG > 8 and print STDERR __LINE__, ": $copy: deprecated\n" if $copy =~ $deprecated_re; - goto set_1252 if $copy =~ $deprecated_re; - - # Nor are rare code points. But this is hard to determine. khw - # believes that IPA characters and the modifier letters are unlikely to - # be in pod (and certainly very unlikely to be the in the first line in - # the pod containing non-ASCII) - DEBUG > 8 and print STDERR __LINE__, ": $copy: rare\n" if $copy =~ $rare_blocks_re; - goto set_1252 if $rare_blocks_re && $copy =~ $rare_blocks_re; - - # The first Unicode version included essentially every Latin character - # in modern usage. So, a Latin character not in the first release will - # unlikely be in pod. - DEBUG > 8 and print STDERR __LINE__, ": $copy: later_latin\n" if $later_latin_re && $copy =~ $later_latin_re; - goto set_1252 if $later_latin_re && $copy =~ $later_latin_re; - - # On perls that handle script runs, if the UTF-8 interpretation yields - # a single script, we guess UTF-8, otherwise just having a mixture of - # scripts is suspicious, so guess CP1252. We first strip off, as best - # we can, the ASCII characters that look like they are pod directives, - # as these would always show as mixed with non-Latin text. - $copy =~ s/$pod_chars_re//g; - - if ($script_run_re) { - goto set_utf8 if $copy =~ $script_run_re; - DEBUG > 8 and print STDERR __LINE__, ": not script run\n"; - goto set_1252; - } - - # Even without script runs, but on recent enough perls and Unicodes, we - # can check if there is a mixture of both Latin and non-Latin. Again, - # having a mixture of scripts is suspicious, so assume CP1252 - - # If it's all non-Latin, there is no CP1252, as that is Latin - # characters and punct, etc. - DEBUG > 8 and print STDERR __LINE__, ": $copy: not latin\n" if $copy !~ $latin_re; - goto set_utf8 if $copy !~ $latin_re; - - DEBUG > 8 and print STDERR __LINE__, ": $copy: all latin\n" if $copy =~ $every_char_is_latin_re; - goto set_utf8 if $copy =~ $every_char_is_latin_re; - - DEBUG > 8 and print STDERR __LINE__, ": $copy: mixed\n"; - - set_1252: - DEBUG > 9 and print STDERR __LINE__, ": $copy: is 1252\n"; - $encoding = 'CP1252'; - goto done_set; + # We don't bother doing anything special for EBCDIC on early Perls. + # If there is a solitary variant, CP1252 will be chosen; otherwise + # UTF-8. + } + } # End of loop through all variant sequences on the line - set_utf8: - DEBUG > 9 and print STDERR __LINE__, ": $copy: is UTF-8\n"; + # All sequences in the line could be UTF-8. Guess that. $encoding = 'UTF-8'; - done_set: + guessed: $self->_handle_encoding_line( "=encoding $encoding" ); delete $self->{'_processed_encoding'}; $self->{'_transcoder'} && $self->{'_transcoder'}->($line); @@ -462,13 +254,13 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) $self->{'line_count'}, "=cut found outside a pod block. Skipping to next block." ); - + ## Before there were errata sections in the world, it was ## least-pessimal to abort processing the file. But now we can ## just barrel on thru (but still not start a pod block). #splice @_; #push @_, undef; - + next; } else { $self->{'in_pod'} = $self->{'start_of_pod_block'} @@ -481,7 +273,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) if $code_handler; # Note: this may cause code to be processed out of order relative # to pods, but in order relative to cuts. - + # Note also that we haven't yet applied the transcoding to $line # by time we call $code_handler! @@ -492,11 +284,11 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) DEBUG > 1 and print STDERR "# Setting nextline to $1\n"; $self->{'line_count'} = $1 - 1; } - + next; } } - + # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . # Else we're in pod mode: @@ -516,13 +308,12 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # ++$self->{'pod_para_count'}; $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. - DEBUG > 6 and print STDERR "Processing any cut handler, line ${$self}{'line_count'}\n"; $cut_handler->(map $_, $line, $self->{'line_count'}, $self) if $cut_handler; # TODO: add to docs: Note: this may cause cuts to be processed out # of order relative to pods, but in order relative to code. - + } elsif($line =~ m/^(\s*)$/s) { # it's a blank line if (defined $1 and $1 =~ /[^\S\r\n]/) { # it's a white line $wl_handler->(map $_, $line, $self->{'line_count'}, $self) @@ -533,30 +324,29 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) DEBUG > 1 and print STDERR "Saving blank line at line ${$self}{'line_count'}\n"; push @{$paras->[-1]}, $line; } # otherwise it's not interesting - + if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) { DEBUG > 1 and print STDERR "Noting para ends with blank line at ${$self}{'line_count'}\n"; } - + $self->{'last_was_blank'} = 1; - + } elsif($self->{'last_was_blank'}) { # A non-blank line starting a new para... - - if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(\s+|$)(.*)/s) { + + if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) { # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS - my $new = [$1, {'start_line' => $self->{'line_count'}}, $3]; - $new->[1]{'~orig_spacer'} = $2 if $2 && $2 ne " "; + my $new = [$1, {'start_line' => $self->{'line_count'}}, $2]; # Note that in "=head1 foo", the WS is lost. # Example: ['=head1', {'start_line' => 123}, ' foo'] - + ++$self->{'pod_para_count'}; - + $self->_ponder_paragraph_buffer(); # by now it's safe to consider the previous paragraph as done. - + push @$paras, $new; # the new incipient paragraph DEBUG > 1 and print STDERR "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n"; - + } elsif($line =~ m/^\s/s) { if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') { @@ -589,7 +379,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) } $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0; } - + } # ends the big while loop DEBUG > 1 and print STDERR (pretty(@$paras), "\n"); @@ -600,7 +390,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) sub _handle_encoding_line { my($self, $line) = @_; - + return if $self->parse_characters; # The point of this routine is to set $self->{'_transcoder'} as indicated. @@ -702,7 +492,7 @@ sub _handle_encoding_line { sub _handle_encoding_second_level { # By time this is called, the encoding (if well formed) will already - # have been acted on. + # have been acted one. my($self, $para) = @_; my @x = @$para; my $content = join ' ', splice @x, 2; @@ -710,7 +500,7 @@ sub _handle_encoding_second_level { $content =~ s/\s+$//s; DEBUG > 2 and print STDERR "Ogling encoding directive: =encoding $content\n"; - + if (defined($self->{'_processed_encoding'})) { #if($content ne $self->{'_processed_encoding'}) { # Could it happen? @@ -728,14 +518,14 @@ sub _handle_encoding_second_level { } else { DEBUG > 2 and print STDERR " (Yup, it was successfully handled already.)\n"; } - + } else { # Otherwise it's a syntax error $self->whine( $para->[1]{'start_line'}, "Invalid =encoding syntax: $content" ); } - + return; } @@ -752,7 +542,7 @@ sub _gen_errata { return() unless $self->{'errata'} and keys %{$self->{'errata'}}; my @out; - + foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) { push @out, ['=item', {'start_line' => $m}, "Around line $line:"], @@ -765,7 +555,7 @@ sub _gen_errata { ) ; } - + # TODO: report of unknown entities? unrenderable characters? unshift @out, @@ -779,7 +569,7 @@ sub _gen_errata { ['=over', {'start_line' => $m, 'errata' => 1}, ''], ; - push @out, + push @out, ['=back', {'start_line' => $m, 'errata' => 1}, ''], ; @@ -820,7 +610,7 @@ sub _ponder_paragraph_buffer { # Document, # Data, Para, Verbatim # B, C, longdirname (TODO -- wha?), etc. for all directives - # + # my $self = $_[0]; my $paras; @@ -834,11 +624,11 @@ sub _ponder_paragraph_buffer { # We have something in our buffer. So apparently the document has started. unless($self->{'doc_has_started'}) { $self->{'doc_has_started'} = 1; - + my $starting_contentless; $starting_contentless = ( - !@$curr_open + !@$curr_open and @$paras and ! grep $_->[0] ne '~end', @$paras # i.e., if the paras is all ~ends ) @@ -847,7 +637,7 @@ sub _ponder_paragraph_buffer { $starting_contentless ? 'contentless' : 'contentful', " document\n" ; - + $self->_handle_element_start( ($scratch = 'Document'), { @@ -859,28 +649,15 @@ sub _ponder_paragraph_buffer { my($para, $para_type); while(@$paras) { - last if @$paras == 1 - and ( $paras->[0][0] eq '=over' - or $paras->[0][0] eq '=item' - or ($paras->[0][0] eq '~Verbatim' and $self->{'in_pod'})); + last if @$paras == 1 and + ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim' + or $paras->[0][0] eq '=item' ) + ; # Those're the three kinds of paragraphs that require lookahead. # Actually, an "=item Foo" inside an <over type=text> region # and any =item inside an <over type=block> region (rare) # don't require any lookahead, but all others (bullets # and numbers) do. - # The verbatim is different from the other two, because those might be - # like: - # - # =item - # ... - # =cut - # ... - # =item - # - # The =cut here finishes the paragraph but doesn't terminate the =over - # they should be in. (khw apologizes that he didn't comment at the time - # why the 'in_pod' works, and no longer remembers why, and doesn't think - # it is currently worth the effort to re-figure it out.) # TODO: whinge about many kinds of directives in non-resolving =for regions? # TODO: many? like what? =head1 etc? @@ -890,7 +667,7 @@ sub _ponder_paragraph_buffer { DEBUG > 1 and print STDERR "Pondering a $para_type paragraph, given the stack: (", $self->_dump_curr_open(), ")\n"; - + if($para_type eq '=for') { next if $self->_ponder_for($para,$curr_open,$paras); @@ -927,7 +704,7 @@ sub _ponder_paragraph_buffer { } else { # All non-magical codes!!! - + # Here we start using $para_type for our own twisted purposes, to # mean how it should get treated, not as what the element name # should be. @@ -967,10 +744,10 @@ sub _ponder_paragraph_buffer { ; next; } - - + + my $over_type = $over->[1]{'~type'}; - + if(!$over_type) { # Shouldn't happen1 die "Typeless over in stack, starting at line " @@ -995,7 +772,7 @@ sub _ponder_paragraph_buffer { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + if($item_type eq 'text') { # Nothing special needs doing for 'text' } elsif($item_type eq 'number' or $item_type eq 'bullet') { @@ -1011,16 +788,16 @@ sub _ponder_paragraph_buffer { } else { die "Unhandled item type $item_type"; # should never happen } - + # =item-text thingies don't need any assimilation, it seems. } elsif($over_type eq 'number') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; - + if($item_type eq 'bullet') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; @@ -1045,7 +822,7 @@ sub _ponder_paragraph_buffer { } elsif($expected_value == $para->[1]{'number'}) { DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n"; - + } else { DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'}, " instead of the expected value of $expected_value\n"; @@ -1056,7 +833,7 @@ sub _ponder_paragraph_buffer { ); $para->[1]{'number'} = $expected_value; # correcting!! } - + if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { @@ -1073,13 +850,13 @@ sub _ponder_paragraph_buffer { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + if($item_type eq 'bullet') { # as expected! if( $para->[1]{'~_freaky_para_hack'} ) { DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n"; - push @$para, $para->[1]{'~_freaky_para_hack'}; + push @$para, delete $para->[1]{'~_freaky_para_hack'}; } } elsif($item_type eq 'number') { @@ -1167,15 +944,15 @@ sub _ponder_paragraph_buffer { my @fors = grep $_->[0] eq '=for', @$curr_open; DEBUG > 1 and print STDERR "Containing fors: ", join(',', map $_->[1]{'target'}, @fors), "\n"; - + if(! @fors) { DEBUG and print STDERR "Treating $para_type paragraph as such because stack has no =for's\n"; - + #} elsif(grep $_->[1]{'~resolve'}, @fors) { #} elsif(not grep !$_->[1]{'~resolve'}, @fors) { } elsif( $fors[-1][1]{'~resolve'} ) { # Look to the immediately containing for - + if($para_type eq 'Data') { DEBUG and print STDERR "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n"; $para->[0] = 'Para'; @@ -1194,7 +971,7 @@ sub _ponder_paragraph_buffer { if($para_type eq 'Plain') { $self->_ponder_Plain($para); } elsif($para_type eq 'Verbatim') { - $self->_ponder_Verbatim($para); + $self->_ponder_Verbatim($para); } elsif($para_type eq 'Data') { $self->_ponder_Data($para); } else { @@ -1212,7 +989,7 @@ sub _ponder_paragraph_buffer { $self->_traverse_treelet_bit(@$para); } } - + return; } @@ -1247,9 +1024,9 @@ sub _ponder_for { } DEBUG > 1 and print STDERR "Faking out a =for $target as a =begin $target / =end $target\n"; - + $para->[0] = 'Data'; - + unshift @$paras, ['=begin', {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'}, @@ -1261,7 +1038,7 @@ sub _ponder_for { $target, ], ; - + return 1; } @@ -1278,20 +1055,20 @@ sub _ponder_begin { DEBUG and print STDERR "Ignoring targetless =begin\n"; return 1; } - + my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/; $para->[1]{'title'} = $title if ($title); $para->[1]{'target'} = $target; # without any ':' $content = $target; # strip off the title - + $content =~ s/^:!/!:/s; my $neg; # whether this is a negation-match $neg = 1 if $content =~ s/^!//s; my $to_resolve; # whether to process formatting codes $to_resolve = 1 if $content =~ s/^://s; - + my $dont_ignore; # whether this target matches us - + foreach my $target_name ( split(',', $content, -1), $neg ? () : '*' @@ -1299,7 +1076,7 @@ sub _ponder_begin { DEBUG > 2 and print STDERR " Considering whether =begin $content matches $target_name\n"; next unless $self->{'accept_targets'}{$target_name}; - + DEBUG > 2 and print STDERR " It DOES match the acceptable target $target_name!\n"; $to_resolve = 1 @@ -1362,7 +1139,7 @@ sub _ponder_end { DEBUG and print STDERR "Ignoring targetless =end\n"; return 1; } - + unless($content =~ m/^\S+$/) { # i.e., unless it's one word $self->whine( $para->[1]{'start_line'}, @@ -1372,7 +1149,7 @@ sub _ponder_end { DEBUG and print STDERR "Ignoring mistargetted =end $content\n"; return 1; } - + unless(@$curr_open and $curr_open->[-1][0] eq '=for') { $self->whine( $para->[1]{'start_line'}, @@ -1382,11 +1159,11 @@ sub _ponder_end { DEBUG and print STDERR "Ignoring mistargetted =end $content\n"; return 1; } - + unless($content eq $curr_open->[-1][1]{'target'}) { $self->whine( $para->[1]{'start_line'}, - "=end $content doesn't match =begin " + "=end $content doesn't match =begin " . $curr_open->[-1][1]{'target'} . ". (Stack: " . $self->_dump_curr_open() . ')' @@ -1403,7 +1180,7 @@ sub _ponder_end { } else { $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'}; # what's that for? - + $self->{'content_seen'} ||= 1; $self->_handle_element_end( my $scratch = 'for', $para->[1]); } @@ -1411,14 +1188,14 @@ sub _ponder_end { pop @$curr_open; return 1; -} +} sub _ponder_doc_end { my ($self,$para,$curr_open,$paras) = @_; if(@$curr_open) { # Deal with things left open DEBUG and print STDERR "Stack is nonempty at end-document: (", $self->_dump_curr_open(), ")\n"; - + DEBUG > 9 and print STDERR "Stack: ", pretty($curr_open), "\n"; unshift @$paras, $self->_closers_for_all_curr_open; # Make sure there is exactly one ~end in the parastack, at the end: @@ -1428,11 +1205,11 @@ sub _ponder_doc_end { # generate errata, and then another to be at the end # when that loop back around to process the errata. return 1; - + } else { DEBUG and print STDERR "Okay, stack is empty now.\n"; } - + # Try generating errata section, if applicable unless($self->{'~tried_gen_errata'}) { $self->{'~tried_gen_errata'} = 1; @@ -1443,7 +1220,7 @@ sub _ponder_doc_end { return 1; # I.e., loop around again to process these fake-o paragraphs } } - + splice @$paras; # Well, that's that for this paragraph buffer. DEBUG and print STDERR "Throwing end-document event.\n"; @@ -1501,9 +1278,8 @@ sub _ponder_over { $para->[1]{'~type'} = $list_type; push @$curr_open, $para; # yes, we reuse the paragraph as a stack item - + my $content = join ' ', splice @$para, 2; - $para->[1]{'~orig_content'} = $content; my $overness; if($content =~ m/^\s*$/s) { $para->[1]{'indent'} = 4; @@ -1525,13 +1301,13 @@ sub _ponder_over { $para->[1]{'indent'} = 4; } DEBUG > 1 and print STDERR "=over found of type $list_type\n"; - + $self->{'content_seen'} ||= 1; $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]); return; } - + sub _ponder_back { my ($self,$para,$curr_open,$paras) = @_; # TODO: fire off </item-number> or </item-bullet> or </item-text> ?? @@ -1578,10 +1354,10 @@ sub _ponder_item { ; return 1; } - - + + my $over_type = $over->[1]{'~type'}; - + if(!$over_type) { # Shouldn't happen1 die "Typeless over in stack, starting at line " @@ -1606,7 +1382,7 @@ sub _ponder_item { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + if($item_type eq 'text') { # Nothing special needs doing for 'text' } elsif($item_type eq 'number' or $item_type eq 'bullet') { @@ -1622,16 +1398,16 @@ sub _ponder_item { } else { die "Unhandled item type $item_type"; # should never happen } - + # =item-text thingies don't need any assimilation, it seems. } elsif($over_type eq 'number') { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + my $expected_value = ++ $curr_open->[-1][1]{'~counter'}; - + if($item_type eq 'bullet') { # Hm, it's not numeric. Correct for this. $para->[1]{'number'} = $expected_value; @@ -1656,7 +1432,7 @@ sub _ponder_item { } elsif($expected_value == $para->[1]{'number'}) { DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n"; - + } else { DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'}, " instead of the expected value of $expected_value\n"; @@ -1667,7 +1443,7 @@ sub _ponder_item { ); $para->[1]{'number'} = $expected_value; # correcting!! } - + if(@$para == 2) { # For the cases where we /didn't/ push to @$para if($paras->[0][0] eq '~Para') { @@ -1684,13 +1460,13 @@ sub _ponder_item { my $item_type = $self->_get_item_type($para); # That kills the content of the item if it's a number or bullet. DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n"; - + if($item_type eq 'bullet') { # as expected! if( $para->[1]{'~_freaky_para_hack'} ) { DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n"; - push @$para, $para->[1]{'~_freaky_para_hack'}; + push @$para, delete $para->[1]{'~_freaky_para_hack'}; } } elsif($item_type eq 'number') { @@ -1757,36 +1533,30 @@ sub _ponder_Verbatim { $para->[1]{'xml:space'} = 'preserve'; - unless ($self->{'_output_is_for_JustPod'}) { - my $indent = $self->strip_verbatim_indent; - if ($indent && ref $indent eq 'CODE') { - my @shifted = (shift @{$para}, shift @{$para}); - $indent = $indent->($para); - unshift @{$para}, @shifted; - } - - for(my $i = 2; $i < @$para; $i++) { - foreach my $line ($para->[$i]) { # just for aliasing - # Strip indentation. - $line =~ s/^\Q$indent// if $indent; + my $indent = $self->strip_verbatim_indent; + if ($indent && ref $indent eq 'CODE') { + my @shifted = (shift @{$para}, shift @{$para}); + $indent = $indent->($para); + unshift @{$para}, @shifted; + } - # This is commented out because of github issue #85, and the - # current maintainers don't know why it was there in the first - # place. - #&& !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted}); - while( $line =~ - # Sort of adapted from Text::Tabs -- yes, it's hardwired in that - # tabs are at every EIGHTH column. For portability, it has to be - # one setting everywhere, and 8th wins. - s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e - ) {} + for(my $i = 2; $i < @$para; $i++) { + foreach my $line ($para->[$i]) { # just for aliasing + # Strip indentation. + $line =~ s/^\Q$indent// if $indent + && !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted}); + while( $line =~ + # Sort of adapted from Text::Tabs -- yes, it's hardwired in that + # tabs are at every EIGHTH column. For portability, it has to be + # one setting everywhere, and 8th wins. + s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e + ) {} - # TODO: whinge about (or otherwise treat) unindented or overlong lines + # TODO: whinge about (or otherwise treat) unindented or overlong lines - } } } - + # Now the VerbatimFormatted hoodoo... if( $self->{'accept_codes'} and $self->{'accept_codes'}{'VerbatimFormatted'} @@ -1826,7 +1596,7 @@ sub _traverse_treelet_bit { # for use only by the routine above my $scratch; $self->_handle_element_start(($scratch=$name), shift @_); - + while (@_) { my $x = shift; if (ref($x)) { @@ -1836,7 +1606,7 @@ sub _traverse_treelet_bit { # for use only by the routine above $self->_handle_text($x); } } - + $self->_handle_element_end($scratch=$name); return; } @@ -1881,7 +1651,7 @@ sub _closers_for_all_curr_open { sub _verbatim_format { my($it, $p) = @_; - + my $formatting; for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines @@ -1889,7 +1659,7 @@ sub _verbatim_format { $p->[$i] .= "\n"; # Unlike with simple Verbatim blocks, we don't end up just doing # a join("\n", ...) on the contents, so we have to append a - # newline to every line, and then nix the last one later. + # newline to ever line, and then nix the last one later. } if( DEBUG > 4 ) { @@ -1902,7 +1672,7 @@ sub _verbatim_format { for(my $i = $#$p; $i > 2; $i--) { # work backwards over the lines, except the first (#2) - + #next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s # and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s; # look at a formatty line preceding a nonformatty one @@ -1910,7 +1680,7 @@ sub _verbatim_format { if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) { DEBUG > 5 and print STDERR " It's a formatty line. ", "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n"; - + if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) { DEBUG > 5 and print STDERR " Previous line is formatty! Skipping this one.\n"; next; @@ -1926,11 +1696,11 @@ sub _verbatim_format { # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic. # Example: # What do you want? i like pie. [or whatever] - # #:^^^^^^^^^^^^^^^^^ ///////////// - + # #:^^^^^^^^^^^^^^^^^ ///////////// + DEBUG > 4 and print STDERR "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n"; - + $formatting = ' ' . $1; $formatting =~ s/\s+$//s; # nix trailing whitespace unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op @@ -1946,7 +1716,7 @@ sub _verbatim_format { } # Make $formatting and the previous line be exactly the same length, # with $formatting having a " " as the last character. - + DEBUG > 4 and print STDERR "Formatting <$formatting> on <", $p->[$i-1], ">\n"; @@ -1971,10 +1741,10 @@ sub _verbatim_format { #print STDERR "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n"; } } - my @nixed = + my @nixed = splice @$p, $i-1, 2, @new_line; # replace myself and the next line DEBUG > 10 and print STDERR "Nixed count: ", scalar(@nixed), "\n"; - + DEBUG > 6 and print STDERR "New version of the above line is these tokens (", scalar(@new_line), "):", map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n"; @@ -2021,46 +1791,29 @@ sub _treelet_from_formatting_codes { # [ 'B', {}, "pie" ], # "!" # ] - # This illustrates the general format of a treelet. It is an array: - # [0] is a scalar indicating its type. In the example above, the - # types are '~Top' and 'B' - # [1] is a hash of various flags about it, possibly empty - # [2] - [N] are an ordered list of the subcomponents of the treelet. - # Scalars are literal text, refs are sub-treelets, to - # arbitrary levels. Stringifying a treelet will recursively - # stringify the sub-treelets, concatentating everything - # together to form the exact text of the treelet. - + my($self, $para, $start_line, $preserve_space) = @_; - + my $treelet = ['~Top', {'start_line' => $start_line},]; - + unless ($preserve_space || $self->{'preserve_whitespace'}) { $para =~ s/\s+/ /g; # collapse and trim all whitespace first. $para =~ s/ $//; $para =~ s/^ //; } - + # Only apparent problem the above code is that N<< >> turns into # N<< >>. But then, word wrapping does that too! So don't do that! - - - # As a Start-code is encountered, the number of opening bracket '<' - # characters minus 1 is pushed onto @stack (so 0 means a single bracket, - # etc). When closing brackets are found in the text, at least this number - # (plus the 1) will be required to mean the Start-code is terminated. When - # those are found, @stack is popped. + my @stack; - my @lineage = ($treelet); my $raw = ''; # raw content of L<> fcode before splitting/processing # XXX 'raw' is not 100% accurate: all surrounding whitespace is condensed - # into just 1 ' '. Is this the regex's doing or 'raw's? Answer is it's - # the 'collapse and trim all whitespace first' lines just above. + # into just 1 ' '. Is this the regex's doing or 'raw's? my $inL = 0; DEBUG > 4 and print STDERR "Paragraph:\n$para\n\n"; - + # Here begins our frightening tokenizer RE. The following regex matches # text in four main parts: # @@ -2093,11 +1846,7 @@ sub _treelet_from_formatting_codes { | # Match multiple-bracket end codes. $3 gets the whitespace that # should be discarded before an end bracket but kept in other cases - # and $4 gets the end brackets themselves. ($3 can be empty if the - # construct is empty, like C<< >>, and all the white-space has been - # gobbled up already, considered to be space after the opening - # bracket. In this case we use look-behind to verify that there are - # at least 2 spaces in a row before the ">".) + # and $4 gets the end brackets themselves. (\s+|(?<=\s\s))(>{2,}) | (\s?>) # $5: simple end-codes @@ -2123,48 +1872,23 @@ sub _treelet_from_formatting_codes { ) { DEBUG > 4 and print STDERR "\nParagraphic tokenstack = (@stack)\n"; if(defined $1) { - my $bracket_count; # How many '<<<' in a row this has. Needed for - # Pod::Simple::JustPod if(defined $2) { DEBUG > 3 and print STDERR "Found complex start-text code \"$1\"\n"; - $bracket_count = length($2) + 1; - push @stack, $bracket_count; # length of the necessary complex - # end-code string + push @stack, length($2) + 1; + # length of the necessary complex end-code string } else { DEBUG > 3 and print STDERR "Found simple start-text code \"$1\"\n"; push @stack, 0; # signal that we're looking for simple - $bracket_count = 1; } - my $code = substr($1,0,1); - if ('L' eq $code) { - if ($inL) { - $raw .= $1; - $self->scream( $start_line, - 'Nested L<> are illegal. Pretending inner one is ' - . 'X<...> so can continue looking for other errors.'); - $code = "X"; - } - else { - $raw = ""; # reset raw content accumulator - $inL = @stack; - } + push @lineage, [ substr($1,0,1), {}, ]; # new node object + push @{ $lineage[-2] }, $lineage[-1]; + if ('L' eq substr($1,0,1)) { + $raw = $inL ? $raw.$1 : ''; # reset raw content accumulator + $inL = 1; } else { $raw .= $1 if $inL; } - push @lineage, [ $code, {}, ]; # new node object - - # Tell Pod::Simple::JustPod how many brackets there were, but to save - # space, not in the most usual case of there was just 1. It can be - # inferred by the absence of this element. Similarly, if there is more - # than one bracket, extract the white space between the final bracket - # and the real beginning of the interior. Save that if it isn't just a - # single space - if ($self->{'_output_is_for_JustPod'} && $bracket_count > 1) { - $lineage[-1][1]{'~bracket_count'} = $bracket_count; - my $lspacer = substr($1, 1 + $bracket_count); - $lineage[-1][1]{'~lspacer'} = $lspacer if $lspacer ne " "; - } - push @{ $lineage[-2] }, $lineage[-1]; + } elsif(defined $4) { DEBUG > 3 and print STDERR "Found apparent complex end-text code \"$3$4\"\n"; # This is where it gets messy... @@ -2193,35 +1917,20 @@ sub _treelet_from_formatting_codes { } #print STDERR "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n"; - if ($3 ne " " && $self->{'_output_is_for_JustPod'}) { - if ($3 ne "") { - $lineage[-1][1]{'~rspacer'} = $3; - } - elsif ($lineage[-1][1]{'~lspacer'} eq " ") { - - # Here we had something like C<< >> which was a false positive - delete $lineage[-1][1]{'~lspacer'}; - } - else { - $lineage[-1][1]{'~rspacer'} - = substr($lineage[-1][1]{'~lspacer'}, -1, 1); - chop $lineage[-1][1]{'~lspacer'}; - } - } - push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] }; # Keep the element from being childless - - if ($inL == @stack) { - $lineage[-1][1]{'raw'} = $raw; - $inL = 0; - } - + pop @stack; pop @lineage; + unless (@stack) { # not in an L if there are no open fcodes + $inL = 0; + if (ref $lineage[-1][-1] && $lineage[-1][-1][0] eq 'L') { + $lineage[-1][-1][1]{'raw'} = $raw + } + } $raw .= $3.$4 if $inL; - + } elsif(defined $5) { DEBUG > 3 and print STDERR "Found apparent simple end-text code \"$5\"\n"; @@ -2235,11 +1944,6 @@ sub _treelet_from_formatting_codes { push @{ $lineage[-1] }, ''; # keep it from being really childless } - if ($inL == @stack) { - $lineage[-1][1]{'raw'} = $raw; - $inL = 0; - } - pop @stack; pop @lineage; } else { @@ -2247,6 +1951,12 @@ sub _treelet_from_formatting_codes { push @{ $lineage[-1] }, $5; } + unless (@stack) { # not in an L if there are no open fcodes + $inL = 0; + if (ref $lineage[-1][-1] && $lineage[-1][-1][0] eq 'L') { + $lineage[-1][-1][1]{'raw'} = $raw + } + } $raw .= $5 if $inL; } elsif(defined $6) { @@ -2255,7 +1965,6 @@ sub _treelet_from_formatting_codes { $raw .= $6 if $inL; # XXX does not capture multiplace whitespaces -- 'raw' ends up with # at most 1 leading/trailing whitespace, why not all of it? - # Answer, because we deliberately trimmed it above } else { # should never ever ever ever happen @@ -2386,7 +2095,7 @@ sub pretty { # adopted from Class::Classless # letters, but I don't know if it has always worked without bugs. It # seemed safest just to list the characters. # s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> - s<([^ !"#'()*+,\-./0123456789:;\<=\>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]^_`abcdefghijklmnopqrstuvwxyz{|}~])> + s<([^ !#'()*+,\-./0123456789:;\<=\>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]^_`abcdefghijklmnopqrstuvwxyz{|}~])> <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg; #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg; qq{"$_"}; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm b/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm index b30dd66296..83415f8e25 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm @@ -9,7 +9,7 @@ use Carp (); use Pod::Simple::Methody (); use Pod::Simple (); use vars qw( @ISA $VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG @@ -88,10 +88,8 @@ sub end_item_text { $_[0]->emit_par(-2) } sub emit_par { return unless $_[0]{'Errata_seen'}; my($self, $tweak_indent) = splice(@_,0,2); - my $length = 2 * $self->{'Indent'} + ($tweak_indent||0); - my $indent = ' ' x ($length > 0 ? $length : 0); + my $indent = ' ' x ( 2 * $self->{'Indent'} + ($tweak_indent||0) ); # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0 - # 'Negative repeat count does nothing' since 5.22 $self->{'Thispara'} =~ s/$Pod::Simple::shy//g; my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n"); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm index aa714db47a..428cc72359 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm @@ -2,7 +2,7 @@ require 5; package Pod::Simple::Debug; use strict; use vars qw($VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; sub import { my($value,$variable); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm index 2de11f19fb..71bef5070b 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::DumpAsText; -$VERSION = '3.36'; +$VERSION = '3.35'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm index b68597fb68..9d84878cb7 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::DumpAsXML; -$VERSION = '3.36'; +$VERSION = '3.35'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm index 977e92ff32..9cdbed217e 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm @@ -9,7 +9,7 @@ use vars qw( $Doctype_decl $Content_decl ); @ISA = ('Pod::Simple::PullParser'); -$VERSION = '3.36'; +$VERSION = '3.35'; BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } @@ -29,7 +29,7 @@ $LamePad = '' unless defined $LamePad; $Linearization_Limit = 120 unless defined $Linearization_Limit; # headings/items longer than that won't get an <a name="..."> -$Perldoc_URL_Prefix = 'https://metacpan.org/pod/' +$Perldoc_URL_Prefix = 'http://search.cpan.org/perldoc?' unless defined $Perldoc_URL_Prefix; $Perldoc_URL_Postfix = '' unless defined $Perldoc_URL_Postfix; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm index 58cd1ee9a8..661266d0de 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm @@ -5,7 +5,7 @@ use strict; use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA ); -$VERSION = '3.36'; +$VERSION = '3.35'; @ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML! # TODO: nocontents stylesheets. Strike some of the color variations? @@ -720,21 +720,22 @@ sub _gen_css_wad { } # Now a few indexless variations: - for (my ($outfile, $variation) = each %{{ - blkbluw => 'black_with_blue_on_white', - whtpurk => 'white_with_purple_on_black', - whtgrng => 'white_with_green_on_grey', - grygrnw => 'grey_with_green_on_white', - }}) { + foreach my $variation ( + 'blkbluw', # black_with_blue_on_white + 'whtpurk', # white_with_purple_on_black + 'whtgrng', # white_with_green_on_grey + 'grygrnw', # grey_with_green_on_white + ) { + my $outname = $variation; my $this_css = join "\n", - "/* This file is autogenerated. Do not edit. $outfile */\n", + "/* This file is autogenerated. Do not edit. $outname */\n", "\@import url(\"./_$variation.css\");", ".indexgroup { display: none; }", "\n", ; - my $name = $outfile; + my $name = $outname; $name =~ tr/-_/ /; - $self->add_css( "_$outfile.css", 0, $name, 0, 0, \$this_css); + $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css); } return; @@ -1109,15 +1110,12 @@ Example: =item $batchconv = Pod::Simple::HTMLBatch->new; -This creates a new batch converter. The method doesn't take parameters. -To change the converter's attributes, use the L<"/ACCESSOR METHODS"> -below. +This TODO + =item $batchconv->batch_convert( I<indirs>, I<outdir> ); -This searches the directories given in I<indirs> and writes -HTML files for each of these to a corresponding directory -in I<outdir>. The directory I<outdir> must exist. +this TODO =item $batchconv->batch_convert( undef , ...); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/JustPod.pm b/cpan/Pod-Simple/lib/Pod/Simple/JustPod.pm deleted file mode 100644 index c7ad3d6977..0000000000 --- a/cpan/Pod-Simple/lib/Pod/Simple/JustPod.pm +++ /dev/null @@ -1,362 +0,0 @@ -use 5; -package Pod::Simple::JustPod; -# ABSTRACT: Pod::Simple formatter that extracts POD from a file containing -# other things as well -use strict; -use warnings; - -use Pod::Simple::Methody (); -our @ISA = ('Pod::Simple::Methody'); - -sub new { - my $self = shift; - my $new = $self->SUPER::new(@_); - - $new->accept_targets('*'); - $new->keep_encoding_directive(1); - $new->preserve_whitespace(1); - $new->complain_stderr(1); - $new->_output_is_for_JustPod(1); - - return $new; -} - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -sub check_that_all_is_closed { - - # Actually checks that the things we depend on being balanced in fact are, - # so that we can continue in spit of pod errors - - my $self = shift; - while ($self->{inL}) { - $self->end_L(@_); - } - while ($self->{fcode_end} && @{$self->{fcode_end}}) { - $self->_end_fcode(@_); - } -} - -sub handle_text { - - # Add text to the output buffer. This is skipped if within a L<>, as we use - # the 'raw' attribute of that tag instead. - - $_[0]{buffer} .= $_[1] unless $_[0]{inL} ; -} - -sub spacer { - - # Prints the white space following things like =head1. This is normally a - # blank, unless BlackBox has told us otherwise. - - my ($self, $arg) = @_; - return unless $arg; - - my $spacer = ($arg->{'~orig_spacer'}) - ? $arg->{'~orig_spacer'} - : " "; - $self->handle_text($spacer); -} - -sub _generic_start { - - # Called from tags like =head1, etc. - - my ($self, $text, $arg) = @_; - $self->check_that_all_is_closed(); - $self->handle_text($text); - $self->spacer($arg); -} - -sub start_Document { shift->_generic_start("=pod\n\n"); } -sub start_head1 { shift->_generic_start('=head1', @_); } -sub start_head2 { shift->_generic_start('=head2', @_); } -sub start_head3 { shift->_generic_start('=head3', @_); } -sub start_head4 { shift->_generic_start('=head4', @_); } -sub start_encoding { shift->_generic_start('=encoding', @_); } -# sub start_Para -# sub start_Verbatim - -sub start_item_bullet { # Handle =item * - my ($self, $arg) = @_; - $self->check_that_all_is_closed(); - $self->handle_text('=item'); - - # It can be that they said simply '=item', and it is inferred that it is to - # be a bullet. - if (! $arg->{'~orig_content'}) { - $self->handle_text("\n\n"); - } - else { - $self->spacer($arg); - if ($arg->{'~_freaky_para_hack'}) { - - # See Message Id <87y3gtcwa2.fsf@hope.eyrie.org> - my $item_text = $arg->{'~orig_content'}; - my $trailing = quotemeta $arg->{'~_freaky_para_hack'}; - $item_text =~ s/$trailing$//; - $self->handle_text($item_text); - } - else { - $self->handle_text("*\n\n"); - } - } -} - -sub start_item_number { # Handle '=item 2' - my ($self, $arg) = @_; - $self->check_that_all_is_closed(); - $self->handle_text("=item"); - $self->spacer($arg); - $self->handle_text("$arg->{'~orig_content'}\n\n"); -} - -sub start_item_text { # Handle '=item foo bar baz' - my ($self, $arg) = @_; - $self->check_that_all_is_closed(); - $self->handle_text('=item'); - $self->spacer($arg); -} - -sub _end_item { - my $self = shift; - $self->check_that_all_is_closed(); - $self->emit; -} - -*end_item_bullet = *_end_item; -*end_item_number = *_end_item; -*end_item_text = *_end_item; - -sub _start_over { # Handle =over - my ($self, $arg) = @_; - $self->check_that_all_is_closed(); - $self->handle_text("=over"); - - # The =over amount is optional - if ($arg->{'~orig_content'}) { - $self->spacer($arg); - $self->handle_text("$arg->{'~orig_content'}"); - } - $self->handle_text("\n\n"); -} - -*start_over_bullet = *_start_over; -*start_over_number = *_start_over; -*start_over_text = *_start_over; -*start_over_block = *_start_over; - -sub _end_over { - my $self = shift; - $self->check_that_all_is_closed(); - $self->handle_text('=back'); - $self->emit; -} - -*end_over_bullet = *_end_over; -*end_over_number = *_end_over; -*end_over_text = *_end_over; -*end_over_block = *_end_over; - -sub end_Document { - my $self = shift; - $self->emit; # Make sure buffer gets flushed - print {$self->{'output_fh'} } "=cut\n" -} - -sub _end_generic { - my $self = shift; - $self->check_that_all_is_closed(); - $self->emit; -} - -*end_head1 = *_end_generic; -*end_head2 = *_end_generic; -*end_head3 = *_end_generic; -*end_head4 = *_end_generic; -*end_encoding = *_end_generic; -*end_Para = *_end_generic; -*end_Verbatim = *_end_generic; - -sub _start_fcode { - my ($type, $self, $flags) = @_; - - # How many brackets is set by BlackBox unless the count is 1 - my $bracket_count = (exists $flags->{'~bracket_count'}) - ? $flags->{'~bracket_count'} - : 1; - $self->handle_text($type . ( "<" x $bracket_count)); - - my $rspacer = ""; - if ($bracket_count > 1) { - my $lspacer = (exists $flags->{'~lspacer'}) - ? $flags->{'~lspacer'} - : " "; - $self->handle_text($lspacer); - - $rspacer = (exists $flags->{'~rspacer'}) - ? $flags->{'~rspacer'} - : " "; - } - - # BlackBox doesn't output things for for the ending code callbacks, so save - # what we need. - push @{$self->{'fcode_end'}}, [ $bracket_count, $rspacer ]; -} - -sub start_B { _start_fcode('B', @_); } -sub start_C { _start_fcode('C', @_); } -sub start_E { _start_fcode('E', @_); } -sub start_F { _start_fcode('F', @_); } -sub start_I { _start_fcode('I', @_); } -sub start_S { _start_fcode('S', @_); } -sub start_X { _start_fcode('X', @_); } -sub start_Z { _start_fcode('Z', @_); } - -sub _end_fcode { - my $self = shift; - my $fcode_end = pop @{$self->{'fcode_end'}}; - my $bracket_count = 1; - my $rspacer = ""; - - if (! defined $fcode_end) { # If BlackBox is working, this shouldn't - # happen, but verify - $self->whine($self->{line_count}, "Extra '>'"); - } - else { - $bracket_count = $fcode_end->[0]; - $rspacer = $fcode_end->[1]; - } - - $self->handle_text($rspacer) if $bracket_count > 1; - $self->handle_text(">" x $bracket_count); -} - -*end_B = *_end_fcode; -*end_C = *_end_fcode; -*end_E = *_end_fcode; -*end_F = *_end_fcode; -*end_I = *_end_fcode; -*end_S = *_end_fcode; -*end_X = *_end_fcode; -*end_Z = *_end_fcode; - -sub start_L { - _start_fcode('L', @_); - $_[0]->handle_text($_[1]->{raw}); - $_[0]->{inL}++ -} - -sub end_L { - my $self = shift; - $self->{inL}--; - if ($self->{inL} < 0) { # If BlackBox is working, this shouldn't - # happen, but verify - $self->whine($self->{line_count}, "Extra '>' ending L<>"); - $self->{inL} = 0; - } - - $self->_end_fcode(@_); -} - -sub emit { - my $self = shift; - - if ($self->{buffer} ne "") { - print { $self->{'output_fh'} } "",$self->{buffer} ,"\n\n"; - - $self->{buffer} = ""; - } - - return; -} - -1; - -__END__ - -=head1 NAME - -Pod::Simple::JustPod -- just the Pod, the whole Pod, and nothing but the Pod - -=head1 SYNOPSIS - - my $infile = "mixed_code_and_pod.pm"; - my $outfile = "just_the_pod.pod"; - open my $fh, ">$outfile" or die "Can't write to $outfile: $!"; - - my $parser = Pod::Simple::JustPod->new(); - $parser->output_fh($fh); - $parser->parse_file($infile); - close $fh or die "Can't close $outfile: $!"; - -=head1 DESCRIPTION - -This class returns a copy of its input, translated into Perl's internal -encoding (UTF-8), and with all the non-Pod lines removed. - -This is a subclass of L<Pod::Simple::Methody> and inherits all its methods. -And since, that in turn is a subclass of L<Pod::Simple>, you can use any of -its methods. This means you can output to a string instead of a file, or -you can parse from an array. - -This class strives to return the Pod lines of the input completely unchanged, -except for any necessary translation into Perl's internal encoding, and it makes -no effort to return trailing spaces on lines; these likely will be stripped. -If the input pod is well-formed with no warnings nor errors generated, the -extracted pod should generate the same documentation when formatted by a Pod -formatter as the original file does. - -By default, warnings are output to STDERR - -=head1 SEE ALSO - -L<Pod::Simple>, L<Pod::Simple::Methody> - -=head1 SUPPORT - -Questions or discussion about POD and Pod::Simple should be sent to the -L<mailto:pod-people@perl.org> mail list. Send an empty email to -L<mailto:pod-people-subscribe@perl.org> to subscribe. - -This module is managed in an open GitHub repository, -L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or -to clone L<git://github.com/theory/pod-simple.git> and send patches! - -Patches against Pod::Simple are welcome. Please send bug reports to -L<mailto:<bug-pod-simple@rt.cpan.org>. - -=head1 COPYRIGHT AND DISCLAIMERS - -Copyright (c) 2002 Sean M. Burke. - -This library is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - -This program is distributed in the hope that it will be useful, but -without any warranty; without even the implied warranty of -merchantability or fitness for a particular purpose. - -=head1 AUTHOR - -Pod::Simple was created by Sean M. Burke <sburke@cpan.org>. -But don't bother him, he's retired. - -Pod::Simple is maintained by: - -=over - -=item * Allison Randal C<allison@perl.org> - -=item * Hans Dieter Pearcey C<hdp@cpan.org> - -=item * David E. Wheeler C<dwheeler@cpan.org> - -=back - -Pod::Simple::JustPod was developed by John SJ Anderson -C<genehack@genehack.org>, with contributions from Karl Williamson -C<khw@cpan.org>. - -=cut diff --git a/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm b/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm index 4b8e34fdd1..04612f202e 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm @@ -2,11 +2,13 @@ require 5; package Pod::Simple::LinkSection; # Based somewhat dimly on Array::Autojoin +use vars qw($VERSION ); +$VERSION = '3.35'; use strict; use Pod::Simple::BlackBox; use vars qw($VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; use overload( # So it'll stringify nice '""' => \&Pod::Simple::BlackBox::stringify_lol, diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm b/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm index 993f6e4a67..67b8706741 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm @@ -4,7 +4,7 @@ package Pod::Simple::Methody; use strict; use Pod::Simple (); use vars qw(@ISA $VERSION); -$VERSION = '3.36'; +$VERSION = '3.35'; @ISA = ('Pod::Simple'); # Yes, we could use named variables, but I want this to be impose diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm b/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm index fa983240d2..0c18a5b37d 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::Progress; -$VERSION = '3.36'; +$VERSION = '3.35'; use strict; # Objects of this class are used for noting progress of an diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm index 672c6fc47e..7c326ec6ae 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm @@ -1,6 +1,6 @@ require 5; package Pod::Simple::PullParser; -$VERSION = '3.36'; +$VERSION = '3.35'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm index b3196e49cb..d3066a8e87 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.36'; +$VERSION = '3.35'; sub new { # Class->new(tagname); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm index 01670470b1..d938e0adb2 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.36'; +$VERSION = '3.35'; sub new { # Class->new(tagname, optional_attrhash); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm index 5cdd3baa0d..a11ce0fd92 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.36'; +$VERSION = '3.35'; sub new { # Class->new(text); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm index 75044d6fab..c6618168e6 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm @@ -3,7 +3,7 @@ require 5; package Pod::Simple::PullParserToken; # Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token @ISA = (); -$VERSION = '3.36'; +$VERSION = '3.35'; use strict; sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway diff --git a/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm b/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm index 9c4a8e3835..153c3d3e28 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm @@ -8,67 +8,24 @@ package Pod::Simple::RTF; use strict; use vars qw($VERSION @ISA %Escape $WRAP %Tagmap); -$VERSION = '3.36'; +$VERSION = '3.35'; use Pod::Simple::PullParser (); BEGIN {@ISA = ('Pod::Simple::PullParser')} use Carp (); BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG } -sub to_uni ($) { # Convert native code point to Unicode - my $x = shift; - - # Broken for early EBCDICs - $x = chr utf8::native_to_unicode(ord $x) if $] ge 5.007_003 - && ord("A") != 65; - return $x; -} - -# We escape out 'F' so that we can send RTF files thru the mail without the -# slightest worry that paragraphs beginning with "From" will get munged. -# We also escape '\', '{', '}', and '_' -my $map_to_self = ' !"#$%&\'()*+,-./0123456789:;<=>?@ABCDEGHIJKLMNOPQRSTUVWXYZ[]^`abcdefghijklmnopqrstuvwxyz|~'; - $WRAP = 1 unless defined $WRAP; -%Escape = ( - - # Start with every character mapping to its hex equivalent - map( (chr($_) => sprintf("\\'%02x", $_)), 0 .. 0xFF), - - # Override most ASCII printables with themselves (or on non-ASCII platforms, - # their ASCII values. This is because the output is UTF-16, which is always - # based on Unicode code points) - map( ( substr($map_to_self, $_, 1) - => to_uni(substr($map_to_self, $_, 1))), 0 .. length($map_to_self) - 1), - - # And some refinements: - "\r" => "\n", - "\cj" => "\n", - "\n" => "\n\\line ", - - "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay) - "\f" => "\n\\page\n", # Formfeed - "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen - $Pod::Simple::nbsp => "\\~", # Latin-1 non-breaking space - $Pod::Simple::shy => "\\-", # Latin-1 soft (optional) hyphen - # CRAZY HACKS: - "\n" => "\\line\n", - "\r" => "\n", - "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1 - "\cc" => "}", -); +# These are broken for early Perls on EBCDIC; they could be fixed to work +# better there, but not worth it. These are part of a larger [...] class, so +# are just the strings to substitute into it, as opposed to compiled patterns. +my $cntrl = '[:cntrl:]'; +$cntrl = '\x00-\x1F\x7F' unless eval "qr/[$cntrl]/"; -# Generate a string of all the characters in %Escape that don't map to -# themselves. First, one without the hyphen, then one with. -my $escaped_sans_hyphen = ""; -$escaped_sans_hyphen .= $_ for grep { $_ ne $Escape{$_} && $_ ne '-' } - sort keys %Escape; -my $escaped = "-$escaped_sans_hyphen"; +my $not_ascii = '[:^ascii:]'; +$not_ascii = '\x80-\xFF' unless eval "qr/[$not_ascii]/"; -# Then convert to patterns -$escaped_sans_hyphen = qr/[\Q$escaped_sans_hyphen \E]/; -$escaped= qr/[\Q$escaped\E]/; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -201,13 +158,6 @@ sub run { #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# Match something like an identifier. Prefer XID if available, then plain ID, -# then just ASCII -my $id_re = Pod::Simple::BlackBox::my_qr('[\'_\p{XIDS}][\'\p{XIDC}]+', "ab"); -$id_re = Pod::Simple::BlackBox::my_qr('[\'_\p{IDS}][\'\p{IDC}]+', "ab") - unless $id_re; -$id_re = qr/['_a-zA-Z]['a-zA-Z0-9_]+/ unless $id_re; - sub do_middle { # the main work my $self = $_[0]; my $fh = $self->{'output_fh'}; @@ -222,7 +172,7 @@ sub do_middle { # the main work if( ($type = $token->type) eq 'text' ) { if( $self->{'rtfverbatim'} ) { DEBUG > 1 and print STDERR " $type " , $token->text, " in verbatim!\n"; - rtf_esc(0, $scratch = $token->text); # 0 => Don't escape hyphen + rtf_esc_codely($scratch = $token->text); print $fh $scratch; next; } @@ -245,13 +195,13 @@ sub do_middle { # the main work | # or starting alpha, but containing anything strange: (?: - ${id_re}[\$\@\:_<>\(\\\*]\S+ + [a-zA-Z'${not_ascii}]+[\$\@\:_<>\(\\\*]\S+ ) ) /\cb$1\cc/xsg ; - rtf_esc(1, $scratch); # 1 => escape hyphen + rtf_esc($scratch); $scratch =~ s/( [^\r\n]{65} # Snare 65 characters from a line @@ -361,7 +311,7 @@ sub do_middle { # the main work print $fh $token->attr('number'), ". \n"; } elsif ($tagname eq 'item-bullet') { print $fh "\\'", ord("_"), "\n"; - #for funky testing: print $fh '', rtf_esc(1, "\x{4E4B}\x{9053}"); + #for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}"); } } elsif( $type eq 'end' ) { @@ -515,7 +465,7 @@ sub doc_start { # catches the most common case, at least DEBUG and print STDERR "Title0: <$title>\n"; - $title = rtf_esc(1, $title); # 1 => escape hyphen + $title = rtf_esc($title); DEBUG and print STDERR "Title1: <$title>\n"; $title = '\lang1024\noproof ' . $title if $is_obviously_module_name; @@ -539,69 +489,90 @@ END #------------------------------------------------------------------------- use integer; - -my $question_mark_code_points = - Pod::Simple::BlackBox::my_qr('([^\x00-\x{D7FF}\x{E000}-\x{10FFFF}])', - "\x{110000}"); -my $plane0 = - Pod::Simple::BlackBox::my_qr('([\x{100}-\x{FFFF}])', "\x{100}"); -my $other_unicode = - Pod::Simple::BlackBox::my_qr('([\x{10000}-\x{10FFFF}])', "\x{10000}"); - -sub esc_uni($) { - use if $] le 5.006002, 'utf8'; - - my $x = shift; - - # The output is expected to be UTF-16. Surrogates and above-Unicode get - # mapped to '?' - $x =~ s/$question_mark_code_points/?/g if $question_mark_code_points; - - # Non-surrogate Plane 0 characters get mapped to their code points. But - # the standard calls for a 16bit SIGNED value. - $x =~ s/$plane0/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg - if $plane0; - - # Use surrogate pairs for the rest - $x =~ s/$other_unicode/'\\uc1\\u' . ((ord($1) >> 10) + 0xD7C0 - 65536) . '\\u' . (((ord$1) & 0x03FF) + 0xDC00 - 65536) . '?'/eg if $other_unicode; - +sub rtf_esc { + my $x; # scratch + if(!defined wantarray) { # void context: alter in-place! + for(@_) { + s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER + s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; + } + return; + } elsif(wantarray) { # return an array + return map {; ($x = $_) =~ + s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER + $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; + $x; + } @_; + } else { # return a single scalar + ($x = ((@_ == 1) ? $_[0] : join '', @_) + ) =~ s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER + # Escape \, {, }, -, control chars, and 7f-ff. + $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; return $x; + } } -sub rtf_esc ($$) { - # The parameter is true if we should escape hyphens - my $escape_re = ((shift) ? $escaped : $escaped_sans_hyphen); - - # When false, it doesn't change "-" to hard-hyphen. - # We don't want to change the "-" to hard-hyphen, because we want to +sub rtf_esc_codely { + # Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts. + # We don't want to change the "-" to hard-hyphen, because we want to # be able to paste this into a file and run it without there being # dire screaming about the mysterious hard-hyphen character (which # looks just like a normal dash character). - # XXX The comments used to claim that when false it didn't apply computerese - # style-smarts, but khw didn't see this actually - + my $x; # scratch if(!defined wantarray) { # void context: alter in-place! for(@_) { - s/($escape_re)/$Escape{$1}/g; # ESCAPER - $_ = esc_uni($_); + s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER + s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; } return; } elsif(wantarray) { # return an array return map {; ($x = $_) =~ - s/($escape_re)/$Escape{$1}/g; # ESCAPER - $x = esc_uni($x); + s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER + $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; $x; } @_; } else { # return a single scalar ($x = ((@_ == 1) ? $_[0] : join '', @_) - ) =~ s/($escape_re)/$Escape{$1}/g; # ESCAPER + ) =~ s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER # Escape \, {, }, -, control chars, and 7f-ff. - $x = esc_uni($x); + $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg; return $x; } } +%Escape = ( + (($] lt 5.007_003) # Broken for non-ASCII on early Perls + ? (map( (chr($_),chr($_)), # things not apparently needing escaping + 0x20 .. 0x7E ), + map( (chr($_),sprintf("\\'%02x", $_)), # apparently escapeworthy things + 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46)) + : (map( (chr(utf8::unicode_to_native($_)),chr(utf8::unicode_to_native($_))), + 0x20 .. 0x7E ), + map( (chr($_),sprintf("\\'%02x", utf8::unicode_to_native($_))), + 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46))), + + # We get to escape out 'F' so that we can send RTF files thru the mail + # without the slightest worry that paragraphs beginning with "From" + # will get munged. + + # And some refinements: + "\r" => "\n", + "\cj" => "\n", + "\n" => "\n\\line ", + + "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay) + "\f" => "\n\\page\n", # Formfeed + "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen + $Pod::Simple::nbsp => "\\~", # Latin-1 non-breaking space + $Pod::Simple::shy => "\\-", # Latin-1 soft (optional) hyphen + + # CRAZY HACKS: + "\n" => "\\line\n", + "\r" => "\n", + "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1 + "\cc" => "}", +); 1; __END__ diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Search.pm b/cpan/Pod-Simple/lib/Pod/Simple/Search.pm index 37c8e24c6b..df499cacf2 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Search.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Search.pm @@ -3,7 +3,7 @@ package Pod::Simple::Search; use strict; use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); -$VERSION = '3.36'; ## Current version of this package +$VERSION = '3.35'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); @@ -546,7 +546,7 @@ sub _limit_glob_to_limit_re { sub _actual_filenames { my $dir = shift; my $fn = lc shift; - opendir my ($dh), $dir or return; + opendir my $dh, $dir or return; return map { File::Spec->catdir($dir, $_) } grep { lc $_ eq $fn } readdir $dh; } diff --git a/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm b/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm index a6cdc8693c..bff5af84c4 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm @@ -5,7 +5,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '3.36'; +$VERSION = '3.35'; BEGIN { @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Subclassing.pod b/cpan/Pod-Simple/lib/Pod/Simple/Subclassing.pod index f9cb09a52e..88f85e86de 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Subclassing.pod +++ b/cpan/Pod-Simple/lib/Pod/Simple/Subclassing.pod @@ -98,14 +98,9 @@ nodes that represent preformatted text (from verbatim sections). TODO intro... mention that events are supplied for implicits, like for missing >'s -In the following section, we use XML to represent the event structure -associated with a particular construct. That is, an opening tag -represents the element start, the attributes of that opening tag are -the attributes given to the callback, and the closing tag represents -the end element. -Three callback methods must be supplied by a class extending -L<Pod::Simple> to receive the corresponding event: +In the following section, we use XML to represent the event structure +associated with a particular construct. That is, TODO =over @@ -117,9 +112,8 @@ L<Pod::Simple> to receive the corresponding event: =back -Here's the comprehensive list of values you can expect as -I<element_name> in your implementation of C<_handle_element_start> -and C<_handle_element_end>:: +TODO describe + =over diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Text.pm b/cpan/Pod-Simple/lib/Pod/Simple/Text.pm index 35166d7309..66e15f48cc 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Text.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Text.pm @@ -6,7 +6,7 @@ use Carp (); use Pod::Simple::Methody (); use Pod::Simple (); use vars qw( @ISA $VERSION $FREAKYMODE); -$VERSION = '3.36'; +$VERSION = '3.35'; @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm b/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm index 5db95ccc17..980612b313 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm @@ -6,7 +6,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( @ISA $VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; @ISA = ('Pod::Simple'); sub new { diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm b/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm index 277a321b44..a7364dfa58 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm @@ -4,7 +4,7 @@ package Pod::Simple::TiedOutFH; use Symbol ('gensym'); use Carp (); use vars qw($VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm b/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm index 6b4a43fdbd..a4bb29ffdb 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm @@ -3,7 +3,7 @@ require 5; package Pod::Simple::Transcode; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.36'; +$VERSION = '3.35'; BEGIN { if(defined &DEBUG) {;} # Okay diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm index dfded058d2..c206905657 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm @@ -5,7 +5,7 @@ require 5; package Pod::Simple::TranscodeDumb; use strict; use vars qw($VERSION %Supported); -$VERSION = '3.36'; +$VERSION = '3.35'; # This module basically pretends it knows how to transcode, except # only for null-transcodings! We use this when Encode isn't # available. diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm index c0ae1c6ac0..e4d4f7eb60 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm @@ -9,7 +9,7 @@ use strict; use Pod::Simple; require Encode; use vars qw($VERSION ); -$VERSION = '3.36'; +$VERSION = '3.35'; sub is_dumb {0} sub is_smart {1} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm index 10f9d52cae..8c2cf1a01b 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm @@ -45,7 +45,7 @@ declare the output character set as UTF-8 before parsing, like so: package Pod::Simple::XHTML; use strict; use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES ); -$VERSION = '3.36'; +$VERSION = '3.35'; use Pod::Simple::Methody (); @ISA = ('Pod::Simple::Methody'); @@ -92,7 +92,7 @@ the call to C<parse_file>: In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what to put before the "Foo%3a%3aBar". The default value is -"https://metacpan.org/pod/". +"http://search.cpan.org/perldoc?". =head2 perldoc_url_postfix @@ -247,7 +247,7 @@ sub new { my $self = shift; my $new = $self->SUPER::new(@_); $new->{'output_fh'} ||= *STDOUT{IO}; - $new->perldoc_url_prefix('https://metacpan.org/pod/'); + $new->perldoc_url_prefix('http://search.cpan.org/perldoc?'); $new->man_url_prefix('http://man.he.net/man'); $new->html_charset('ISO-8859-1'); $new->nix_X_codes(1); @@ -685,8 +685,8 @@ sub emit { Resolves a POD link target (typically a module or POD file name) and section name to a URL. The resulting link will be returned for the above examples as: - https://metacpan.org/pod/Net::Ping#INSTALL - https://metacpan.org/pod/perlpodspec + http://search.cpan.org/perldoc?Net::Ping#INSTALL + http://search.cpan.org/perldoc?perlpodspec #SYNOPSIS Note that when there is only a section argument the URL will simply be a link diff --git a/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm b/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm index 856b308bcb..62fe39549d 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm @@ -5,7 +5,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '3.36'; +$VERSION = '3.35'; BEGIN { @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; diff --git a/cpan/Pod-Simple/t/00about.t b/cpan/Pod-Simple/t/00about.t index 70fcffe12e..e5e7038e38 100644 --- a/cpan/Pod-Simple/t/00about.t +++ b/cpan/Pod-Simple/t/00about.t @@ -23,7 +23,7 @@ Pod::Simple Pod::Simple::BlackBox Pod::Simple::Checker Pod::Simple::DumpAsText Pod::Simple::DumpAsXML Pod::Simple::HTML Pod::Simple::HTMLBatch Pod::Simple::HTMLLegacy Pod::Simple::LinkSection Pod::Simple::Methody -Pod::Simple::JustPod Pod::Simple::Progress Pod::Simple::PullParser +Pod::Simple::Progress Pod::Simple::PullParser Pod::Simple::PullParserEndToken Pod::Simple::PullParserStartToken Pod::Simple::PullParserTextToken Pod::Simple::PullParserToken Pod::Simple::RTF Pod::Simple::Search Pod::Simple::SimpleTree diff --git a/cpan/Pod-Simple/t/JustPod01.t b/cpan/Pod-Simple/t/JustPod01.t deleted file mode 100644 index c74b3370cb..0000000000 --- a/cpan/Pod-Simple/t/JustPod01.t +++ /dev/null @@ -1,219 +0,0 @@ -#! user/bin/perl -w - -# t/JustPod01.t - check basics of Pod::Simple::JustPod - -BEGIN { - chdir 't' if -d 't'; -} - -use strict; -use lib '../lib'; -use Test::More tests => 2; - -use warnings; -use utf8; - -use_ok('Pod::Simple::JustPod') or exit; - -my $parser = Pod::Simple::JustPod->new(); - -my $input; -while ( <DATA> ) { $input .= $_ } - -my $output; -$parser->output_string( \$output ); -$parser->parse_string_document( $input ); - -# Strip off text before =pod in the input -$input =~ s/^.*(=pod.*)$/$1/mgs; - -my $msg = "got expected output"; -if ($output eq $input) { - pass($msg); -} -elsif ($ENV{PERL_TEST_DIFF}) { - fail($msg); - require File::Temp; - my $orig_file = File::Temp->new(); - local $/ = "\n"; - chomp $input; - print $orig_file $input, "\n"; - close $orig_file || die "Can't close orig_file: $!"; - - chomp $output; - my $parsed_file = File::Temp->new(); - print $parsed_file $output, "\n"; - close $parsed_file || die "Can't close parsed_file"; - - my $diff = File::Temp->new(); - system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); - - open my $fh, "<", $diff || die "Can't open $diff"; - my @diffs = <$fh>; - diag(@diffs); -} -else { - eval { require Text::Diff; }; - if ($@) { - is($output, $input, $msg); - diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" - . " Text::Diff to see just the differences."); - } - else { - fail($msg); - diag Text::Diff::diff(\$input, \$output, { STYLE => 'Unified' }); - } -} - - -__DATA__ -package utf8::all; -use strict; -use warnings; -use 5.010; # state -# ABSTRACT: turn on Unicode - all of it -our $VERSION = '0.010'; # VERSION - - -use Import::Into; -use parent qw(Encode charnames utf8 open warnings feature); - -sub import { - my $target = caller; - 'utf8'->import::into($target); - 'open'->import::into($target, qw{:encoding(UTF-8) :std}); - 'charnames'->import::into($target, qw{:full :short}); - 'warnings'->import::into($target, qw{FATAL utf8}); - 'feature'->import::into($target, qw{unicode_strings}) if $^V >= v5.11.0; - 'feature'->import::into($target, qw{unicode_eval fc}) if $^V >= v5.16.0; - - { - no strict qw(refs); ## no critic (TestingAndDebugging::ProhibitNoStrict) - *{$target . '::readdir'} = \&_utf8_readdir; - } - - # utf8 in @ARGV - state $have_encoded_argv = 0; - _encode_argv() unless $have_encoded_argv++; - - $^H{'utf8::all'} = 1; - - return; -} - -sub _encode_argv { - $_ = Encode::decode('UTF-8', $_) for @ARGV; - return; -} - -sub _utf8_readdir(*) { ## no critic (Subroutines::ProhibitSubroutinePrototypes) - my $handle = shift; - if (wantarray) { - my @all_files = CORE::readdir($handle); - $_ = Encode::decode('UTF-8', $_) for @all_files; - return @all_files; - } - else { - my $next_file = CORE::readdir($handle); - $next_file = Encode::decode('UTF-8', $next_file); - return $next_file; - } -} - - -1; - -__END__ - -=pod - -=encoding utf-8 - -=head1 NAME - -utf8::all - turn on Unicode - all of it - -=head1 VERSION - -version 0.010 - -=head1 SYNOPSIS - - use utf8::all; # Turn on UTF-8. All of it. - - open my $in, '<', 'contains-utf8'; # UTF-8 already turned on here - print length 'føø bār'; # 7 UTF-8 characters - my $utf8_arg = shift @ARGV; # @ARGV is UTF-8 too! - -=head1 DESCRIPTION - -L<utf8> allows you to write your Perl encoded in UTF-8. That means UTF-8 -strings, variable names, and regular expressions. C<utf8::all> goes further, and -makes C<@ARGV> encoded in UTF-8, and filehandles are opened with UTF-8 encoding -turned on by default (including STDIN, STDOUT, STDERR), and charnames are -imported so C<\N{...}> sequences can be used to compile Unicode characters based -on names. If you I<don't> want UTF-8 for a particular filehandle, you'll have to -set C<binmode $filehandle>. - -The pragma is lexically-scoped, so you can do the following if you had some -reason to: - - { - use utf8::all; - open my $out, '>', 'outfile'; - my $utf8_str = 'føø bār'; - print length $utf8_str, "\n"; # 7 - print $out $utf8_str; # out as utf8 - } - open my $in, '<', 'outfile'; # in as raw - my $text = do { local $/; <$in>}; - print length $text, "\n"; # 10, not 7! - -=head1 INTERACTION WITH AUTODIE - -If you use L<autodie>, which is a great idea, you need to use at least version -B<2.12>, released on L<June 26, 2012|https://metacpan.org/source/PJF/autodie-2.12/Changes#L3>. -Otherwise, autodie obliterates the IO layers set by the L<open> pragma. See -L<RT #54777|https://rt.cpan.org/Ticket/Display.html?id=54777> and -L<GH #7|https://github.com/doherty/utf8-all/issues/7>. - -=head1 AVAILABILITY - -The project homepage is L<http://metacpan.org/release/utf8-all/>. - -The latest version of this module is available from the Comprehensive Perl -Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN -site near you, or see L<https://metacpan.org/module/utf8::all/>. - -=head1 SOURCE - -The development version is on github at L<http://github.com/doherty/utf8-all> -and may be cloned from L<git://github.com/doherty/utf8-all.git> - -=head1 BUGS AND LIMITATIONS - -You can make new bug reports, and view existing ones, through the -web interface at L<https://github.com/doherty/utf8-all/issues>. - -=head1 AUTHORS - -=over 4 - -=item * - -Michael Schwern <mschwern@cpan.org> - -=item * - -Mike Doherty <doherty@cpan.org> - -=back - -=head1 COPYRIGHT AND LICENSE - -This software is copyright (c) 2009 by Michael Schwern <mschwern@cpan.org>. - -This is free software; you can redistribute it and/or modify it under -the same terms as the Perl 5 programming language system itself. - -=cut diff --git a/cpan/Pod-Simple/t/JustPod02.t b/cpan/Pod-Simple/t/JustPod02.t deleted file mode 100644 index 8205aecaa0..0000000000 --- a/cpan/Pod-Simple/t/JustPod02.t +++ /dev/null @@ -1,445 +0,0 @@ -use strict; -use warnings; - -use Test::More; - -BEGIN { plan tests => 1 } - -use Pod::Simple::JustPod; - -my @orig = <DATA>; -my $parsed; - -my $parser = Pod::Simple::JustPod->new(); -$parser->output_string(\$parsed); -$parser->parse_lines(@orig, undef); - -my $orig = join "", @orig; - -my $msg = "Verify parsed pod sufficiently matches original"; -if ($parsed eq $orig) { - pass($msg); -} -elsif ($ENV{PERL_TEST_DIFF}) { - fail($msg); - require File::Temp; - my $orig_file = File::Temp->new(); - local $/ = "\n"; - chomp $orig; - print $orig_file $orig, "\n"; - close $orig_file || die "Can't close orig_file: $!"; - - chomp $parsed; - my $parsed_file = File::Temp->new(); - print $parsed_file $parsed, "\n"; - close $parsed_file || die "Can't close parsed_file"; - - my $diff = File::Temp->new(); - system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); - - open my $fh, "<", $diff || die "Can't open $diff"; - my @diffs = <$fh>; - diag(@diffs); -} -else { - eval { require Text::Diff; }; - if ($@) { - is($parsed, $orig, $msg); - diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" - . " Text::Diff to see just the differences."); - } - else { - fail($msg); - diag Text::Diff::diff(\$orig, \$parsed, { STYLE => 'Unified' }); - } -} - -# The data is adapted from a test file from pod2lators. Extra spaces are -# added in places to make sure they get retained, and some extra tests -__DATA__ -=pod - -=encoding ASCII - -=head1 NAME - -basic.pod - Test of various basic POD features in translators. - -=head1 HEADINGS - -Try a few different levels of headings, with embedded formatting codes and -other interesting bits. - -=head1 This C<is> a "level 1" heading - -=head2 ``Level'' "2 I<heading> - -=head3 Level 3 B<heading I<with C<weird F<stuff "" (double quote)>>>> - -=head4 Level "4 C<heading> - -Now try again with B<intermixed> F<text>. - -=head1 This C<is> a "level 1" heading - -Text. - -=head2 ``Level'' 2 I<heading> - -Text. - -=head3 Level 3 B<heading I<with C<weird F<stuff>>>> - -Text. - -=head4 Level "4 C<heading> - -Text. - -=head1 LINKS - -These are all taken from the Pod::Parser tests. - -Try out I<LOTS> of different ways of specifying references: - -Reference the L<manpage/section> - -Reference the L<"manpage"/section> - -Reference the L<manpage/"section"> - -Now try it using the new "|" stuff ... - -Reference the L<thistext|manpage/section>| - -Reference the L<thistext | manpage / section>| - -Reference the L<thistext| manpage/ section>| - -Reference the L<thistext |manpage /section>| - -Reference the L<thistext|manpage/"section">| - -Reference the L<thistext| -manpage/ -section>| - -And then throw in a few new ones of my own. - -L<foo> - -L<foo|bar> - -L<foo/bar> - -L<foo/"baz boo"> - -L</bar> - -L</"baz boo"> - -L</baz boo> - -L<foo bar/baz boo> - -L<"boo var baz"> - -L<bar baz> - -L</boo>, L</bar>, and L</baz> - -L<fooZ<>bar> - -L<Testing I<italics>|foo/bar> - -L<foo/I<Italic> text> - -L<fooE<verbar>barZ<>/Section C<with> I<B<other> markup>> - -=head1 OVER AND ITEMS - -Taken from Pod::Parser tests, this is a test to ensure that multiline -=item paragraphs get indented appropriately. - -=over 4 - -=item This -is -a -test. - -=back - -There should be whitespace now before this line. - -Taken from Pod::Parser tests, this is a test to ensure the nested =item -paragraphs get indented appropriately. - -=over 2 - -=item 1 - -First section. - -=over 2 - -=item a - -this is item a - -=item b - -this is item b - -=back - -=item 2 - -Second section. - -=over 2 - -=item a - -this is item a - -=item b - -this is item b - -=item c - -=item d - -This is item c & d. - -=back - -=back - -Now some additional weirdness of our own. Make sure that multiple tags -for one paragraph are properly compacted. - -=over 4 - -=item "foo" - -=item B<bar> - -=item C<baz> - -There shouldn't be any spaces between any of these item tags; this idiom -is used in perlfunc. - -=item Some longer item text - -Just to make sure that we test paragraphs where the item text doesn't fit -in the margin of the paragraph (and make sure that this paragraph fills a -few lines). - -Let's also make it multiple paragraphs to be sure that works. - -=back - -Test use of =over without =item as a block "quote" or block paragraph. - -=over 4 - -This should be indented four spaces but otherwise formatted the same as -any other regular text paragraph. Make sure it's long enough to see the -results of the formatting..... - -=back - -Now try the same thing nested, and make sure that the indentation is reset -back properly. - -=over 4 - -=over 4 - -This paragraph should be doubly indented. - -=back - -This paragraph should only be singly indented. - -=over 4 - -=item - -This is an item in the middle of a block-quote, which should be allowed. - -=item - -We're also testing tagless item commands. - -=back - -Should be back to the single level of indentation. - -=back - -Should be back to regular indentation. - -Now also check the transformation of * into real bullets for man pages. - -=over - -=item * - -An item. We're also testing using =over without a number, and making sure -that item text wraps properly. - -=item * - -Another item. - -=back - -and now test the numbering of item blocks. - -=over 4 - -=item 1. - -First item. - -=item 2. - -Second item. - -=back - -=head1 FORMATTING CODES - -Another test taken from Pod::Parser. - -This is a test to see if I can do not only C<$self> and C<method()>, but -also C<< $self->method() >> and C<< $self->{FIELDNAME} >> and -C<< $Foo <=> $Bar >> without resorting to escape sequences. If -I want to refer to the right-shift operator I can do something -like C<<< $x >> 3 >>> or even C<<<< $y >> 5 >>>>. - -Now for the grand finale of C<< $self->method()->{FIELDNAME} = {FOO=>BAR} >>. -And I also want to make sure that newlines work like this -C<<< -$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b] ->>> - -Of course I should still be able to do all this I<with> escape sequences -too: C<$self-E<gt>method()> and C<$self-E<gt>{FIELDNAME}> and -C<{FOO=E<gt>BAR}>. - -Dont forget C<$self-E<gt>method()-E<gt>{FIELDNAME} = {FOO=E<gt>BAR}>. - -And make sure that C<0> works too! - -Now, if I use << or >> as my delimiters, then I have to use whitespace. -So things like C<<$self->method()>> and C<<$self->{FIELDNAME}>> wont end -up doing what you might expect since the first > will still terminate -the first < seen. - -Lets make sure these work for empty ones too, like C<<< >>>, -C<<<< ->>>>, and C<< >> >> (just to be obnoxious) - -The statement: C<This is dog kind's I<finest> hour!> is a parody of a -quotation from Winston Churchill. - -The following tests are added to those: - -Make sure that a few othZ<>er odd I<Z<>things> still work. This should be -a vertical bar: E<verbar>. Here's a test of a few more special escapes -that have to be supported: - -=over 3 - -=item E<amp> - -An ampersand. - -=item E<apos> - -An apostrophe. - -=item E<lt> - -A less-than sign. - -=item E<gt> - -A greater-than sign. - -=item E<quot> - -A double quotation mark. - -=item E<sol> - -A forward slash. - -=back - -Try to get this bit of text over towards the edge so S<|that all of this -text inside SE<lt>E<gt> won't|> be wrapped. Also test the -|sameE<nbsp>thingE<nbsp>withE<nbsp>non-breakingS< spaces>.| - -There is a soft hyE<shy>phen in hyphen at hy-phen. - -This is a test of an X<index entry>index entry. - -=head1 VERBATIM - -Throw in a few verbatim paragraphs. - - use Term::ANSIColor; - print color 'bold blue'; - print "This text is bold blue.\n"; - print color 'reset'; - print "This text is normal.\n"; - print colored ("Yellow on magenta.\n", 'yellow on_magenta'); - print "This text is normal.\n"; - print colored ['yellow on_magenta'], "Yellow on magenta.\n"; - - use Term::ANSIColor qw(uncolor); - print uncolor '01;31', "\n"; - -But this isn't verbatim (make sure it wraps properly), and the next -paragraph is again: - - use Term::ANSIColor qw(:constants); - print BOLD, BLUE, "This text is in bold blue.\n", RESET; - - use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; - -(Ugh, that's obnoxiously long.) Try different spacing: - - Starting with a tab. -Not -starting -with -a -tab. But this should still be verbatim. - As should this. - -This isn't. - - This is. And this: is an internal tab. It should be: - |--| <= lined up with that. - -(Tricky, but tabs should be expanded before the translator starts in on -the text since otherwise text with mixed tabs and spaces will get messed -up.) - - And now we test verbatim paragraphs right before a heading. Older - versions of Pod::Man generated two spaces between paragraphs like this - and the heading. (In order to properly test this, one may have to - visually inspect the nroff output when run on the generated *roff - text, unfortunately.) - -=head1 CONCLUSION - -That's all, folks! - -=cut diff --git a/cpan/Pod-Simple/t/JustPod_corpus.t b/cpan/Pod-Simple/t/JustPod_corpus.t deleted file mode 100644 index 31acaaf7b8..0000000000 --- a/cpan/Pod-Simple/t/JustPod_corpus.t +++ /dev/null @@ -1,155 +0,0 @@ -# Testing Pod::Simple::JustPod against *.pod in /t -use strict; - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } - - use Config; - if ($Config::Config{'extensions'} !~ /\bEncode\b/) { - print "1..0 # Skip: Encode was not built\n"; - exit 0; - } -} - -use File::Find; -use File::Spec; -use Test::More; - -use Pod::Simple::JustPod; - -my @test_files; - -BEGIN { - sub source_path { - my $file = shift; - if ($ENV{PERL_CORE}) { - require File::Spec; - my $updir = File::Spec->updir; - my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); - return File::Spec->catdir($dir, $file); - } - else { - return $file; - } - } - - my @test_dirs = ( - File::Spec->catdir( source_path('t') ) , - File::Spec->catdir( File::Spec->updir, 't') , - ); - - my $test_dir; - foreach( @test_dirs ) { - $test_dir = $_ and last if -e; - } - - die "Can't find the test dir" unless $test_dir; - print "# TESTDIR: $test_dir\n"; - - sub wanted { - push @test_files, $File::Find::name - if $File::Find::name =~ /\.pod$/; - } - find(\&wanted , $test_dir ); - - plan tests => scalar @test_files; -} - -foreach my $file (@test_files) { - my $parser = Pod::Simple::JustPod->new(); - $parser->complain_stderr(0); - - my $input; - open( IN , '<' , $file ) or die "$file: $!"; - $input .= $_ while (<IN>); - close( IN ); - - my $output; - $parser->output_string( \$output ); - $parser->parse_string_document( $input ); - - if ($parser->any_errata_seen()) { - pass("Skip '$file' because of pod errors"); - my $errata = $parser->errata_seen(); - foreach my $line_number (sort { $a <=> $b } keys %$errata) { - foreach my $err_msg (sort @{$errata->{$line_number}}) { - diag "$file: $line_number: $err_msg"; - } - } - next; - } - - my $encoding = $parser->encoding(); - if (defined $encoding) { - eval { require Encode; }; - $input = Encode::decode($parser->encoding(), $input); - } - - my @input = split "\n", $input; - my $stripped_input = ""; - while (defined ($_ = shift @input)) { - if (/ ^ = [a-z]+ /x) { - my $line = "$_\n"; - - if ($stripped_input eq "" || $_ !~ /^=pod/) { - $stripped_input .= $line; - } - while (defined ($_ = shift @input)) { - $stripped_input .= "$_\n"; - last if / ^ =cut /x; - } - } - } - $stripped_input =~ s/ ^ =cut \n (.) /$1/mgx; - - $input = $stripped_input if $stripped_input ne ""; - if ($input !~ / ^ =pod /x) { - $input =~ s/ ^ \s+ //x; - $input = "=pod\n\n$input"; - } - if ($input !~ / =cut $ /x) { - $input =~ s/ \s+ $ //x; - $input .= "\n\n=cut\n"; - } - - my $msg = "got expected output for $file"; - if ($output eq $input) { - pass($msg); - } - elsif ($ENV{PERL_TEST_DIFF}) { - fail($msg); - require File::Temp; - my $orig_file = File::Temp->new(); - local $/ = "\n"; - chomp $input; - print $orig_file $input, "\n"; - close $orig_file || die "Can't close orig_file: $!"; - - chomp $output; - my $parsed_file = File::Temp->new(); - print $parsed_file $output, "\n"; - close $parsed_file || die "Can't close parsed_file"; - - my $diff = File::Temp->new(); - system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); - - open my $fh, "<", $diff || die "Can't open $diff"; - my @diffs = <$fh>; - diag(@diffs); - } - else { - eval { require Text::Diff; }; - if ($@) { - is($output, $input, $msg); - diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" - . " Text::Diff to see just the differences."); - } - else { - fail($msg); - diag Text::Diff::diff(\$input, \$output, { STYLE => 'Unified' }); - } - } -} diff --git a/cpan/Pod-Simple/t/corpus/polish_utf8.txt b/cpan/Pod-Simple/t/corpus/polish_utf8.txt index 95b1224842..32c763ee7a 100644 --- a/cpan/Pod-Simple/t/corpus/polish_utf8.txt +++ b/cpan/Pod-Simple/t/corpus/polish_utf8.txt @@ -8,16 +8,7 @@ WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to -the Polish Christmas carol "Wśród nocnej ciszy", except it includes -a few lines to test RTF specially. - -ff is a character in the upper half of Plane 0, so should be negative in RTF -𝔸 is a character in Plane 1, so should be expressed as a surrogate pair in RTF - -All the ASCII printables - !"#$%&\'()*+,-./0123456789:;<=>?@ -ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` -abcdefghijklmnopqrstuvwxyz{|}~ +the Polish Christmas carol "Wśród nocnej ciszy". Wśród nocnej ciszy głos się rozchodzi: / Wstańcie, pasterze, Bóg się nam rodzi! / @@ -47,14 +38,6 @@ Chleba i wina. And now as verbatim text: - ff upper half, Plane 0 - 𝔸 Plane 1 - - All the ASCII printables - !"#$%&\'()*+,-./0123456789:;<=>?@ - ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` - abcdefghijklmnopqrstuvwxyz{|}~ - Wśród nocnej ciszy głos się rozchodzi: Wstańcie, pasterze, Bóg się nam rodzi! Czym prędzej się wybierajcie, diff --git a/cpan/Pod-Simple/t/corpus/polish_utf8.xml b/cpan/Pod-Simple/t/corpus/polish_utf8.xml index 2eccfe76d4..2778571c95 100644 --- a/cpan/Pod-Simple/t/corpus/polish_utf8.xml +++ b/cpan/Pod-Simple/t/corpus/polish_utf8.xml @@ -13,54 +13,35 @@ </head1> <Para start_line="10"> This is a test Pod document in UTF8. Its content is the lyrics to the - Polish Christmas carol "Wśród nocnej ciszy", except - it includes a few lines to test RTF specially. + Polish Christmas carol "Wśród nocnej ciszy". </Para> - <Para start_line="14"> - ff is a character in the upper half of Plane 0, so should be negative - in RTF 𝔸 is a character in Plane 1, so should be expressed as a - surrogate pair in RTF - </Para> - <Para start_line="17"> - All the ASCII printables - !"#$%&\'()*+,-./0123456789:;<=>?@ - ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ - </Para> - <Para start_line="22"> + <Para start_line="13"> Wśród nocnej ciszy głos się rozchodzi: / Wstańcie, pasterze, Bóg się nam rodzi! / Czym prędzej się wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. </Para> - <Para start_line="28"> + <Para start_line="19"> Poszli, znaleźli Dzieciątko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witając zawołali / Z wielkiej radości: </Para> - <Para start_line="34"> + <Para start_line="25"> Ach, witaj Zbawco z dawno żądany, / Wiele tysięcy lat wyglądany / Na Ciebie króle, prorocy / Czekali, a Tyś tej nocy / Nam się objawił. </Para> - <Para start_line="40"> + <Para start_line="31"> I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na głos kapłana, / Padniemy na twarz przed Tobą, / Wierząc, żeś jest pod osłoną / Chleba i wina. </Para> - <head2 start_line="46"> + <head2 start_line="37"> As Verbatim </head2> - <Para start_line="48"> + <Para start_line="39"> And now as verbatim text: </Para> - <VerbatimFormatted start_line="50" xml:space="preserve"> - ff upper half, Plane 0 - 𝔸 Plane 1 - - All the ASCII printables - !"#$%&\'()*+,-./0123456789:;<=>?@ - ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` - abcdefghijklmnopqrstuvwxyz{|}~ - + <VerbatimFormatted start_line="41" xml:space="preserve"> Wśród nocnej ciszy głos się rozchodzi: Wstańcie, pasterze, Bóg się nam rodzi! Czym prędzej się wybierajcie, @@ -85,7 +66,7 @@ Wierząc, żeś jest pod osłoną Chleba i wina. </VerbatimFormatted> - <Para start_line="82"> + <Para start_line="65"> [end] </Para> </Document> diff --git a/cpan/Pod-Simple/t/encod04.t b/cpan/Pod-Simple/t/encod04.t index 8f41f98a6c..88727cca52 100644 --- a/cpan/Pod-Simple/t/encod04.t +++ b/cpan/Pod-Simple/t/encod04.t @@ -12,14 +12,14 @@ BEGIN { use strict; use Test; BEGIN { - plan tests => 6, todo => []; -} - -# fail with the supplied diagnostic - -sub my_nok { - my ($diag) = @_; - ok (1, 0, $diag); + if ($] lt 5.007_003) { + plan tests => 5, todo => [4, 5]; # Need utf8::decode() to pass #5 + # and isn't available in this + # release + } + else { + plan tests => 5, todo => [4]; + } } ok 1; @@ -61,13 +61,16 @@ if( $guess ) { if( grep m{Dash $dash}, @output_lines ) { ok 1; } else { - my_nok "failed to find expected control character in output"; + ok 0; + print STDERR "# failed to find expected control character in output\n" } } else { - my_nok "parser guessed wrong encoding expected 'CP1252' got '$guess'"; + ok 0; + print STDERR "# parser guessed wrong encoding expected 'CP1252' got '$guess'\n"; } } else { - my_nok "parser failed to detect non-ASCII bytes in input"; + ok 0; + print STDERR "# parser failed to detect non-ASCII bytes in input\n"; } @@ -92,18 +95,18 @@ else { if( $guess eq 'CP1252' ) { ok 1; } else { - my_nok "parser guessed wrong encoding expected 'CP1252' got '$guess'"; + ok 0; + print STDERR "# parser guessed wrong encoding expected 'CP1252' got '$guess'\n"; } } else { - my_nok "parser failed to detect non-ASCII bytes in input"; + ok 0; + print STDERR "# parser failed to detect non-ASCII bytes in input\n"; } } -# Initial accented character (E acute) followed by 'smart' apostrophe is legal -# CP1252, which should be preferred over UTF-8 because the latter -# interpretation would be "JOS" . \N{LATIN SMALL LETTER TURNED ALPHA} . "S -# PLACE", and that \N{} letter is an IPA one. +# Initial accented character followed by 'smart' apostrophe causes heuristic +# to choose UTF8 (a somewhat contrived example) @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ @@ -124,10 +127,12 @@ else { if( $guess eq 'CP1252' ) { ok 1; } else { - my_nok "parser guessed wrong encoding expected 'CP1252' got '$guess'"; + ok 0; + print STDERR "# parser guessed wrong encoding expected 'CP1252' got '$guess'\n"; } } else { - my_nok "parser failed to detect non-ASCII bytes in input"; + ok 0; + print STDERR "# parser failed to detect non-ASCII bytes in input\n"; } } @@ -155,40 +160,12 @@ else { if( $guess eq 'CP1252' ) { ok 1; } else { - my_nok "parser guessed wrong encoding expected 'CP1252' got '$guess'"; - } - } else { - my_nok "parser failed to detect non-ASCII bytes in input"; - } -} - -# The following is a real word example of something in CP1252 expressible in -# UTF-8, but doesn't make sense in UTF-8, contributed by Bo Lindbergh. -# Muvrarášša is a Sami word - -@output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ - -=head1 NAME - -Muvrar\xE1\x9A\x9Aa is a mountain in Norway - -=cut - -} ); - -if (ord("A") != 65) { # ASCII-platform dependent test skipped on this platform - ok (1); -} -else { - ($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; - if( $guess ) { - if( $guess eq 'CP1252' ) { - ok 1; - } else { - my_nok "parser guessed wrong encoding expected 'CP1252' got '$guess'"; + ok 0; + print STDERR "# parser guessed wrong encoding expected 'CP1252' got '$guess'\n"; } } else { - my_nok "parser failed to detect non-ASCII bytes in input"; + ok 0; + print STDERR "# parser failed to detect non-ASCII bytes in input\n"; } } diff --git a/cpan/Pod-Simple/t/fcodes_s.t b/cpan/Pod-Simple/t/fcodes_s.t index fd48ec07bf..977756593d 100644 --- a/cpan/Pod-Simple/t/fcodes_s.t +++ b/cpan/Pod-Simple/t/fcodes_s.t @@ -43,17 +43,17 @@ skip( $unless_ascii, skip( $unless_ascii, $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S<L</"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L content-implicit="yes" raw="/"bric-a-brac a gogo"" section="bric-a-brac a gogo" type="pod">"bric-a-brac a gogo"</L>.</Para></Document>' +'<Document><Para>I like <L content-implicit="yes" section="bric-a-brac a gogo" type="pod">"bric-a-brac a gogo"</L>.</Para></Document>' ); skip( $unless_ascii, $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S<L<Stuff like that|/"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L raw="Stuff like that|/"bric-a-brac a gogo"" section="bric-a-brac a gogo" type="pod">Stuff like that</L>.</Para></Document>' +'<Document><Para>I like <L section="bric-a-brac a gogo" type="pod">Stuff like that</L>.</Para></Document>' ); skip( $unless_ascii, $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S<L<Stuff I<like that>|/"bric-a-brac a gogo">>.\n}), -'<Document><Para>I like <L raw="Stuff I<like that>|/"bric-a-brac a gogo"" section="bric-a-brac a gogo" type="pod">Stuff <I>like that</I></L>.</Para></Document>' +'<Document><Para>I like <L section="bric-a-brac a gogo" type="pod">Stuff <I>like that</I></L>.</Para></Document>' ); &ok( $x->_duo( sub { $_[0]->nbsp_for_S(1) }, @@ -219,7 +219,7 @@ ok( # Test HTML output of links. use Pod::Simple::HTML; -my $PERLDOC = "https://metacpan.org/pod"; +my $PERLDOC = "http://search.cpan.org/perldoc"; my $MANURL = "http://man.he.net/man"; sub x ($) { Pod::Simple::HTML->_out( @@ -230,12 +230,12 @@ sub x ($) { ok( x(qq{L<Net::Ping>\n}), - qq{\n<p><a href="$PERLDOC/Net%3A%3APing" class="podlinkpod"\n>Net::Ping</a></p>\n} + qq{\n<p><a href="$PERLDOC?Net%3A%3APing" class="podlinkpod"\n>Net::Ping</a></p>\n} ); ok( x(qq{Be sure to read the L<Net::Ping> docs\n}), - qq{\n<p>Be sure to read the <a href="$PERLDOC/Net%3A%3APing" class="podlinkpod"\n>Net::Ping</a> docs</p>\n} + qq{\n<p>Be sure to read the <a href="$PERLDOC?Net%3A%3APing" class="podlinkpod"\n>Net::Ping</a> docs</p>\n} ); ok( @@ -250,7 +250,7 @@ ok( ok( x(qq{L<Net::Ping/Ping-pong>\n}), - qq{\n<p><a href="$PERLDOC/Net%3A%3APing#Ping-pong" class="podlinkpod"\n>"Ping-pong" in Net::Ping</a></p>\n} + qq{\n<p><a href="$PERLDOC?Net%3A%3APing#Ping-pong" class="podlinkpod"\n>"Ping-pong" in Net::Ping</a></p>\n} ); ok( @@ -270,7 +270,7 @@ ok( ok( x(qq{L<Net::Ping/Ping-E<112>ong>\n}), - qq{\n<p><a href="$PERLDOC/Net%3A%3APing#Ping-pong" class="podlinkpod"\n>"Ping-pong" in Net::Ping</a></p>\n} + qq{\n<p><a href="$PERLDOC?Net%3A%3APing#Ping-pong" class="podlinkpod"\n>"Ping-pong" in Net::Ping</a></p>\n} ); ok( @@ -315,17 +315,17 @@ ok( ok( x(qq{L<Perl Error Messages|perldiag>\n}), - qq{\n<p><a href="$PERLDOC/perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} + qq{\n<p><a href="$PERLDOC?perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} ); ok( x(qq{L<Perl\nError\nMessages|perldiag>\n}), - qq{\n<p><a href="$PERLDOC/perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} + qq{\n<p><a href="$PERLDOC?perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} ); ok( x(qq{L<Perl\nError\t Messages|perldiag>\n}), - qq{\n<p><a href="$PERLDOC/perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} + qq{\n<p><a href="$PERLDOC?perldiag" class="podlinkpod"\n>Perl Error Messages</a></p>\n} ); ok( @@ -352,12 +352,12 @@ sub o ($) { ok( o(qq{L<Net::Ping>}), - qq{<p><a href="$PERLDOC/Net::Ping">Net::Ping</a></p>\n\n} + qq{<p><a href="$PERLDOC?Net::Ping">Net::Ping</a></p>\n\n} ); ok( o(qq{Be sure to read the L<Net::Ping> docs}), - qq{<p>Be sure to read the <a href="$PERLDOC/Net::Ping">Net::Ping</a> docs</p>\n\n} + qq{<p>Be sure to read the <a href="$PERLDOC?Net::Ping">Net::Ping</a> docs</p>\n\n} ); ok( @@ -372,7 +372,7 @@ ok( ok( o(qq{L<Net::Ping/Ping-pong>}), - qq{<p><a href="$PERLDOC/Net::Ping#Ping-pong">"Ping-pong" in Net::Ping</a></p>\n\n} + qq{<p><a href="$PERLDOC?Net::Ping#Ping-pong">"Ping-pong" in Net::Ping</a></p>\n\n} ); ok( @@ -392,7 +392,7 @@ ok( ok( o(qq{L<Net::Ping/Ping-E<112>ong>}), - qq{<p><a href="$PERLDOC/Net::Ping#Ping-pong">"Ping-pong" in Net::Ping</a></p>\n\n} + qq{<p><a href="$PERLDOC?Net::Ping#Ping-pong">"Ping-pong" in Net::Ping</a></p>\n\n} ); ok( @@ -437,17 +437,17 @@ ok( ok( o(qq{L<Perl Error Messages|perldiag>}), - qq{<p><a href="$PERLDOC/perldiag">Perl Error Messages</a></p>\n\n} + qq{<p><a href="$PERLDOC?perldiag">Perl Error Messages</a></p>\n\n} ); ok( o(qq{L<Perl\nError\nMessages|perldiag>}), - qq{<p><a href="$PERLDOC/perldiag">Perl Error Messages</a></p>\n\n} + qq{<p><a href="$PERLDOC?perldiag">Perl Error Messages</a></p>\n\n} ); ok( o(qq{L<Perl\nError\t Messages|perldiag>}), - qq{<p><a href="$PERLDOC/perldiag">Perl Error Messages</a></p>\n\n} + qq{<p><a href="$PERLDOC?perldiag">Perl Error Messages</a></p>\n\n} ); ok( diff --git a/cpan/Pod-Simple/t/github_issue_79.t b/cpan/Pod-Simple/t/github_issue_79.t deleted file mode 100644 index a56b428c2a..0000000000 --- a/cpan/Pod-Simple/t/github_issue_79.t +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More; - -BEGIN { - eval { require Test::Deep; }; - plan skip_all => 'Fails with Can\'t locate object method "print" via package "IO::File" at t/github_issue_79.t line 33' if $] le 5.012005; - plan skip_all => 'Need Test::Deep to test' if $@; - Test::Deep->import('cmp_deeply'); -} - -{ -package DumpAsXML::Enh; - -use parent 'Pod::Simple::DumpAsXML'; - -sub new { - my ( $class ) = @_; - my $self = $class->SUPER::new(); - $self->code_handler( sub { pop( @_ )->_handle_line( 'code', @_ ); } ); - $self->cut_handler( sub { pop( @_ )->_handle_line( 'cut', @_ ); } ); - $self->pod_handler( sub { pop( @_ )->_handle_line( 'pod', @_ ); } ); - $self->whiteline_handler( sub { pop( @_ )->_handle_line( 'white', @_ ); } ); - return $self; -}; - -sub _handle_line { - my ( $self, $elem, $text, $line ) = @_; - my $fh = $self->{ output_fh }; - $fh->print( ' ' x $self->{ indent }, "<$elem start_line=\"$line\"/>\n" ); -}; - -} - -my $output = ''; -my $parser = DumpAsXML::Enh->new(); -$parser->output_string( \$output ); - -my $input = [ - '=head1 DESCRIPTION', - '', - ' Verbatim paragraph.', - '', - '=cut', -]; -my $expected_output = [ - '<Document start_line="1">', - ' <head1 start_line="1">', - ' DESCRIPTION', - ' </head1>', - ' <VerbatimFormatted start_line="3" xml:space="preserve">', - ' Verbatim paragraph.', - ' </VerbatimFormatted>', - ' <cut start_line="5"/>', - '</Document>', -]; - -$parser->parse_lines( @$input, undef ); - -my $actual_output = [ split( "\n", $output ) ]; -cmp_deeply( $actual_output, $expected_output ) or do { - diag( 'actual output:' ); - diag( "|$_" ) for @$actual_output; - diag( 'expected output:' ); - diag( "|$_" ) for @$expected_output; -}; - -done_testing; -exit( 0 ); - diff --git a/cpan/Pod-Simple/t/html01.t b/cpan/Pod-Simple/t/html01.t index 8d8e528320..b4caa39dc6 100644 --- a/cpan/Pod-Simple/t/html01.t +++ b/cpan/Pod-Simple/t/html01.t @@ -9,7 +9,7 @@ BEGIN { use strict; use Test; -BEGIN { plan tests => 14 }; +BEGIN { plan tests => 13 }; #use Pod::Simple::Debug (10); @@ -137,16 +137,6 @@ ok( "\n<dl>\n<dt><a name=\"howdy\"\n>Foo</a></dt>\n</dl>\n", ); -{ # Test that strip_verbatim_indent() works. github issue #i5 - my $output; - - my $obj = Pod::Simple::HTML->new; - $obj->strip_verbatim_indent(" "); - $obj->output_string(\$output); - $obj->parse_string_document("=pod\n\n First line\n 2nd line\n"); - ok($output, qr!<pre>First line\n2nd line</pre>!s); -} - print "# And one for the road...\n"; ok 1; diff --git a/cpan/Pod-Simple/t/perlcyg.pod b/cpan/Pod-Simple/t/perlcyg.pod index 2da4b28aa6..6264a15788 100644 --- a/cpan/Pod-Simple/t/perlcyg.pod +++ b/cpan/Pod-Simple/t/perlcyg.pod @@ -56,7 +56,7 @@ runtime behavior (see L</"TEST">). =over 4 -=item * C<PATH> +=item * C<PATH> Set the C<PATH> environment variable so that Configure finds the Cygwin versions of programs. Any Windows directories should be removed or diff --git a/cpan/Pod-Simple/t/rtf_utf8.t b/cpan/Pod-Simple/t/rtf_utf8.t deleted file mode 100644 index 0d2d8ecf73..0000000000 --- a/cpan/Pod-Simple/t/rtf_utf8.t +++ /dev/null @@ -1,220 +0,0 @@ -#!/usr/bin/perl -w - -# t/rtf_utf8.t - Check that RTF works with UTF-8 input - -BEGIN { - chdir 't' if -d 't'; -} - -my $expected = join "", <DATA>; - -use strict; -use lib '../lib'; -use Test::More; -use File::Spec; - -if ($] < 5.008) { - plan skip_all => "Doesn't work before 5.8"; -} -else { - plan tests => 5; -} - -for my $format (qw(RTF)) { - my $class = "Pod::Simple::RTF"; - use_ok $class or next; - ok my $parser = $class->new, "Construct RTF parser"; - - my $output = ''; - ok $parser->output_string(\$output), "Set RTF output string"; - ok $parser->parse_file(File::Spec->catfile(qw(corpus polish_utf8.txt))), - "Parse to RTF via parse_file()"; - $output =~ s/\\info.*?author \[see doc\]\}/VARIANT TEXT DELETED/s; - $output =~ s/$/\n/; - - my $msg = "got expected output"; - if ($output eq $expected) { - pass($msg); - } - elsif ($ENV{PERL_TEST_DIFF}) { - fail($msg); - require File::Temp; - my $orig_file = File::Temp->new(); - local $/ = "\n"; - chomp $expected; - print $orig_file $expected, "\n"; - close $orig_file || die "Can't close orig_file: $!"; - - chomp $output; - my $parsed_file = File::Temp->new(); - print $parsed_file $output, "\n"; - close $parsed_file || die "Can't close parsed_file"; - - my $diff = File::Temp->new(); - system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); - - open my $fh, "<", $diff || die "Can't open $diff"; - my @diffs = <$fh>; - diag(@diffs); - } - else { - eval { require Text::Diff; }; - if ($@) { - is($output, $expected, $msg); - diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" - . " Text::Diff to see just the differences."); - } - else { - fail($msg); - diag Text::Diff::diff(\$expected, \$output, { STYLE => 'Unified' }); - } - } -} - -__DATA__ -{\rtf1\ansi\deff0 - -{\fonttbl -{\f0\froman Times New Roman;} -{\f1\fmodern Courier New;} -{\f2\fswiss Arial;} -} - -{\stylesheet -{\snext0 Normal;} -{\*\cs10 \additive Default Paragraph Font;} -{\*\cs16 \additive \i \sbasedon10 pod-I;} -{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;} -{\*\cs18 \additive \b \sbasedon10 pod-B;} -{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;} -{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs18\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;} -{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;} -{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;} -{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;} -{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;} - -{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;} -{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;} -{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;} -{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;} - -{\s31\ql \keepn\sb90\sa180\f2\fs32\ul\sbasedon0 \snext0 pod-head1;} -{\s32\ql \keepn\sb90\sa180\f2\fs28\ul\sbasedon0 \snext0 pod-head2;} -{\s33\ql \keepn\sb90\sa180\f2\fs25\ul\sbasedon0 \snext0 pod-head3;} -{\s34\ql \keepn\sb90\sa180\f2\fs22\ul\sbasedon0 \snext0 pod-head4;} -} - -{\colortbl;\red255\green0\blue0;\red0\green0\blue255;} -{VARIANT TEXT DELETED{\company [see doc]}{\operator [see doc]} -} - -\deflang1033\plain\lang1033\widowctrl -{\header\pard\qr\plain\f2\fs17 -W\uc1\u346?R\'d3D NOCNEJ CISZY \_\_ explicitly utf8 test document in Polish, -p.\chpgn\par} -\fs25 - - - -{\pard\li0\s31\keepn\sb90\sa180\f2\fs32\ul{ -NAME -}\par} - -{\pard\li0\sa180 -W\uc1\u346?R\'d3D NOCNEJ CISZY \_\_ explicitly utf8 test document -in Polish -\par} - -{\pard\li0\s31\keepn\sb90\sa180\f2\fs32\ul{ -DESCRIPTION -}\par} - -{\pard\li0\sa180 -This is a test Pod document in UT\'468. Its content is the lyrics -to the Polish Christmas carol "W\uc1\u347?r\'f3d nocnej ciszy", except -it includes a few lines to test RT\'46 specially. -\par} - -{\pard\li0\sa180 -\uc1\u-1280? is a character in the upper half of Plane 0, so should -be negative in RT\'46 \uc1\u-10187\u-8904? is a character in Plane -1, so should be expressed as a surrogate pair in RT\'46 -\par} - -{\pard\li0\sa180 -All the ASCII printables !"#$%&\'5c'()*+,\_./0123456789:;<=>?@ ABCDE\'46GHIJKLMNOPQRSTUVWXYZ[{ -\cs21\lang1024\noproof \'5c]^\'5f`} abcdefghijklmnopqrstuvwxyz\'7b|\'7d~ -\par} - -{\pard\li0\sa180 -W\uc1\u347?r\'f3d nocnej ciszy g\uc1\u322?os si\uc1\u281? rozchodzi: -/ Wsta\uc1\u324?cie, pasterze, B\'f3g si\uc1\u281? nam rodzi! / Czym -pr\uc1\u281?dzej si\uc1\u281? wybierajcie, / Do Betlejem pospieszajcie -/ Przywita\uc1\u263? Pana. -\par} - -{\pard\li0\sa180 -Poszli, znale\uc1\u378?li Dzieci\uc1\u261?tko w \uc1\u380?\uc1\u322?obie -/ Z wszystkimi znaki danymi sobie. / Jako Bogu cze\uc1\u347?\uc1\u263? -Mu dali, / A witaj\uc1\u261?c zawo\uc1\u322?ali / Z wielkiej rado\uc1\u347?ci: -\par} - -{\pard\li0\sa180 -Ach, witaj Zbawco z dawno \uc1\u380?\uc1\u261?dany, / Wiele tysi\uc1\u281?cy -lat wygl\uc1\u261?dany / Na Ciebie kr\'f3le, prorocy / Czekali, a -Ty\uc1\u347? tej nocy / Nam si\uc1\u281? objawi\uc1\u322?. -\par} - -{\pard\li0\sa180 -I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na g\uc1\u322?os -kap\uc1\u322?ana, / Padniemy na twarz przed Tob\uc1\u261?, / Wierz\uc1\u261?c, -\uc1\u380?e\uc1\u347? jest pod os\uc1\u322?on\uc1\u261? / Chleba i -wina. -\par} - -{\pard\li0\s32\keepn\sb90\sa180\f2\fs28\ul{ -As Verbatim -}\par} - -{\pard\li0\sa180 -And now as verbatim text: -\par} - -{\pard\li0\plain\s20\sa180\f1\fs18\lang1024\noproof - \uc1\u-1280? upper half, Plane 0\line - \uc1\u-10187\u-8904? Plane 1\line -\line - All the ASCII printables\line - !"#$%&\'5c'()*+,-./0123456789:;<=>?@\line - ABCDE\'46GHIJKLMNOPQRSTUVWXYZ[\'5c]^\'5f`\line - abcdefghijklmnopqrstuvwxyz\'7b|\'7d~\line -\line - W\uc1\u347?r\'f3d nocnej ciszy g\uc1\u322?os si\uc1\u281? rozchodzi:\line - Wsta\uc1\u324?cie, pasterze, B\'f3g si\uc1\u281? nam rodzi!\line - Czym pr\uc1\u281?dzej si\uc1\u281? wybierajcie,\line - Do Betlejem pospieszajcie\line - Przywita\uc1\u263? Pana.\line -\line - Poszli, znale\uc1\u378?li Dzieci\uc1\u261?tko w \uc1\u380?\uc1\u322?obie\line - Z wszystkimi znaki danymi sobie.\line - Jako Bogu cze\uc1\u347?\uc1\u263? Mu dali,\line - A witaj\uc1\u261?c zawo\uc1\u322?ali\line - Z wielkiej rado\uc1\u347?ci:\line -\line - Ach, witaj Zbawco z dawno \uc1\u380?\uc1\u261?dany,\line - Wiele tysi\uc1\u281?cy lat wygl\uc1\u261?dany\line - Na Ciebie kr\'f3le, prorocy\line - Czekali, a Ty\uc1\u347? tej nocy\line - Nam si\uc1\u281? objawi\uc1\u322?.\line -\line - I my czekamy na Ciebie, Pana,\line - A skoro przyjdziesz na g\uc1\u322?os kap\uc1\u322?ana,\line - Padniemy na twarz przed Tob\uc1\u261?,\line - Wierz\uc1\u261?c, \uc1\u380?e\uc1\u347? jest pod os\uc1\u322?on\uc1\u261?\line - Chleba i wina. -\par} - -{\pard\li0\sa180 -[end] -\par} -} diff --git a/cpan/Pod-Simple/t/search50.t b/cpan/Pod-Simple/t/search50.t index 0dc9d75a29..126f24a7b1 100644 --- a/cpan/Pod-Simple/t/search50.t +++ b/cpan/Pod-Simple/t/search50.t @@ -23,7 +23,6 @@ ok $x->inc; # make sure inc=1 is the default use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; -*pretty = \&Pod::Simple::BlackBox::pretty; # avoid 'once' warning my $found = 0; $x->callback(sub { diff --git a/cpan/Pod-Simple/t/whine.t b/cpan/Pod-Simple/t/whine.t index 4ac76e5bd3..b33f0a91ef 100644 --- a/cpan/Pod-Simple/t/whine.t +++ b/cpan/Pod-Simple/t/whine.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More tests => 4; { package Pod::Simple::ErrorFinder; @@ -51,23 +51,3 @@ sub errors { Pod::Simple::ErrorFinder->errors_for_input(@_) } "warning for / in text part of L<>", ); } - -{ - my $input = "=pod\n\nnested LE<lt>E<sol>E<gt>: L<Nested L<http://foobar>|http://baz>\n"; - my $errors = errors("$input"); - is_deeply( - $errors, - { 3 => [ "Nested L<> are illegal. Pretending inner one is X<...> so can continue looking for other errors." ] }, - "warning for nested L<>", - ); -} - -{ - my $input = "=pod\n\nLE<lt>E<sol>E<gt> containing only slash: L< / >\n"; - my $errors = errors("$input"); - is_deeply( - $errors, - { 3 => [ "L<> contains only '/'" ] }, - "warning for L< / > containing only a slash", - ); -} diff --git a/cpan/Pod-Simple/t/x_nixer.t b/cpan/Pod-Simple/t/x_nixer.t index 3787006266..34018109c5 100644 --- a/cpan/Pod-Simple/t/x_nixer.t +++ b/cpan/Pod-Simple/t/x_nixer.t @@ -184,7 +184,7 @@ ok( Pod::Simple::DumpAsXML->_out( \&nixy_mergy, "=pod\n\nZ<>F<C<Z<>fE<111>L<E<78 ' <F>', ' <C>', ' fo', - ' <L content-implicit="yes" raw="E<78>et::Ping/Ping-E<112>ong" section="Ping-pong" to="Net::Ping" type="pod">', + ' <L content-implicit="yes" section="Ping-pong" to="Net::Ping" type="pod">', ' "Ping-pong" in Net::Ping', ' </L>', ' o', diff --git a/cpan/Pod-Simple/t/xhtml01.t b/cpan/Pod-Simple/t/xhtml01.t index 7ee0865216..01e6f189b4 100644 --- a/cpan/Pod-Simple/t/xhtml01.t +++ b/cpan/Pod-Simple/t/xhtml01.t @@ -18,7 +18,7 @@ isa_ok ($parser, 'Pod::Simple::XHTML'); my $results; -my $PERLDOC = "https://metacpan.org/pod"; +my $PERLDOC = "http://search.cpan.org/perldoc"; my $MANURL = "http://man.he.net/man"; initialize($parser, $results); @@ -541,7 +541,7 @@ $parser->parse_string_document(<<'EOPOD'); A plain paragraph with a L<Newlines>. EOPOD is($results, <<"EOHTML", "Link entity in a paragraph"); -<p>A plain paragraph with a <a href="$PERLDOC/Newlines">Newlines</a>.</p> +<p>A plain paragraph with a <a href="$PERLDOC?Newlines">Newlines</a>.</p> EOHTML @@ -552,7 +552,7 @@ $parser->parse_string_document(<<'EOPOD'); A plain paragraph with a L<perlport/Newlines>. EOPOD is($results, <<"EOHTML", "Link entity in a paragraph"); -<p>A plain paragraph with a <a href="$PERLDOC/perlport#Newlines">"Newlines" in perlport</a>.</p> +<p>A plain paragraph with a <a href="$PERLDOC?perlport#Newlines">"Newlines" in perlport</a>.</p> EOHTML @@ -742,16 +742,16 @@ like $results, qr{\Q<meta http-equiv="Content-Type" content="text/html; charset= # Test the link generation methods. is $parser->resolve_pod_page_link('Net::Ping', 'INSTALL'), - "$PERLDOC/Net::Ping#INSTALL", + "$PERLDOC?Net::Ping#INSTALL", 'POD link with fragment'; is $parser->resolve_pod_page_link('perlpodspec'), - "$PERLDOC/perlpodspec", 'Simple POD link'; + "$PERLDOC?perlpodspec", 'Simple POD link'; is $parser->resolve_pod_page_link(undef, 'SYNOPSIS'), '#SYNOPSIS', 'Simple fragment link'; is $parser->resolve_pod_page_link(undef, 'this that'), '#this-that', 'Fragment link with space'; is $parser->resolve_pod_page_link('perlpod', 'this that'), - "$PERLDOC/perlpod#this-that", + "$PERLDOC?perlpod#this-that", 'POD link with fragment with space'; is $parser->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE'), |