GSP/Panel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added Cyg-Win

Browse source
This commit is contained in:
Frank Harris 2026-06-06 18:46:40 -04:00
parent 82cbc206eb
commit 413c315806
10586 changed files with 3806249 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

1209
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Checker.pm Normal file
View file

File diff suppressed because it is too large Load diff

732
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Escapes.pm Normal file
View file

@ -0,0 +1,732 @@
package Pod::Escapes;
use strict;
use warnings;
use 5.006;
use vars qw(
%Code2USASCII
%Name2character
%Name2character_number
%Latin1Code_to_fallback
%Latin1Char_to_fallback
$FAR_CHAR
$FAR_CHAR_NUMBER
$NOT_ASCII
@ISA $VERSION @EXPORT_OK %EXPORT_TAGS
);
require Exporter;
@ISA = ('Exporter');
$VERSION = '1.07';
@EXPORT_OK = qw(
%Code2USASCII
%Name2character
%Name2character_number
%Latin1Code_to_fallback
%Latin1Char_to_fallback
e2char
e2charnum
);
%EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
#==========================================================================
$FAR_CHAR = "?" unless defined $FAR_CHAR;
$FAR_CHAR_NUMBER = ord($FAR_CHAR) unless defined $FAR_CHAR_NUMBER;
$NOT_ASCII = 'A' ne chr(65) unless defined $NOT_ASCII;
#--------------------------------------------------------------------------
sub e2char {
my $in = $_[0];
return undef unless defined $in and length $in;
# Convert to decimal:
if($in =~ m/^(0[0-7]*)$/s ) {
$in = oct $in;
} elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
$in = hex $1;
} # else it's decimal, or named
if($in =~ m/^\d+$/s) {
if($] < 5.007 and $in > 255) { # can't be trusted with Unicode
return $FAR_CHAR;
} elsif ($] >= 5.007003) {
return chr(utf8::unicode_to_native($in));
} elsif ($NOT_ASCII) {
return $Code2USASCII{$in} # so "65" => "A" everywhere
|| $Latin1Code_to_fallback{$in} # Fallback.
|| $FAR_CHAR; # Fall further back
} else {
return chr($in);
}
} else {
return $Name2character{$in}; # returns undef if unknown
}
}
#--------------------------------------------------------------------------
sub e2charnum {
my $in = $_[0];
return undef unless defined $in and length $in;
# Convert to decimal:
if($in =~ m/^(0[0-7]*)$/s ) {
$in = oct $in;
} elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
$in = hex $1;
} # else it's decimal, or named
if($in =~ m/^[0-9]+$/s) {
return 0 + $in;
} else {
return $Name2character_number{$in}; # returns undef if unknown
}
}
#--------------------------------------------------------------------------
%Code2USASCII = (
# mostly generated by
# perl -e "printf qq{ \x25 3s, '\x25s',\n}, $_, chr($_) foreach (32 .. 126)"
32, ' ',
33, '!',
34, '"',
35, '#',
36, '$',
37, '%',
38, '&',
39, "'", #!
40, '(',
41, ')',
42, '*',
43, '+',
44, ',',
45, '-',
46, '.',
47, '/',
48, '0',
49, '1',
50, '2',
51, '3',
52, '4',
53, '5',
54, '6',
55, '7',
56, '8',
57, '9',
58, ':',
59, ';',
60, '<',
61, '=',
62, '>',
63, '?',
64, '@',
65, 'A',
66, 'B',
67, 'C',
68, 'D',
69, 'E',
70, 'F',
71, 'G',
72, 'H',
73, 'I',
74, 'J',
75, 'K',
76, 'L',
77, 'M',
78, 'N',
79, 'O',
80, 'P',
81, 'Q',
82, 'R',
83, 'S',
84, 'T',
85, 'U',
86, 'V',
87, 'W',
88, 'X',
89, 'Y',
90, 'Z',
91, '[',
92, "\\", #!
93, ']',
94, '^',
95, '_',
96, '`',
97, 'a',
98, 'b',
99, 'c',
100, 'd',
101, 'e',
102, 'f',
103, 'g',
104, 'h',
105, 'i',
106, 'j',
107, 'k',
108, 'l',
109, 'm',
110, 'n',
111, 'o',
112, 'p',
113, 'q',
114, 'r',
115, 's',
116, 't',
117, 'u',
118, 'v',
119, 'w',
120, 'x',
121, 'y',
122, 'z',
123, '{',
124, '|',
125, '}',
126, '~',
);
#--------------------------------------------------------------------------
%Latin1Code_to_fallback = ();
@Latin1Code_to_fallback{0xA0 .. 0xFF} = (
# Copied from Text/Unidecode/x00.pm:
' ', qq{!}, qq{C/}, 'PS', qq{\$?}, qq{Y=}, qq{|}, 'SS', qq{"}, qq{(c)}, 'a', qq{<<}, qq{!}, "", qq{(r)}, qq{-},
'deg', qq{+-}, '2', '3', qq{'}, 'u', 'P', qq{*}, qq{,}, '1', 'o', qq{>>}, qq{1/4}, qq{1/2}, qq{3/4}, qq{?},
'A', 'A', 'A', 'A', 'A', 'A', 'AE', 'C', 'E', 'E', 'E', 'E', 'I', 'I', 'I', 'I',
'D', 'N', 'O', 'O', 'O', 'O', 'O', 'x', 'O', 'U', 'U', 'U', 'U', 'U', 'Th', 'ss',
'a', 'a', 'a', 'a', 'a', 'a', 'ae', 'c', 'e', 'e', 'e', 'e', 'i', 'i', 'i', 'i',
'd', 'n', 'o', 'o', 'o', 'o', 'o', qq{/}, 'o', 'u', 'u', 'u', 'u', 'y', 'th', 'y',
);
{
# Now stuff %Latin1Char_to_fallback:
%Latin1Char_to_fallback = ();
my($k,$v);
while( ($k,$v) = each %Latin1Code_to_fallback) {
$Latin1Char_to_fallback{chr $k} = $v;
#print chr($k), ' => ', $v, "\n";
}
}
#--------------------------------------------------------------------------
%Name2character_number = (
# General XML/XHTML:
'lt' => 60,
'gt' => 62,
'quot' => 34,
'amp' => 38,
'apos' => 39,
# POD-specific:
'sol' => 47,
'verbar' => 124,
'lchevron' => 171, # legacy for laquo
'rchevron' => 187, # legacy for raquo
# Remember, grave looks like \ (as in virtu\)
# acute looks like / (as in re/sume/)
# circumflex looks like ^ (as in papier ma^che/)
# umlaut/dieresis looks like " (as in nai"ve, Chloe")
# From the XHTML 1 .ent files:
'nbsp' , 160,
'iexcl' , 161,
'cent' , 162,
'pound' , 163,
'curren' , 164,
'yen' , 165,
'brvbar' , 166,
'sect' , 167,
'uml' , 168,
'copy' , 169,
'ordf' , 170,
'laquo' , 171,
'not' , 172,
'shy' , 173,
'reg' , 174,
'macr' , 175,
'deg' , 176,
'plusmn' , 177,
'sup2' , 178,
'sup3' , 179,
'acute' , 180,
'micro' , 181,
'para' , 182,
'middot' , 183,
'cedil' , 184,
'sup1' , 185,
'ordm' , 186,
'raquo' , 187,
'frac14' , 188,
'frac12' , 189,
'frac34' , 190,
'iquest' , 191,
'Agrave' , 192,
'Aacute' , 193,
'Acirc' , 194,
'Atilde' , 195,
'Auml' , 196,
'Aring' , 197,
'AElig' , 198,
'Ccedil' , 199,
'Egrave' , 200,
'Eacute' , 201,
'Ecirc' , 202,
'Euml' , 203,
'Igrave' , 204,
'Iacute' , 205,
'Icirc' , 206,
'Iuml' , 207,
'ETH' , 208,
'Ntilde' , 209,
'Ograve' , 210,
'Oacute' , 211,
'Ocirc' , 212,
'Otilde' , 213,
'Ouml' , 214,
'times' , 215,
'Oslash' , 216,
'Ugrave' , 217,
'Uacute' , 218,
'Ucirc' , 219,
'Uuml' , 220,
'Yacute' , 221,
'THORN' , 222,
'szlig' , 223,
'agrave' , 224,
'aacute' , 225,
'acirc' , 226,
'atilde' , 227,
'auml' , 228,
'aring' , 229,
'aelig' , 230,
'ccedil' , 231,
'egrave' , 232,
'eacute' , 233,
'ecirc' , 234,
'euml' , 235,
'igrave' , 236,
'iacute' , 237,
'icirc' , 238,
'iuml' , 239,
'eth' , 240,
'ntilde' , 241,
'ograve' , 242,
'oacute' , 243,
'ocirc' , 244,
'otilde' , 245,
'ouml' , 246,
'divide' , 247,
'oslash' , 248,
'ugrave' , 249,
'uacute' , 250,
'ucirc' , 251,
'uuml' , 252,
'yacute' , 253,
'thorn' , 254,
'yuml' , 255,
'fnof' , 402,
'Alpha' , 913,
'Beta' , 914,
'Gamma' , 915,
'Delta' , 916,
'Epsilon' , 917,
'Zeta' , 918,
'Eta' , 919,
'Theta' , 920,
'Iota' , 921,
'Kappa' , 922,
'Lambda' , 923,
'Mu' , 924,
'Nu' , 925,
'Xi' , 926,
'Omicron' , 927,
'Pi' , 928,
'Rho' , 929,
'Sigma' , 931,
'Tau' , 932,
'Upsilon' , 933,
'Phi' , 934,
'Chi' , 935,
'Psi' , 936,
'Omega' , 937,
'alpha' , 945,
'beta' , 946,
'gamma' , 947,
'delta' , 948,
'epsilon' , 949,
'zeta' , 950,
'eta' , 951,
'theta' , 952,
'iota' , 953,
'kappa' , 954,
'lambda' , 955,
'mu' , 956,
'nu' , 957,
'xi' , 958,
'omicron' , 959,
'pi' , 960,
'rho' , 961,
'sigmaf' , 962,
'sigma' , 963,
'tau' , 964,
'upsilon' , 965,
'phi' , 966,
'chi' , 967,
'psi' , 968,
'omega' , 969,
'thetasym' , 977,
'upsih' , 978,
'piv' , 982,
'bull' , 8226,
'hellip' , 8230,
'prime' , 8242,
'Prime' , 8243,
'oline' , 8254,
'frasl' , 8260,
'weierp' , 8472,
'image' , 8465,
'real' , 8476,
'trade' , 8482,
'alefsym' , 8501,
'larr' , 8592,
'uarr' , 8593,
'rarr' , 8594,
'darr' , 8595,
'harr' , 8596,
'crarr' , 8629,
'lArr' , 8656,
'uArr' , 8657,
'rArr' , 8658,
'dArr' , 8659,
'hArr' , 8660,
'forall' , 8704,
'part' , 8706,
'exist' , 8707,
'empty' , 8709,
'nabla' , 8711,
'isin' , 8712,
'notin' , 8713,
'ni' , 8715,
'prod' , 8719,
'sum' , 8721,
'minus' , 8722,
'lowast' , 8727,
'radic' , 8730,
'prop' , 8733,
'infin' , 8734,
'ang' , 8736,
'and' , 8743,
'or' , 8744,
'cap' , 8745,
'cup' , 8746,
'int' , 8747,
'there4' , 8756,
'sim' , 8764,
'cong' , 8773,
'asymp' , 8776,
'ne' , 8800,
'equiv' , 8801,
'le' , 8804,
'ge' , 8805,
'sub' , 8834,
'sup' , 8835,
'nsub' , 8836,
'sube' , 8838,
'supe' , 8839,
'oplus' , 8853,
'otimes' , 8855,
'perp' , 8869,
'sdot' , 8901,
'lceil' , 8968,
'rceil' , 8969,
'lfloor' , 8970,
'rfloor' , 8971,
'lang' , 9001,
'rang' , 9002,
'loz' , 9674,
'spades' , 9824,
'clubs' , 9827,
'hearts' , 9829,
'diams' , 9830,
'OElig' , 338,
'oelig' , 339,
'Scaron' , 352,
'scaron' , 353,
'Yuml' , 376,
'circ' , 710,
'tilde' , 732,
'ensp' , 8194,
'emsp' , 8195,
'thinsp' , 8201,
'zwnj' , 8204,
'zwj' , 8205,
'lrm' , 8206,
'rlm' , 8207,
'ndash' , 8211,
'mdash' , 8212,
'lsquo' , 8216,
'rsquo' , 8217,
'sbquo' , 8218,
'ldquo' , 8220,
'rdquo' , 8221,
'bdquo' , 8222,
'dagger' , 8224,
'Dagger' , 8225,
'permil' , 8240,
'lsaquo' , 8249,
'rsaquo' , 8250,
'euro' , 8364,
);
# Fill out %Name2character...
{
%Name2character = ();
my($name, $number);
while( ($name, $number) = each %Name2character_number) {
if($] < 5.007 and $number > 255) {
$Name2character{$name} = $FAR_CHAR;
# substitute for Unicode characters, for perls
# that can't reliably handle them
} elsif ($] >= 5.007003) {
$Name2character{$name} = chr utf8::unicode_to_native($number);
# normal case for more recent Perls where we can translate from Unicode
# to the native character set.
}
elsif (exists $Code2USASCII{$number}) {
$Name2character{$name} = $Code2USASCII{$number};
# on older Perls, we can use the translations we have hard-coded in this
# file, but these don't include the non-ASCII-range characters
}
elsif ($NOT_ASCII && $number > 127 && $number < 256) {
# this range on old non-ASCII-platform perls is wrong
if (exists $Latin1Code_to_fallback{$number}) {
$Name2character{$name} = $Latin1Code_to_fallback{$number};
} else {
$Name2character{$name} = $FAR_CHAR;
}
} else {
$Name2character{$name} = chr $number;
}
}
}
#--------------------------------------------------------------------------
1;
__END__
=head1 NAME
Pod::Escapes - for resolving Pod EE<lt>...E<gt> sequences
=head1 SYNOPSIS
use Pod::Escapes qw(e2char);
...la la la, parsing POD, la la la...
$text = e2char($e_node->label);
unless(defined $text) {
print "Unknown E sequence \"", $e_node->label, "\"!";
}
...else print/interpolate $text...
=head1 DESCRIPTION
This module provides things that are useful in decoding
Pod EE<lt>...E<gt> sequences. Presumably, it should be used
only by Pod parsers and/or formatters.
By default, Pod::Escapes exports none of its symbols. But
you can request any of them to be exported.
Either request them individually, as with
C<use Pod::Escapes qw(symbolname symbolname2...);>,
or you can do C<use Pod::Escapes qw(:ALL);> to get all
exportable symbols.
=head1 GOODIES
=over
=item e2char($e_content)
Given a name or number that could appear in a
C<EE<lt>name_or_numE<gt>> sequence, this returns the string that
it stands for. For example, C<e2char('sol')>, C<e2char('47')>,
C<e2char('0x2F')>, and C<e2char('057')> all return "/",
because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
and C<EE<lt>057E<gt>>, all mean "/". If
the name has no known value (as with a name of "qacute") or is
syntactically invalid (as with a name of "1/4"), this returns undef.
=item e2charnum($e_content)
Given a name or number that could appear in a
C<EE<lt>name_or_numE<gt>> sequence, this returns the number of
the Unicode character that this stands for. For example,
C<e2char('sol')>, C<e2char('47')>,
C<e2char('0x2F')>, and C<e2char('057')> all return 47,
because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
and C<EE<lt>057E<gt>>, all mean "/", whose Unicode number is 47. If
the name has no known value (as with a name of "qacute") or is
syntactically invalid (as with a name of "1/4"), this returns undef.
=item $Name2character{I<name>}
Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
to the string that each stands for. Note that this does not
include numerics (like "64" or "x981c"). Under old Perl versions
(before 5.7) you get a "?" in place of characters whose Unicode
value is over 255.
=item $Name2character_number{I<name>}
Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
to the Unicode value that each stands for. For example,
C<$Name2character_number{'eacute'}> is 201, and
C<$Name2character_number{'eacute'}> is 8364. You get the correct
Unicode value, regardless of the version of Perl you're using --
which differs from C<%Name2character>'s behavior under pre-5.7 Perls.
Note that this hash does not
include numerics (like "64" or "x981c").
=item $Latin1Code_to_fallback{I<integer>}
For numbers in the range 160 (0x00A0) to 255 (0x00FF), this maps
from the character code for a Latin-1 character (like 233 for
lowercase e-acute) to the US-ASCII character that best aproximates
it (like "e"). You may find this useful if you are rendering
POD in a format that you think deals well only with US-ASCII
characters.
=item $Latin1Char_to_fallback{I<character>}
Just as above, but maps from characters (like "\xE9",
lowercase e-acute) to characters (like "e").
=item $Code2USASCII{I<integer>}
This maps from US-ASCII codes (like 32) to the corresponding
character (like space, for 32). Only characters 32 to 126 are
defined. This is meant for use by C<e2char($x)> when it senses
that it's running on a non-ASCII platform (where chr(32) doesn't
get you a space -- but $Code2USASCII{32} will). It's
documented here just in case you might find it useful.
=back
=head1 CAVEATS
On Perl versions before 5.7, Unicode characters with a value
over 255 (like lambda or emdash) can't be conveyed. This
module does work under such early Perl versions, but in the
place of each such character, you get a "?". Latin-1
characters (characters 160-255) are unaffected.
Under EBCDIC platforms, C<e2char($n)> may not always be the
same as C<chr(e2charnum($n))>, and ditto for
C<$Name2character{$name}> and
C<chr($Name2character_number{$name})>, because the strings are returned as
native, and the numbers are returned as Unicode.
However, for Perls starting with v5.8, C<e2char($n)> is the same as
C<chr(utf8::unicode_to_native(e2charnum($n)))>, and ditto for
C<$Name2character{$name}> and
C<chr(utf8::unicode_to_native($Name2character_number{$name}))>.
=head1 SEE ALSO
L<Pod::Browser> - a pod web server based on L<Catalyst>.
L<Pod::Checker> - check pod documents for syntax errors.
L<Pod::Coverage> - check if the documentation for a module is comprehensive.
L<perlpod> - description of pod format (for people documenting with pod).
L<perlpodspec> - specification of pod format (for people processing it).
L<Text::Unidecode> - ASCII transliteration of Unicode text.
=head1 REPOSITORY
L<https://github.com/neilbowers/Pod-Escapes>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2001-2004 Sean M. Burke. All rights reserved.
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.
Portions of the data tables in this module are derived from the
entity declarations in the W3C XHTML specification.
Currently (October 2001), that's these three:
http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent
http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent
http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent
=head1 AUTHOR
Sean M. Burke C<sburke@cpan.org>
Now being maintained by Neil Bowers E<lt>neilb@cpan.orgE<gt>
=cut
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# What I used for reading the XHTML .ent files:
my(@norms, @good, @bad);
my $dir = 'c:/sgml/docbook/';
my %escapes;
foreach my $file (qw(
xhtml-symbol.ent
xhtml-lat1.ent
xhtml-special.ent
)) {
open(IN, "<$dir$file") or die "can't read-open $dir$file: $!";
print "Reading $file...\n";
while(<IN>) {
if(m/<!ENTITY\s+(\S+)\s+"&#([^;]+);">/) {
my($name, $value) = ($1,$2);
next if $name eq 'quot' or $name eq 'apos' or $name eq 'gt';
$value = hex $1 if $value =~ m/^x([a-fA-F0-9]+)$/s;
print "ILLEGAL VALUE $value" unless $value =~ m/^\d+$/s;
if($value > 255) {
push @good , sprintf " %-10s , chr(%s),\n", "'$name'", $value;
push @bad , sprintf " %-10s , \$bad,\n", "'$name'", $value;
} else {
push @norms, sprintf " %-10s , chr(%s),\n", "'$name'", $value;
}
} elsif(m/<!ENT/) {
print "# Skipping $_";
}
}
close(IN);
}
print @norms;
print "\n ( \$] .= 5.006001 ? (\n";
print @good;
print " ) : (\n";
print @bad;
print " )\n);\n";
__END__
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

354
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Functions.pm Normal file
View file

@ -0,0 +1,354 @@
package Pod::Functions;
use strict;
=head1 NAME
Pod::Functions - Group Perl's functions a la perlfunc.pod
=head1 SYNOPSIS
use Pod::Functions;
my @misc_ops = @{ $Kinds{ 'Misc' } };
my $misc_dsc = $Type_Description{ 'Misc' };
or
perl /path/to/lib/Pod/Functions.pm
This will print a grouped list of Perl's functions, like the
L<perlfunc/"Perl Functions by Category"> section.
=head1 DESCRIPTION
It exports the following variables:
=over 4
=item %Kinds
This holds a hash-of-lists. Each list contains the functions in the category
the key denotes.
=item %Type
In this hash each key represents a function and the value is the category.
The category can be a comma separated list.
=item %Flavor
In this hash each key represents a function and the value is a short
description of that function.
=item %Type_Description
In this hash each key represents a category of functions and the value is
a short description of that category.
=item @Type_Order
This list of categories is used to produce the same order as the
L<perlfunc/"Perl Functions by Category"> section.
=back
=cut
our $VERSION = '1.14';
use Exporter 'import';
our @EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);
our(%Kinds, %Type, %Flavor, %Type_Description, @Type_Order);
foreach (
[String => 'Functions for SCALARs or strings'],
[Regexp => 'Regular expressions and pattern matching'],
[Math => 'Numeric functions'],
[ARRAY => 'Functions for real @ARRAYs'],
[LIST => 'Functions for list data'],
[HASH => 'Functions for real %HASHes'],
['I/O' => 'Input and output functions'],
[Binary => 'Functions for fixed-length data or records'],
[File => 'Functions for filehandles, files, or directories'],
[Flow => 'Keywords related to the control flow of your Perl program'],
[Namespace => 'Keywords related to scoping'],
[Misc => 'Miscellaneous functions'],
[Process => 'Functions for processes and process groups'],
[Modules => 'Keywords related to Perl modules'],
[Objects => 'Keywords related to classes and object-orientation'],
[Socket => 'Low-level socket functions'],
[SysV => 'System V interprocess communication functions'],
[User => 'Fetching user and group info'],
[Network => 'Fetching network info'],
[Time => 'Time-related functions'],
) {
push @Type_Order, $_->[0];
$Type_Description{$_->[0]} = $_->[1];
};
while (<DATA>) {
chomp;
s/^#.*//;
next unless $_;
my($name, @data) = split "\t", $_;
$Flavor{$name} = pop @data;
$Type{$name} = join ',', @data;
for my $t (@data) {
push @{$Kinds{$t}}, $name;
}
}
close DATA;
my( $typedesc, $list );
unless (caller) {
foreach my $type ( @Type_Order ) {
$list = join(", ", sort @{$Kinds{$type}});
$typedesc = $Type_Description{$type} . ":";
write;
}
}
format =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$typedesc
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$typedesc
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$list
.
1;
__DATA__
-X File a file test (-r, -x, etc)
abs Math absolute value function
accept Socket accept an incoming socket connect
alarm Process schedule a SIGALRM
atan2 Math arctangent of Y/X in the range -PI to PI
bind Socket binds an address to a socket
binmode I/O prepare binary files for I/O
bless Objects create an object
break Flow break out of a C<given> block
caller Flow Namespace get context of the current subroutine call
chdir File change your current working directory
chmod File changes the permissions on a list of files
chomp String remove a trailing record separator from a string
chop String remove the last character from a string
chown File change the ownership on a list of files
chr String get character this number represents
chroot File make directory new root for path lookups
class Namespace Objects declare a separate global namespace that is an object class
__CLASS__ Objects the class name of the current instance.
close I/O close file (or pipe or socket) handle
closedir I/O close directory handle
connect Socket connect to a remote socket
continue Flow optional trailing block in a while or foreach
cos Math cosine function
crypt String one-way passwd-style encryption
dbmclose I/O Objects breaks binding on a tied dbm file
dbmopen I/O Objects create binding on a tied dbm file
defined Misc test whether a value, variable, or function is defined
delete HASH deletes a value from a hash
die Flow I/O raise an exception or bail out
do Flow Modules turn a BLOCK into a TERM
dump Flow create an immediate core dump
each ARRAY HASH retrieve the next key/value pair from a hash
endgrent User be done using group file
endhostent User be done using hosts file
endnetent User be done using networks file
endprotoent Network be done using protocols file
endpwent User be done using passwd file
endservent Network be done using services file
eof I/O test a filehandle for its end
eval Flow catch exceptions or compile and run code
evalbytes Flow similar to string eval, but intend to parse a bytestream
exec Process abandon this program to run another
exists HASH test whether a hash key is present
exit Flow terminate this program
exp Math raise I<e> to a power
fc String return casefolded version of a string
fcntl File file control system call
field Namespace Objects declare a field variable of the current class
__FILE__ Flow the name of the current source file
fileno I/O return file descriptor from filehandle
flock I/O lock an entire file with an advisory lock
fork Process create a new process just like this one
format I/O declare a picture format with use by the write() function
formline Misc internal function used for formats
getc I/O get the next character from the filehandle
getgrent User get next group record
getgrgid User get group record given group user ID
getgrnam User get group record given group name
gethostbyaddr Network get host record given its address
gethostbyname Network get host record given name
gethostent Network get next hosts record
getlogin User return who logged in at this tty
getnetbyaddr Network get network record given its address
getnetbyname Network get networks record given name
getnetent Network get next networks record
getpeername Socket find the other end of a socket connection
getpgrp Process get process group
getppid Process get parent process ID
getpriority Process get current nice value
getprotobyname Network get protocol record given name
getprotobynumber Network get protocol record numeric protocol
getprotoent Network get next protocols record
getpwent User get next passwd record
getpwnam User get passwd record given user login name
getpwuid User get passwd record given user ID
getservbyname Network get services record given its name
getservbyport Network get services record given numeric port
getservent Network get next services record
getsockname Socket retrieve the sockaddr for a given socket
getsockopt Socket get socket options on a given socket
glob File expand filenames using wildcards
gmtime Time convert UNIX time into record or string using Greenwich time
goto Flow create spaghetti code
grep LIST locate elements in a list test true against a given criterion
hex Math String convert a hexadecimal string to a number
import Modules Namespace patch a module's namespace into your own
index String find a substring within a string
int Math get the integer portion of a number
ioctl File system-dependent device control system call
join LIST join a list into a string using a separator
keys ARRAY HASH retrieve list of indices from a hash
kill Process send a signal to a process or process group
last Flow exit a block prematurely
lc String return lower-case version of a string
lcfirst String return a string with just the next letter in lower case
length String return the number of characters in a string
__LINE__ Flow the current source line number
link File create a hard link in the filesystem
listen Socket register your socket as a server
local Namespace create a temporary value for a global variable (dynamic scoping)
localtime Time convert UNIX time into record or string using local time
lock Misc get a thread lock on a variable, subroutine, or method
log Math retrieve the natural logarithm for a number
lstat File stat a symbolic link
m// Regexp match a string with a regular expression pattern
map LIST apply a change to a list to get back a new list with the changes
method Flow Objects declare a method of a class
mkdir File create a directory
msgctl SysV SysV IPC message control operations
msgget SysV get SysV IPC message queue
msgrcv SysV receive a SysV IPC message from a message queue
msgsnd SysV send a SysV IPC message to a message queue
my Namespace declare and assign a local variable (lexical scoping)
next Flow iterate a block prematurely
no Modules unimport some module symbols or semantics at compile time
oct Math String convert a string to an octal number
open File open a file, pipe, or descriptor
opendir File open a directory
ord String find a character's code point
our Namespace declare and assign a package variable (lexical scoping)
pack Binary String convert a list into a binary representation
package Modules Namespace Objects declare a separate global namespace
__PACKAGE__ Flow the current package
pipe Process open a pair of connected filehandles
pop ARRAY remove the last element from an array and return it
pos Regexp find or set the offset for the last/next m//g search
print I/O output a list to a filehandle
printf I/O output a formatted list to a filehandle
prototype Misc get the prototype (if any) of a subroutine
push ARRAY append one or more elements to an array
q/STRING/ String singly quote a string
qq/STRING/ String doubly quote a string
qr/STRING/ Regexp compile pattern
quotemeta Regexp quote regular expression magic characters
qw/STRING/ LIST quote a list of words
qx/STRING/ Process backquote quote a string
rand Math retrieve the next pseudorandom number
read Binary I/O fixed-length buffered input from a filehandle
readdir I/O get a directory from a directory handle
readline I/O fetch a record from a file
readlink File determine where a symbolic link is pointing
readpipe Process execute a system command and collect standard output
recv Socket receive a message over a Socket
redo Flow start this loop iteration over again
ref Objects find out the type of thing being referenced
rename File change a filename
require Modules load in external functions from a library at runtime
reset Misc clear all variables of a given name
return Flow get out of a function early
reverse LIST String flip a string or a list
rewinddir I/O reset directory handle
rindex String right-to-left substring search
rmdir File remove a directory
s/// Regexp replace a pattern with a string
say I/O output a list to a filehandle, appending a newline
scalar Misc force a scalar context
seek I/O reposition file pointer for random-access I/O
seekdir I/O reposition directory pointer
select File I/O reset default output or do I/O multiplexing
semctl SysV SysV semaphore control operations
semget SysV get set of SysV semaphores
semop SysV SysV semaphore operations
send Socket send a message over a socket
setgrent User prepare group file for use
sethostent Network prepare hosts file for use
setnetent Network prepare networks file for use
setpgrp Process set the process group of a process
setpriority Process set a process's nice value
setprotoent Network prepare protocols file for use
setpwent User prepare passwd file for use
setservent Network prepare services file for use
setsockopt Socket set some socket options
shift ARRAY remove the first element of an array, and return it
shmctl SysV SysV shared memory operations
shmget SysV get SysV shared memory segment identifier
shmread SysV read SysV shared memory
shmwrite SysV write SysV shared memory
shutdown Socket close down just half of a socket connection
sin Math return the sine of a number
sleep Process block for some number of seconds
socket Socket create a socket
socketpair Socket create a pair of sockets
sort LIST sort a list of values
splice ARRAY add or remove elements anywhere in an array
split Regexp split up a string using a regexp delimiter
sprintf String formatted print into a string
sqrt Math square root function
srand Math seed the random number generator
stat File get a file's status information
state Namespace declare and assign a persistent lexical variable
study Regexp no-op, formerly optimized input data for repeated searches
sub Flow declare a subroutine, possibly anonymously
__SUB__ Flow the current subroutine, or C<undef> if not in a subroutine
substr String get or alter a portion of a string
symlink File create a symbolic link to a file
syscall Binary I/O execute an arbitrary system call
sysopen File open a file, pipe, or descriptor
sysread Binary I/O fixed-length unbuffered input from a filehandle
sysseek Binary I/O position I/O pointer on handle used with sysread and syswrite
system Process run a separate program
syswrite Binary I/O fixed-length unbuffered output to a filehandle
tell I/O get current seekpointer on a filehandle
telldir I/O get current seekpointer on a directory handle
tie Objects bind a variable to an object class
tied Objects get a reference to the object underlying a tied variable
time Time return number of seconds since 1970
times Process Time return elapsed time for self and child processes
tr/// String transliterate a string
truncate I/O shorten a file
uc String return upper-case version of a string
ucfirst String return a string with the first letter in upper case
umask File set file creation mode mask
undef Misc remove a variable or function definition
unlink File remove one link to a file
unpack Binary LIST convert binary structure into normal perl variables
unshift ARRAY prepend more elements to the beginning of a list
untie Objects break a tie binding to a variable
use Modules Namespace Objects enable Perl language features and declare required version
utime File set a file's last access and modify times
values ARRAY HASH return a list of the values in a hash
vec Binary test or set particular bits in a string
wait Process wait for any child process to die
waitpid Process wait for a particular child process to die
wantarray Flow get void vs scalar vs list context of current subroutine call
warn I/O print debugging info
write I/O print a picture record
y/// String transliterate a string

724
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Html.pm Normal file
View file

@ -0,0 +1,724 @@
package Pod::Html;
use strict;
use Exporter 'import';
our $VERSION = 1.35;
$VERSION = eval $VERSION;
our @EXPORT = qw(pod2html);
use Config;
use Cwd;
use File::Basename;
use File::Spec;
use Pod::Simple::Search;
use Pod::Simple::SimpleTree ();
use Pod::Html::Util qw(
html_escape
process_command_line
trim_leading_whitespace
unixify
usage
htmlify
anchorify
relativize_url
);
use locale; # make \w work right in non-ASCII lands
=head1 NAME
Pod::Html - module to convert pod files to HTML
=head1 SYNOPSIS
use Pod::Html;
pod2html([options]);
=head1 DESCRIPTION
Converts files from pod format (see L<perlpod>) to HTML format. It
can automatically generate indexes and cross-references, and it keeps
a cache of things it knows how to cross-reference.
=head1 FUNCTIONS
=head2 pod2html
pod2html("pod2html",
"--podpath=lib:ext:pod:vms",
"--podroot=/usr/src/perl",
"--htmlroot=/perl/nmanual",
"--recurse",
"--infile=foo.pod",
"--outfile=/perl/nmanual/foo.html");
pod2html takes the following arguments:
=over 4
=item backlink
--backlink
Turns every C<head1> heading into a link back to the top of the page.
By default, no backlinks are generated.
=item cachedir
--cachedir=name
Creates the directory cache in the given directory.
=item css
--css=stylesheet
Specify the URL of a cascading style sheet. Also disables all HTML/CSS
C<style> attributes that are output by default (to avoid conflicts).
=item flush
--flush
Flushes the directory cache.
=item header
--header
--noheader
Creates header and footer blocks containing the text of the C<NAME>
section. By default, no headers are generated.
=item help
--help
Displays the usage message.
=item htmldir
--htmldir=name
Sets the directory to which all cross references in the resulting
html file will be relative. Not passing this causes all links to be
absolute since this is the value that tells Pod::Html the root of the
documentation tree.
Do not use this and --htmlroot in the same call to pod2html; they are
mutually exclusive.
=item htmlroot
--htmlroot=name
Sets the base URL for the HTML files. When cross-references are made,
the HTML root is prepended to the URL.
Do not use this if relative links are desired: use --htmldir instead.
Do not pass both this and --htmldir to pod2html; they are mutually
exclusive.
=item index
--index
--noindex
Generate an index at the top of the HTML file. This is the default
behaviour.
=item infile
--infile=name
Specify the pod file to convert. Input is taken from STDIN if no
infile is specified.
=item outfile
--outfile=name
Specify the HTML file to create. Output goes to STDOUT if no outfile
is specified.
=item poderrors
--poderrors
--nopoderrors
Include a "POD ERRORS" section in the outfile if there were any POD
errors in the infile. This section is included by default.
=item podpath
--podpath=name:...:name
Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked to in cross references.
=item podroot
--podroot=name
Specify the base directory for finding library pods. Default is the
current working directory.
=item quiet
--quiet
--noquiet
Don't display I<mostly harmless> warning messages. These messages
will be displayed by default. But this is not the same as C<verbose>
mode.
=item recurse
--recurse
--norecurse
Recurse into subdirectories specified in podpath (default behaviour).
=item title
--title=title
Specify the title of the resulting HTML file.
=item verbose
--verbose
--noverbose
Display progress messages. By default, they won't be displayed.
=back
=head2 Formerly Exported Auxiliary Functions
Prior to perl-5.36, the following three functions were exported by
F<Pod::Html>, either by default or on request:
=over 4
=item * C<htmlify()> (by default)
=item * C<anchorify()> (upon request)
=item * C<relativize_url()> (upon request)
=back
The definition and documentation of these functions have been moved to
F<Pod::Html::Util>, viewable via C<perldoc Pod::Html::Util>.
Beginning with perl-5.38 these functions must be explicitly imported from
F<Pod::Html::Util>. Please modify your code as needed.
=head1 ENVIRONMENT
Uses C<$Config{pod2html}> to setup default options.
=head1 AUTHOR
Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
=head1 SEE ALSO
L<perlpod>
=head1 COPYRIGHT
This program is distributed under the Artistic License.
=cut
sub new {
my $class = shift;
return bless {}, $class;
}
sub pod2html {
local(@ARGV) = @_;
local $_;
my $self = Pod::Html->new();
$self->init_globals();
my $opts = process_command_line;
$self->process_options($opts);
$self->refine_globals();
# load or generate/cache %Pages
unless ($self->get_cache()) {
# generate %Pages
#%Pages = $self->generate_cache(\%Pages);
$self->generate_cache($self->{Pages});
}
my $input = $self->identify_input();
my $podtree = $self->parse_input_for_podtree($input);
$self->set_Title_from_podtree($podtree);
# set options for the HTML generator
my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
$parser->codes_in_verbatim(0);
$parser->anchor_items(1); # the old Pod::Html always did
$parser->backlink($self->{Backlink}); # linkify =head1 directives
$parser->force_title($self->{Title});
$parser->htmldir($self->{Htmldir});
$parser->htmlfileurl($self->{Htmlfileurl});
$parser->htmlroot($self->{Htmlroot});
$parser->index($self->{Doindex});
$parser->output_string(\$self->{output}); # written to file later
#$parser->pages(\%Pages);
$parser->pages($self->{Pages});
$parser->quiet($self->{Quiet});
$parser->verbose($self->{Verbose});
$parser = $self->refine_parser($parser);
$self->feed_tree_to_parser($parser, $podtree);
$self->write_file();
}
sub init_globals {
my $self = shift;
$self->{Cachedir} = "."; # The directory to which directory caches
# will be written.
$self->{Dircache} = "pod2htmd.tmp";
$self->{Htmlroot} = "/"; # http-server base directory from which all
# relative paths in $podpath stem.
$self->{Htmldir} = ""; # The directory to which the html pages
# will (eventually) be written.
$self->{Htmlfile} = ""; # write to stdout by default
$self->{Htmlfileurl} = ""; # The url that other files would use to
# refer to this file. This is only used
# to make relative urls that point to
# other files.
$self->{Poderrors} = 1;
$self->{Podfile} = ""; # read from stdin by default
$self->{Podpath} = []; # list of directories containing library pods.
$self->{Podroot} = $self->{Curdir} = File::Spec->curdir;
# filesystem base directory from which all
# relative paths in $podpath stem.
$self->{Css} = ''; # Cascading style sheet
$self->{Recurse} = 1; # recurse on subdirectories in $podpath.
$self->{Quiet} = 0; # not quiet by default
$self->{Verbose} = 0; # not verbose by default
$self->{Doindex} = 1; # non-zero if we should generate an index
$self->{Backlink} = 0; # no backlinks added by default
$self->{Header} = 0; # produce block header/footer
$self->{Title} = undef; # title to give the pod(s)
$self->{Saved_Cache_Key} = '';
$self->{Pages} = {};
return $self;
}
sub process_options {
my ($self, $opts) = @_;
$self->{Podpath} = (defined $opts->{podpath})
? [ split(":", $opts->{podpath}) ]
: [];
$self->{Backlink} = $opts->{backlink} if defined $opts->{backlink};
$self->{Cachedir} = unixify($opts->{cachedir}) if defined $opts->{cachedir};
$self->{Css} = $opts->{css} if defined $opts->{css};
$self->{Header} = $opts->{header} if defined $opts->{header};
$self->{Htmldir} = unixify($opts->{htmldir}) if defined $opts->{htmldir};
$self->{Htmlroot} = unixify($opts->{htmlroot}) if defined $opts->{htmlroot};
$self->{Doindex} = $opts->{index} if defined $opts->{index};
$self->{Podfile} = unixify($opts->{infile}) if defined $opts->{infile};
$self->{Htmlfile} = unixify($opts->{outfile}) if defined $opts->{outfile};
$self->{Poderrors} = $opts->{poderrors} if defined $opts->{poderrors};
$self->{Podroot} = unixify($opts->{podroot}) if defined $opts->{podroot};
$self->{Quiet} = $opts->{quiet} if defined $opts->{quiet};
$self->{Recurse} = $opts->{recurse} if defined $opts->{recurse};
$self->{Title} = $opts->{title} if defined $opts->{title};
$self->{Verbose} = $opts->{verbose} if defined $opts->{verbose};
warn "Flushing directory caches\n"
if $opts->{verbose} && defined $opts->{flush};
$self->{Dircache} = "$self->{Cachedir}/pod2htmd.tmp";
if (defined $opts->{flush}) {
1 while unlink($self->{Dircache});
}
return $self;
}
sub refine_globals {
my $self = shift;
# prevent '//' in urls
$self->{Htmlroot} = "" if $self->{Htmlroot} eq "/";
$self->{Htmldir} =~ s#/\z##;
if ( $self->{Htmlroot} eq ''
&& defined( $self->{Htmldir} )
&& $self->{Htmldir} ne ''
&& substr( $self->{Htmlfile}, 0, length( $self->{Htmldir} ) ) eq $self->{Htmldir}
) {
# Set the 'base' url for this file, so that we can use it
# as the location from which to calculate relative links
# to other files. If this is '', then absolute links will
# be used throughout.
#$self->{Htmlfileurl} = "$self->{Htmldir}/" . substr( $self->{Htmlfile}, length( $self->{Htmldir} ) + 1);
# Is the above not just "$self->{Htmlfileurl} = $self->{Htmlfile}"?
$self->{Htmlfileurl} = unixify($self->{Htmlfile});
}
return $self;
}
sub generate_cache {
my $self = shift;
my $pwd = getcwd();
chdir($self->{Podroot}) ||
die "$0: error changing to directory $self->{Podroot}: $!\n";
# find all pod modules/pages in podpath, store in %Pages
# - inc(0): do not prepend directories in @INC to search list;
# limit search to those in @{$self->{Podpath}}
# - verbose: report (via 'warn') what search is doing
# - laborious: to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
# - recurse: go into subdirectories
# - survey: search for POD files in PodPath
my ($name2path, $path2name) =
Pod::Simple::Search->new->inc(0)->verbose($self->{Verbose})->laborious(1)
->recurse($self->{Recurse})->survey(@{$self->{Podpath}});
# remove Podroot and extension from each file
for my $k (keys %{$name2path}) {
$self->{Pages}{$k} = _transform($self, $name2path->{$k});
}
chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
# cache the directory list for later use
warn "caching directories for later use\n" if $self->{Verbose};
open my $cache, '>', $self->{Dircache}
or die "$0: error open $self->{Dircache} for writing: $!\n";
print $cache join(":", @{$self->{Podpath}}) . "\n$self->{Podroot}\n";
my $_updirs_only = ($self->{Podroot} =~ /\.\./) && !($self->{Podroot} =~ /[^\.\\\/]/);
foreach my $key (keys %{$self->{Pages}}) {
if($_updirs_only) {
my $_dirlevel = $self->{Podroot};
while($_dirlevel =~ /\.\./) {
$_dirlevel =~ s/\.\.//;
# Assume $Pagesref->{$key} has '/' separators (html dir separators).
$self->{Pages}->{$key} =~ s/^[\w\s\-\.]+\///;
}
}
print $cache "$key $self->{Pages}->{$key}\n";
}
close $cache or die "error closing $self->{Dircache}: $!";
}
sub _transform {
my ($self, $v) = @_;
$v = $self->{Podroot} eq File::Spec->curdir
? File::Spec->abs2rel($v)
: File::Spec->abs2rel($v,
File::Spec->canonpath($self->{Podroot}));
# Convert path to unix style path
$v = unixify($v);
my ($file, $dir) = fileparse($v, qr/\.[^.]*/); # strip .ext
return $dir.$file;
}
sub get_cache {
my $self = shift;
# A first-level cache:
# Don't bother reading the cache files if they still apply
# and haven't changed since we last read them.
my $this_cache_key = $self->cache_key();
return 1 if $self->{Saved_Cache_Key} and $this_cache_key eq $self->{Saved_Cache_Key};
$self->{Saved_Cache_Key} = $this_cache_key;
# load the cache of %Pages if possible. $tests will be
# non-zero if successful.
my $tests = 0;
if (-f $self->{Dircache}) {
warn "scanning for directory cache\n" if $self->{Verbose};
$tests = $self->load_cache();
}
return $tests;
}
sub cache_key {
my $self = shift;
return join('!',
$self->{Dircache},
$self->{Recurse},
@{$self->{Podpath}},
$self->{Podroot},
stat($self->{Dircache}),
);
}
#
# load_cache - tries to find if the cache stored in $dircache is a valid
# cache of %Pages. if so, it loads them and returns a non-zero value.
#
sub load_cache {
my $self = shift;
my $tests = 0;
local $_;
warn "scanning for directory cache\n" if $self->{Verbose};
open(my $cachefh, '<', $self->{Dircache}) ||
die "$0: error opening $self->{Dircache} for reading: $!\n";
$/ = "\n";
# is it the same podpath?
$_ = <$cachefh>;
chomp($_);
$tests++ if (join(":", @{$self->{Podpath}}) eq $_);
# is it the same podroot?
$_ = <$cachefh>;
chomp($_);
$tests++ if ($self->{Podroot} eq $_);
# load the cache if its good
if ($tests != 2) {
close($cachefh);
return 0;
}
warn "loading directory cache\n" if $self->{Verbose};
while (<$cachefh>) {
/(.*?) (.*)$/;
$self->{Pages}->{$1} = $2;
}
close($cachefh);
return 1;
}
sub identify_input {
my $self = shift;
my $input;
unless (@ARGV && $ARGV[0]) {
if ($self->{Podfile} and $self->{Podfile} ne '-') {
$input = $self->{Podfile};
} else {
$input = '-'; # XXX: make a test case for this
}
} else {
$self->{Podfile} = $ARGV[0];
$input = *ARGV;
}
return $input;
}
sub parse_input_for_podtree {
my ($self, $input) = @_;
# set options for input parser
my $input_parser = Pod::Simple::SimpleTree->new;
# Normalize whitespace indenting
$input_parser->strip_verbatim_indent(\&trim_leading_whitespace);
$input_parser->codes_in_verbatim(0);
$input_parser->accept_targets(qw(html HTML));
$input_parser->no_errata_section(!$self->{Poderrors}); # note the inverse
warn "Converting input file $self->{Podfile}\n" if $self->{Verbose};
my $podtree = $input_parser->parse_file($input)->root;
return $podtree;
}
sub set_Title_from_podtree {
my ($self, $podtree) = @_;
unless(defined $self->{Title}) {
if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" &&
$podtree->[2]->[0] eq "head1" && @{$podtree->[2]} == 3 &&
ref($podtree->[2]->[2]) eq "" && $podtree->[2]->[2] eq "NAME" &&
ref($podtree->[3]) eq "ARRAY" && $podtree->[3]->[0] eq "Para" &&
@{$podtree->[3]} >= 3 &&
!(grep { ref($_) ne "" }
@{$podtree->[3]}[2..$#{$podtree->[3]}]) &&
(@$podtree == 4 ||
(ref($podtree->[4]) eq "ARRAY" &&
$podtree->[4]->[0] eq "head1"))) {
$self->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]);
}
}
$self->{Title} //= "";
$self->{Title} = html_escape($self->{Title});
return $self;
}
sub refine_parser {
my ($self, $parser) = @_;
# We need to add this ourselves because we use our own header, not
# ::XHTML's header. We need to set $parser->backlink to linkify
# the =head1 directives
my $bodyid = $self->{Backlink} ? ' id="_podtop_"' : '';
my $csslink = '';
my $tdstyle = ' style="background-color: #cccccc; color: #000"';
if ($self->{Css}) {
$csslink = qq(\n<link rel="stylesheet" href="$self->{Css}" type="text/css" />);
$csslink =~ s,\\,/,g;
$csslink =~ s,(/.):,$1|,;
$tdstyle= '';
}
# header/footer block
my $block = $self->{Header} ? <<END_OF_BLOCK : '';
<table border="0" width="100%" cellspacing="0" cellpadding="3">
<tr><td class="_podblock_"$tdstyle valign="middle">
<big><strong><span class="_podblock_">&nbsp;$self->{Title}</span></strong></big>
</td></tr>
</table>
END_OF_BLOCK
# create own header/footer because of --header
$parser->html_header(<<"HTMLHEAD");
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$self->{Title}</title>$csslink
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
<link rev="made" href="mailto:$Config{perladmin}" />
</head>
<body$bodyid>
$block
HTMLHEAD
$parser->html_footer(<<"HTMLFOOT");
$block
</body>
</html>
HTMLFOOT
return $parser;
}
# This sub duplicates the guts of Pod::Simple::FromTree. We could have
# used that module, except that it would have been a non-core dependency.
sub feed_tree_to_parser {
my($self, $parser, $tree) = @_;
if(ref($tree) eq "") {
$parser->_handle_text($tree);
} elsif(!($tree->[0] eq "X" && $parser->nix_X_codes)) {
$parser->_handle_element_start($tree->[0], $tree->[1]);
$self->feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree];
$parser->_handle_element_end($tree->[0]);
}
}
sub write_file {
my $self = shift;
$self->{Htmlfile} = "-" unless $self->{Htmlfile}; # stdout
my $fhout;
if($self->{Htmlfile} and $self->{Htmlfile} ne '-') {
open $fhout, ">", $self->{Htmlfile}
or die "$0: cannot open $self->{Htmlfile} file for output: $!\n";
} else {
open $fhout, ">-";
}
binmode $fhout, ":utf8";
print $fhout $self->{output};
close $fhout or die "Failed to close $self->{Htmlfile}: $!";
chmod 0644, $self->{Htmlfile} unless $self->{Htmlfile} eq '-';
}
package Pod::Simple::XHTML::LocalPodLinks;
use strict;
use warnings;
use parent 'Pod::Simple::XHTML';
use File::Spec;
use File::Spec::Unix;
__PACKAGE__->_accessorize(
'htmldir',
'htmlfileurl',
'htmlroot',
'pages', # Page name => relative/path/to/page from root POD dir
'quiet',
'verbose',
);
sub resolve_pod_page_link {
my ($self, $to, $section) = @_;
return undef unless defined $to || defined $section;
if (defined $section) {
$section = '#' . $self->idify($section, 1);
return $section unless defined $to;
} else {
$section = '';
}
my $path; # path to $to according to %Pages
unless (exists $self->pages->{$to}) {
# Try to find a POD that ends with $to and use that.
# e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
# look for $Podpath/*/XHTML in %Pages, with * being any path,
# as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
my @matches;
foreach my $modname (keys %{$self->pages}) {
push @matches, $modname if $modname =~ /::\Q$to\E\z/;
}
# make it look like a path instead of a namespace
my $modloc = File::Spec->catfile(split(/::/, $to));
if ($#matches == -1) {
warn "Cannot find file \"$modloc.*\" directly under podpath, " .
"cannot find suitable replacement: link remains unresolved.\n"
if $self->verbose;
return '';
} elsif ($#matches == 0) {
$path = $self->pages->{$matches[0]};
my $matchloc = File::Spec->catfile(split(/::/, $path));
warn "Cannot find file \"$modloc.*\" directly under podpath, but ".
"I did find \"$matchloc.*\", so I'll assume that is what you ".
"meant to link to.\n"
if $self->verbose;
} else {
# Use [-1] so newer (higher numbered) perl PODs are used
# XXX currently, @matches isn't sorted so this is not true
$path = $self->pages->{$matches[-1]};
my $matchloc = File::Spec->catfile(split(/::/, $path));
warn "Cannot find file \"$modloc.*\" directly under podpath, but ".
"I did find \"$matchloc.*\" (among others), so I'll use that " .
"to resolve the link.\n" if $self->verbose;
}
} else {
$path = $self->pages->{$to};
}
my $url = File::Spec::Unix->catfile(Pod::Html::Util::unixify($self->htmlroot),
$path);
if ($self->htmlfileurl ne '') {
# then $self->htmlroot eq '' (by definition of htmlfileurl) so
# $self->htmldir needs to be prepended to link to get the absolute path
# that will be relativized
$url = Pod::Html::Util::relativize_url(
File::Spec::Unix->catdir(Pod::Html::Util::unixify($self->htmldir), $url),
$self->htmlfileurl # already unixified
);
}
return $url . ".html$section";
}
1;

289
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Html/Util.pm Normal file
View file

@ -0,0 +1,289 @@
package Pod::Html::Util;
use strict;
use Exporter 'import';
our $VERSION = 1.35; # Please keep in synch with lib/Pod/Html.pm
$VERSION = eval $VERSION;
our @EXPORT_OK = qw(
anchorify
html_escape
htmlify
process_command_line
relativize_url
trim_leading_whitespace
unixify
usage
);
use Config;
use File::Spec;
use File::Spec::Unix;
use Getopt::Long;
use Pod::Simple::XHTML;
use Text::Tabs;
use locale; # make \w work right in non-ASCII lands
=head1 NAME
Pod::Html::Util - helper functions for Pod-Html
=head1 SUBROUTINES
B<Note:> While these functions are importable on request from
F<Pod::Html::Util>, they are specifically intended for use within (a) the
F<Pod-Html> distribution (modules and test programs) shipped as part of the
Perl 5 core and (b) other parts of the core such as the F<installhtml>
program. These functions may be modified or relocated within the core
distribution -- or removed entirely therefrom -- as the core's needs evolve.
Hence, you should not rely on these functions in situations other than those
just described.
=cut
=head2 C<process_command_line()>
Process command-line switches (options). Returns a reference to a hash. Will
provide usage message if C<--help> switch is present or if parameters are
invalid.
Calling this subroutine may modify C<@ARGV>.
=cut
sub process_command_line {
my %opts = map { $_ => undef } (qw|
backlink cachedir css flush
header help htmldir htmlroot
index infile outfile poderrors
podpath podroot quiet recurse
title verbose
|);
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(\%opts,
'backlink!',
'cachedir=s',
'css=s',
'flush',
'help',
'header!',
'htmldir=s',
'htmlroot=s',
'index!',
'infile=s',
'outfile=s',
'poderrors!',
'podpath=s',
'podroot=s',
'quiet!',
'recurse!',
'title=s',
'verbose!',
);
usage("-", "invalid parameters") if not $result;
usage("-") if defined $opts{help}; # see if the user asked for help
$opts{help} = ""; # just to make -w shut-up.
return \%opts;
}
=head2 C<usage()>
Display customary Pod::Html usage information on STDERR.
=cut
sub usage {
my $podfile = shift;
warn "$0: $podfile: @_\n" if @_;
die <<END_OF_USAGE;
Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
--infile=<name> --outfile=<name>
--podpath=<name>:...:<name> --podroot=<name>
--cachedir=<name> --flush --recurse --norecurse
--quiet --noquiet --verbose --noverbose
--index --noindex --backlink --nobacklink
--header --noheader --poderrors --nopoderrors
--css=<URL> --title=<name>
--[no]backlink - turn =head1 directives into links pointing to the top of
the page (off by default).
--cachedir - directory for the directory cache files.
--css - stylesheet URL
--flush - flushes the directory cache.
--[no]header - produce block header/footer (default is no headers).
--help - prints this message.
--htmldir - directory for resulting HTML files.
--htmlroot - http-server base directory from which all relative paths
in podpath stem (default is /).
--[no]index - generate an index at the top of the resulting html
(default behaviour).
--infile - filename for the pod to convert (input taken from stdin
by default).
--outfile - filename for the resulting html file (output sent to
stdout by default).
--[no]poderrors - include a POD ERRORS section in the output if there were
any POD errors in the input (default behavior).
--podpath - colon-separated list of directories containing library
pods (empty by default).
--podroot - filesystem base directory from which all relative paths
in podpath stem (default is .).
--[no]quiet - suppress some benign warning messages (default is off).
--[no]recurse - recurse on those subdirectories listed in podpath
(default behaviour).
--title - title that will appear in resulting html file.
--[no]verbose - self-explanatory (off by default).
END_OF_USAGE
}
=head2 C<unixify()>
Ensure that F<Pod::Html>'s internals and tests handle paths consistently
across Unix, Windows and VMS.
=cut
sub unixify {
my $full_path = shift;
return '' unless $full_path;
return $full_path if $full_path eq '/';
my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
my @dirs = $dirs eq File::Spec->curdir()
? (File::Spec::Unix->curdir())
: File::Spec->splitdir($dirs);
if (defined($vol) && $vol) {
$vol =~ s/:$// if $^O eq 'VMS';
$vol = uc $vol if $^O eq 'MSWin32';
if( $dirs[0] ) {
unshift @dirs, $vol;
}
else {
$dirs[0] = $vol;
}
}
unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
return $file unless scalar(@dirs);
$full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
$file);
$full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
$full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
return $full_path;
}
=head2 C<relativize_url()>
Convert an absolute URL to one relative to a base URL.
Assumes both end in a filename.
=cut
sub relativize_url {
my ($dest, $source) = @_;
# Remove each file from its path
my ($dest_volume, $dest_directory, $dest_file) =
File::Spec::Unix->splitpath( $dest );
$dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
my ($source_volume, $source_directory, $source_file) =
File::Spec::Unix->splitpath( $source );
$source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
my $rel_path = '';
if ($dest ne '') {
$rel_path = File::Spec::Unix->abs2rel( $dest, $source );
}
if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
$rel_path .= "/$dest_file";
} else {
$rel_path .= "$dest_file";
}
return $rel_path;
}
=head2 C<html_escape()>
Make text safe for HTML.
=cut
sub html_escape {
my $rest = $_[0];
$rest =~ s/&/&amp;/g;
$rest =~ s/</&lt;/g;
$rest =~ s/>/&gt;/g;
$rest =~ s/"/&quot;/g;
$rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg;
return $rest;
}
=head2 C<htmlify()>
htmlify($heading);
Converts a pod section specification to a suitable section specification
for HTML. Note that we keep spaces and special characters except
C<", ?> (Netscape problem) and the hyphen (writer's problem...).
=cut
sub htmlify {
my( $heading) = @_;
return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
}
=head2 C<anchorify()>
anchorify(@heading);
Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
that C<anchorify()> is not exported by default.
=cut
sub anchorify {
my ($anchor) = @_;
$anchor =~ s/"/_/g; # Replace double quotes with underscores
$anchor =~ s/_$//; # ... but strip any final underscore
$anchor =~ s/[<>&']//g; # Strip the remaining HTML special characters
$anchor =~ s/^\s+//; s/\s+$//; # Strip white space.
$anchor =~ s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
$anchor =~ s/^[^a-zA-Z]+//; # First char must be a letter.
$anchor =~ s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
$anchor =~ s/[-:.]+$//; # Strip trailing punctuation.
$anchor =~ s/\W/_/g;
return $anchor;
}
=head2 C<trim_leading_whitespace()>
Remove any level of indentation (spaces or tabs) from each code block
consistently. Adapted from:
https://metacpan.org/source/HAARG/MetaCPAN-Pod-XHTML-0.002001/lib/Pod/Simple/Role/StripVerbatimIndent.pm
=cut
sub trim_leading_whitespace {
my ($para) = @_;
# Start by converting tabs to spaces
@$para = Text::Tabs::expand(@$para);
# Find the line with the least amount of indent, as that's our "base"
my @indent_levels = (sort(map { $_ =~ /^( *)./mg } @$para));
my $indent = $indent_levels[0] || "";
# Remove the "base" amount of indent from each line
foreach (@$para) {
$_ =~ s/^\Q$indent//mg;
}
return;
}
1;

2400
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Man.pm Normal file
View file

File diff suppressed because it is too large Load diff

189
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/ParseLink.pm Normal file
View file

@ -0,0 +1,189 @@
# Parse an L<> formatting code in POD text.
#
# This module implements parsing of the text of an L<> formatting code as
# defined in perlpodspec. It should be suitable for any POD formatter. It
# exports only one function, parselink(), which returns the five-item parse
# defined in perlpodspec.
#
# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
##############################################################################
# Modules and declarations
##############################################################################
package Pod::ParseLink;
use 5.010;
use strict;
use warnings;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(parselink);
our $VERSION = '5.01_02';
$VERSION =~ tr/_//d;
##############################################################################
# Implementation
##############################################################################
# Parse the name and section portion of a link into a name and section.
sub _parse_section {
my ($link) = @_;
$link =~ s/^\s+//;
$link =~ s/\s+$//;
# If the whole link is enclosed in quotes, interpret it all as a section
# even if it contains a slash.
return (undef, $1) if ($link =~ /^"\s*(.*?)\s*"$/);
# Split into page and section on slash, and then clean up quoting in the
# section. If there is no section and the name contains spaces, also
# guess that it's an old section link.
my ($page, $section) = split (/\s*\/\s*/, $link, 2);
$section =~ s/^"\s*(.*?)\s*"$/$1/ if $section;
if ($page && $page =~ / / && !defined ($section)) {
$section = $page;
$page = undef;
} else {
$page = undef unless $page;
$section = undef unless $section;
}
return ($page, $section);
}
# Infer link text from the page and section.
sub _infer_text {
my ($page, $section) = @_;
my $inferred;
if ($page && !$section) {
$inferred = $page;
} elsif (!$page && $section) {
$inferred = '"' . $section . '"';
} elsif ($page && $section) {
$inferred = '"' . $section . '" in ' . $page;
}
return $inferred;
}
# Given the contents of an L<> formatting code, parse it into the link text,
# the possibly inferred link text, the name or URL, the section, and the type
# of link (pod, man, or url).
sub parselink {
my ($link) = @_;
$link =~ s/\s+/ /g;
my $text;
if ($link =~ /\|/) {
($text, $link) = split (/\|/, $link, 2);
}
if ($link =~ /\A\w+:[^:\s]\S*\Z/) {
my $inferred;
if (defined ($text) && length ($text) > 0) {
return ($text, $text, $link, undef, 'url');
} else {
return ($text, $link, $link, undef, 'url');
}
} else {
my ($name, $section) = _parse_section ($link);
my $inferred;
if (defined ($text) && length ($text) > 0) {
$inferred = $text;
} else {
$inferred = _infer_text ($name, $section);
}
my $type = ($name && $name =~ /\(\S*\)/) ? 'man' : 'pod';
return ($text, $inferred, $name, $section, $type);
}
}
##############################################################################
# Module return value and documentation
##############################################################################
# Ensure we evaluate to true.
1;
__END__
=for stopwords
markup Allbery URL
=head1 NAME
Pod::ParseLink - Parse an LE<lt>E<gt> formatting code in POD text
=head1 SYNOPSIS
use Pod::ParseLink;
my $link = get_link();
my ($text, $inferred, $name, $section, $type) = parselink($link);
=head1 DESCRIPTION
This module only provides a single function, parselink(), which takes the
text of an LE<lt>E<gt> formatting code and parses it. It returns the
anchor text for the link (if any was given), the anchor text possibly
inferred from the name and section, the name or URL, the section if any,
and the type of link. The type will be one of C<url>, C<pod>, or C<man>,
indicating a URL, a link to a POD page, or a link to a Unix manual page.
Parsing is implemented per L<perlpodspec>. For backward compatibility,
links where there is no section and name contains spaces, or links where the
entirety of the link (except for the anchor text if given) is enclosed in
double-quotes are interpreted as links to a section (LE<lt>/sectionE<gt>).
The inferred anchor text is implemented per L<perlpodspec>:
L<name> => L<name|name>
L</section> => L<"section"|/section>
L<name/section> => L<"section" in name|name/section>
The name may contain embedded EE<lt>E<gt> and ZE<lt>E<gt> formatting codes,
and the section, anchor text, and inferred anchor text may contain any
formatting codes. Any double quotes around the section are removed as part
of the parsing, as is any leading or trailing whitespace.
If the text of the LE<lt>E<gt> escape is entirely enclosed in double
quotes, it's interpreted as a link to a section for backward
compatibility.
No attempt is made to resolve formatting codes. This must be done after
calling parselink() (since EE<lt>E<gt> formatting codes can be used to
escape characters that would otherwise be significant to the parser and
resolving them before parsing would result in an incorrect parse of a
formatting code like:
L<verticalE<verbar>barE<sol>slash>
which should be interpreted as a link to the C<vertical|bar/slash> POD page
and not as a link to the C<slash> section of the C<bar> POD page with an
anchor text of C<vertical>. Note that not only the anchor text will need to
have formatting codes expanded, but so will the target of the link (to deal
with EE<lt>E<gt> and ZE<lt>E<gt> formatting codes), and special handling of
the section may be necessary depending on whether the translator wants to
consider markup in sections to be significant when resolving links. See
L<perlpodspec> for more information.
=head1 AUTHOR
Russ Allbery <rra@cpan.org>
=head1 COPYRIGHT AND LICENSE
Copyright 2001, 2008, 2009, 2014, 2018-2019, 2022 Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<Pod::Parser>
The current version of this module is always available from its web site at
L<https://www.eyrie.org/~eagle/software/podlators/>.
=cut
# Local Variables:
# copyright-at-end-flag: t
# End:

2140
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc.pm Normal file
View file

File diff suppressed because it is too large Load diff

154
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/BaseTo.pm Normal file
View file

@ -0,0 +1,154 @@
package Pod::Perldoc::BaseTo;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '3.28';
use Carp qw(croak carp);
use Config qw(%Config);
use File::Spec::Functions qw(catfile);
sub is_pageable { '' }
sub write_with_binmode { 1 }
sub output_extension { 'txt' } # override in subclass!
# sub new { my $self = shift; ... }
# sub parse_from_file( my($class, $in, $out) = ...; ... }
#sub new { return bless {}, ref($_[0]) || $_[0] }
# this is also in Perldoc.pm, but why look there when you're a
# subclass of this?
sub TRUE () {1}
sub FALSE () {return}
BEGIN {
*is_vms = $^O eq 'VMS' ? \&TRUE : \&FALSE unless defined &is_vms;
*is_mswin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &is_mswin32;
*is_dos = $^O eq 'dos' ? \&TRUE : \&FALSE unless defined &is_dos;
*is_os2 = $^O eq 'os2' ? \&TRUE : \&FALSE unless defined &is_os2;
*is_cygwin = $^O eq 'cygwin' ? \&TRUE : \&FALSE unless defined &is_cygwin;
*is_linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &is_linux;
*is_hpux = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &is_hpux;
*is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd;
*is_freebsd = $^O =~ m/freebsd/ ? \&TRUE : \&FALSE unless defined &is_freebsd;
*is_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig;
}
sub _perldoc_elem {
my($self, $name) = splice @_,0,2;
if(@_) {
$self->{$name} = $_[0];
} else {
$self->{$name};
}
}
sub debugging {
my( $self, @messages ) = @_;
( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() )
}
sub debug {
my( $self, @messages ) = @_;
return unless $self->debugging;
print STDERR map { "DEBUG $_" } @messages;
}
sub warn {
my( $self, @messages ) = @_;
carp join "\n", @messages, '';
}
sub die {
my( $self, @messages ) = @_;
croak join "\n", @messages, '';
}
sub _get_path_components {
my( $self ) = @_;
my @paths = split /\Q$Config{path_sep}/, $ENV{PATH};
return @paths;
}
sub _find_executable_in_path {
my( $self, $program ) = @_;
my @found = ();
foreach my $dir ( $self->_get_path_components ) {
my $binary = catfile( $dir, $program );
$self->debug( "Looking for $binary\n" );
next unless -e $binary;
unless( -x $binary ) {
$self->warn( "Found $binary but it's not executable. Skipping.\n" );
next;
}
$self->debug( "Found $binary\n" );
push @found, $binary;
}
return @found;
}
1;
__END__
=head1 NAME
Pod::Perldoc::BaseTo - Base for Pod::Perldoc formatters
=head1 SYNOPSIS
package Pod::Perldoc::ToMyFormat;
use parent qw( Pod::Perldoc::BaseTo );
...
=head1 DESCRIPTION
This package is meant as a base of Pod::Perldoc formatters,
like L<Pod::Perldoc::ToText>, L<Pod::Perldoc::ToMan>, etc.
It provides default implementations for the methods
is_pageable
write_with_binmode
output_extension
_perldoc_elem
The concrete formatter must implement
new
parse_from_file
=head1 SEE ALSO
L<perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002-2007 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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

161
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/GetOptsOO.pm Normal file
View file

@ -0,0 +1,161 @@
package Pod::Perldoc::GetOptsOO;
use strict;
use vars qw($VERSION);
$VERSION = '3.28';
BEGIN { # Make a DEBUG constant ASAP
*DEBUG = defined( &Pod::Perldoc::DEBUG )
? \&Pod::Perldoc::DEBUG
: sub(){10};
}
sub getopts {
my($target, $args, $truth) = @_;
$args ||= \@ARGV;
$target->aside(
"Starting switch processing. Scanning arguments [@$args]\n"
) if $target->can('aside');
return unless @$args;
$truth = 1 unless @_ > 2;
DEBUG > 3 and print " Truth is $truth\n";
my $error_count = 0;
while( @$args and ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) {
my($first,$rest) = ($1,$2);
if ($_ eq '--') { # early exit if "--"
shift @$args;
last;
}
if ($first eq '-' and $rest) { # GNU style long param names
($first, $rest) = split '=', $rest, 2;
}
my $method = "opt_${first}_with";
if( $target->can($method) ) { # it's argumental
if($rest eq '') { # like -f bar
shift @$args;
$target->warn( "Option $first needs a following argument!\n" ) unless @$args;
$rest = shift @$args;
} else { # like -fbar (== -f bar)
shift @$args;
}
DEBUG > 3 and print " $method => $rest\n";
$target->$method( $rest );
# Otherwise, it's not argumental...
} else {
if( $target->can( $method = "opt_$first" ) ) {
DEBUG > 3 and print " $method is true ($truth)\n";
$target->$method( $truth );
# Otherwise it's an unknown option...
} elsif( $target->can('handle_unknown_option') ) {
DEBUG > 3
and print " calling handle_unknown_option('$first')\n";
$error_count += (
$target->handle_unknown_option( $first ) || 0
);
} else {
++$error_count;
$target->warn( "Unknown option: $first\n" );
}
if($rest eq '') { # like -f
shift @$args
} else { # like -fbar (== -f -bar )
DEBUG > 2 and print " Setting args->[0] to \"-$rest\"\n";
$args->[0] = "-$rest";
}
}
}
$target->aside(
"Ending switch processing. Args are [@$args] with $error_count errors.\n"
) if $target->can('aside');
$error_count == 0;
}
1;
__END__
=head1 NAME
Pod::Perldoc::GetOptsOO - Customized option parser for Pod::Perldoc
=head1 SYNOPSIS
use Pod::Perldoc::GetOptsOO ();
Pod::Perldoc::GetOptsOO::getopts( $obj, \@args, $truth )
or die "wrong usage";
=head1 DESCRIPTION
Implements a customized option parser used for
L<Pod::Perldoc>.
Rather like Getopt::Std's getopts:
=over
=item Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth)
=item Given -n, if there's a opt_n_with, it'll call $object->opt_n_with( ARGUMENT )
(e.g., "-n foo" => $object->opt_n_with('foo'). Ditto "-nfoo")
=item Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth)
(Truth defaults to 1)
=item Otherwise we try calling $object->handle_unknown_option('n')
(and we increment the error count by the return value of it)
=item If there's no handle_unknown_option, then we just warn, and then increment
the error counter
=back
The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors,
otherwise it's false.
=head1 SEE ALSO
L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002-2007 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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

96
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToANSI.pm Normal file
View file

@ -0,0 +1,96 @@
package Pod::Perldoc::ToANSI;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
$VERSION = '3.28';
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
use Pod::Text::Color ();
sub alt { shift->_perldoc_elem('alt' , @_) }
sub indent { shift->_perldoc_elem('indent' , @_) }
sub loose { shift->_perldoc_elem('loose' , @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub sentence { shift->_perldoc_elem('sentence', @_) }
sub width { shift->_perldoc_elem('width' , @_) }
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my $self = shift;
my @options =
map {; $_, $self->{$_} }
grep !m/^_/s,
keys %$self
;
defined(&Pod::Perldoc::DEBUG)
and Pod::Perldoc::DEBUG()
and print "About to call new Pod::Text::Color ",
$Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '',
"with options: ",
@options ? "[@options]" : "(nil)", "\n";
;
Pod::Text::Color->new(@options)->parse_from_file(@_);
}
1;
=head1 NAME
Pod::Perldoc::ToANSI - render Pod with ANSI color escapes
=head1 SYNOPSIS
perldoc -o ansi Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Text as a formatter class.
It supports the following options, which are explained in
L<Pod::Text>: alt, indent, loose, quotes, sentence, width
For example:
perldoc -o term -w indent:5 Some::Modulename
=head1 CAVEAT
This module may change to use a different text formatter class in the
future, and this may change what options are supported.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Text::Color>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2011 Mark Allen. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

78
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToChecker.pm Normal file
View file

@ -0,0 +1,78 @@
package Pod::Perldoc::ToChecker;
use strict;
use warnings;
use vars qw(@ISA);
use vars qw($VERSION);
$VERSION = '3.28';
# Pick our superclass...
#
eval 'require Pod::Simple::Checker';
if($@) {
require Pod::Checker;
@ISA = ('Pod::Checker');
} else {
@ISA = ('Pod::Simple::Checker');
}
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
sub if_zero_length {
my( $self, $file, $tmp, $tmpfd ) = @_;
print "No Pod errors in $file\n";
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToChecker - let Perldoc check Pod for errors
=head1 SYNOPSIS
% perldoc -o checker SomeFile.pod
No Pod errors in SomeFile.pod
(or an error report)
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Simple::Checker as a "formatter" class (or if that is
not available, then Pod::Checker), to check for errors in a given
Pod file.
This is actually a Pod::Simple::Checker (or Pod::Checker) subclass, and
inherits all its options.
=head1 SEE ALSO
L<Pod::Simple::Checker>, L<Pod::Simple>, L<Pod::Checker>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

561
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToMan.pm Normal file
View file

@ -0,0 +1,561 @@
require 5.006;
package Pod::Perldoc::ToMan;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
$VERSION = '3.28';
use File::Spec::Functions qw(catfile);
use Pod::Man 2.18;
# This class is unlike ToText.pm et al, because we're NOT paging thru
# the output in our particular format -- we make the output and
# then we run nroff (or whatever) on it, and then page thru the
# (plaintext) output of THAT!
sub SUCCESS () { 1 }
sub FAILED () { 0 }
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
sub __filter_nroff { shift->_perldoc_elem('__filter_nroff' , @_) }
sub __nroffer { shift->_perldoc_elem('__nroffer' , @_) }
sub __bindir { shift->_perldoc_elem('__bindir' , @_) }
sub __pod2man { shift->_perldoc_elem('__pod2man' , @_) }
sub __output_file { shift->_perldoc_elem('__output_file' , @_) }
sub center { shift->_perldoc_elem('center' , @_) }
sub date { shift->_perldoc_elem('date' , @_) }
sub fixed { shift->_perldoc_elem('fixed' , @_) }
sub fixedbold { shift->_perldoc_elem('fixedbold' , @_) }
sub fixeditalic { shift->_perldoc_elem('fixeditalic' , @_) }
sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) }
sub name { shift->_perldoc_elem('name' , @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub release { shift->_perldoc_elem('release' , @_) }
sub section { shift->_perldoc_elem('section' , @_) }
sub new {
my( $either ) = shift;
my $self = bless {}, ref($either) || $either;
$self->init( @_ );
return $self;
}
sub init {
my( $self, @args ) = @_;
unless( $self->__nroffer ) {
my $roffer = $self->_find_roffer( $self->_roffer_candidates );
$self->debug( "Using $roffer\n" );
$self->__nroffer( $roffer );
}
else {
$self->debug( "__nroffer is " . $self->__nroffer() . "\n" );
}
$self->_check_nroffer;
}
sub _roffer_candidates {
my( $self ) = @_;
if( $self->is_openbsd || $self->is_freebsd || $self->is_bitrig ) { qw( mandoc groff nroff ) }
else { qw( groff nroff mandoc ) }
}
sub _find_roffer {
my( $self, @candidates ) = @_;
my @found = ();
foreach my $candidate ( @candidates ) {
push @found, $self->_find_executable_in_path( $candidate );
}
return wantarray ? @found : $found[0];
}
sub _check_nroffer {
return 1;
# where is it in the PATH?
# is it executable?
# what is its real name?
# what is its version?
# does it support the flags we need?
# is it good enough for us?
}
sub _get_stty { `stty -a` }
sub _get_columns_from_stty {
my $output = $_[0]->_get_stty;
if( $output =~ /\bcolumns\s+(\d+)/ ) { return $1 }
elsif( $output =~ /;\s*(\d+)\s+columns;/ ) { return $1 }
else { return 0 }
}
sub _get_columns_from_manwidth {
my( $self ) = @_;
return 0 unless defined $ENV{MANWIDTH};
unless( $ENV{MANWIDTH} =~ m/\A\d+\z/ ) {
$self->warn( "Ignoring non-numeric MANWIDTH ($ENV{MANWIDTH})\n" );
return 0;
}
if( $ENV{MANWIDTH} == 0 ) {
$self->warn( "Ignoring MANWIDTH of 0. Really? Why even run the program? :)\n" );
return 0;
}
if( $ENV{MANWIDTH} =~ m/\A(\d+)\z/ ) { return $1 }
return 0;
}
sub _get_default_width {
73
}
sub _get_columns {
$_[0]->_get_columns_from_manwidth ||
$_[0]->_get_columns_from_stty ||
$_[0]->_get_default_width;
}
sub _get_podman_switches {
my( $self ) = @_;
my @switches = map { $_, $self->{$_} } grep !m/^_/s, keys %$self;
# There needs to be a cleaner way to handle setting
# the UTF-8 flag, but for now, comment out this
# line because it often does the wrong thing.
#
# See RT #77465
#
#push @switches, 'utf8' => 1;
$self->debug( "Pod::Man switches are [@switches]\n" );
return @switches;
}
sub _parse_with_pod_man {
my( $self, $file ) = @_;
#->output_fh and ->output_string from Pod::Simple aren't
# working, apparently, so there's this ugly hack:
local *STDOUT;
open STDOUT, '>', $self->{_text_ref};
my $parser = Pod::Man->new( $self->_get_podman_switches );
$self->debug( "Parsing $file\n" );
$parser->parse_from_file( $file );
$self->debug( "Done parsing $file\n" );
close STDOUT;
$self->die( "No output from Pod::Man!\n" )
unless length $self->{_text_ref};
$self->_save_pod_man_output if $self->debugging;
return SUCCESS;
}
sub _save_pod_man_output {
my( $self, $fh ) = @_;
$fh = do {
my $file = "podman.out.$$.txt";
$self->debug( "Writing $file with Pod::Man output\n" );
open my $fh2, '>', $file;
$fh2;
} unless $fh;
print { $fh } ${ $self->{_text_ref} };
}
sub _have_groff_with_utf8 {
my( $self ) = @_;
return 0 unless $self->_is_groff;
my $roffer = $self->__nroffer;
my $minimum_groff_version = '1.20.1';
my $version_string = `$roffer -v`;
my( $version ) = $version_string =~ /\(?groff\)? version (\d+\.\d+(?:\.\d+)?)/;
$self->debug( "Found groff $version\n" );
# is a string comparison good enough?
if( $version lt $minimum_groff_version ) {
$self->warn(
"You have an old groff." .
" Update to version $minimum_groff_version for good Unicode support.\n" .
"If you don't upgrade, wide characters may come out oddly.\n"
);
}
$version ge $minimum_groff_version;
}
sub _have_mandoc_with_utf8 {
my( $self ) = @_;
$self->_is_mandoc and not system 'mandoc -Tlocale -V > /dev/null 2>&1';
}
sub _collect_nroff_switches {
my( $self ) = shift;
my @render_switches = ('-man', $self->_get_device_switches);
# Thanks to Brendan O'Dea for contributing the following block
if( $self->_is_roff and -t STDOUT and my ($cols) = $self->_get_columns ) {
my $c = $cols * 39 / 40;
$cols = $c > $cols - 2 ? $c : $cols -2;
push @render_switches, '-rLL=' . (int $c) . 'n' if $cols > 80;
}
# I hear persistent reports that adding a -c switch to $render
# solves many people's problems. But I also hear that some mans
# don't have a -c switch, so that unconditionally adding it here
# would presumably be a Bad Thing -- sburke@cpan.org
push @render_switches, '-c' if( $self->_is_roff and $self->is_cygwin );
return @render_switches;
}
sub _get_device_switches {
my( $self ) = @_;
if( $self->_is_nroff ) { qw() }
elsif( $self->_have_groff_with_utf8 ) { qw(-Kutf8 -Tutf8) }
elsif( $self->_is_ebcdic ) { qw(-Tcp1047) }
elsif( $self->_have_mandoc_with_utf8 ) { qw(-Tlocale) }
elsif( $self->_is_mandoc ) { qw() }
else { qw(-Tlatin1) }
}
sub _is_roff {
my( $self ) = @_;
$self->_is_nroff or $self->_is_groff;
}
sub _is_nroff {
my( $self ) = @_;
$self->__nroffer =~ /\bnroff\b/;
}
sub _is_groff {
my( $self ) = @_;
$self->__nroffer =~ /\bgroff\b/;
}
sub _is_mandoc {
my ( $self ) = @_;
$self->__nroffer =~ /\bmandoc\b/;
}
sub _is_ebcdic {
my( $self ) = @_;
return 0;
}
sub _filter_through_nroff {
my( $self ) = shift;
$self->debug( "Filtering through " . $self->__nroffer() . "\n" );
# Maybe someone set rendering switches as part of the opt_n value
# Deal with that here.
my ($render, $switches) = $self->__nroffer() =~ /\A([\/a-zA-Z0-9_\.-]+)\b(.+)?\z/;
$self->die("no nroffer!?") unless $render;
my @render_switches = $self->_collect_nroff_switches;
if ( $switches ) {
# Eliminate whitespace
$switches =~ s/\s//g;
# Then separate the switches with a zero-width positive
# lookahead on the dash.
#
# See:
# http://www.effectiveperlprogramming.com/blog/1411
# for a good discussion of this technique
push @render_switches, split(/(?=-)/, $switches);
}
$self->debug( "render is $render\n" );
$self->debug( "render options are @render_switches\n" );
require Symbol;
require IPC::Open3;
require IO::Handle;
my $pid = IPC::Open3::open3(
my $writer,
my $reader,
my $err = Symbol::gensym(),
$render,
@render_switches
);
$reader->autoflush(1);
use IO::Select;
my $selector = IO::Select->new( $reader );
$self->debug( "Writing to pipe to $render\n" );
my $offset = 0;
my $chunk_size = 4096;
my $length = length( ${ $self->{_text_ref} } );
my $chunks = $length / $chunk_size;
my $done;
my $buffer;
while( $offset <= $length ) {
$self->debug( "Writing chunk $chunks\n" ); $chunks++;
syswrite $writer, ${ $self->{_text_ref} }, $chunk_size, $offset
or $self->die( $! );
$offset += $chunk_size;
$self->debug( "Checking read\n" );
READ: {
last READ unless $selector->can_read( 0.01 );
$self->debug( "Reading\n" );
my $bytes = sysread $reader, $buffer, 4096;
$self->debug( "Read $bytes bytes\n" );
$done .= $buffer;
$self->debug( sprintf "Output is %d bytes\n",
length $done
);
next READ;
}
}
close $writer;
$self->debug( "Done writing\n" );
# read any leftovers
$done .= do { local $/; <$reader> };
$self->debug( sprintf "Done reading. Output is %d bytes\n",
length $done
);
if( $? ) {
$self->warn( "Error from pipe to $render!\n" );
$self->debug( 'Error: ' . do { local $/; <$err> } );
}
close $reader;
if( my $err = $? ) {
$self->debug(
"Nonzero exit ($?) while running `$render @render_switches`.\n" .
"Falling back to Pod::Perldoc::ToPod\n"
);
return $self->_fallback_to_pod( @_ );
}
$self->debug( "Output:\n----\n$done\n----\n" );
${ $self->{_text_ref} } = $done;
return length ${ $self->{_text_ref} } ? SUCCESS : FAILED;
}
sub parse_from_file {
my( $self, $file, $outfh) = @_;
# We have a pipeline of filters each affecting the reference
# in $self->{_text_ref}
$self->{_text_ref} = \my $output;
$self->_parse_with_pod_man( $file );
# so far, nroff is an external command so we ensure it worked
my $result = $self->_filter_through_nroff;
return $self->_fallback_to_pod( @_ ) unless $result == SUCCESS;
$self->_post_nroff_processing;
print { $outfh } $output or
$self->die( "Can't print to $$self{__output_file}: $!" );
return;
}
sub _fallback_to_pod {
my( $self, @args ) = @_;
$self->warn( "Falling back to Pod because there was a problem!\n" );
require Pod::Perldoc::ToPod;
return Pod::Perldoc::ToPod->new->parse_from_file(@_);
}
# maybe there's a user setting we should check?
sub _get_tab_width { 4 }
sub _expand_tabs {
my( $self ) = @_;
my $tab_width = ' ' x $self->_get_tab_width;
${ $self->{_text_ref} } =~ s/\t/$tab_width/g;
}
sub _post_nroff_processing {
my( $self ) = @_;
if( $self->is_hpux ) {
$self->debug( "On HP-UX, I'm going to expand tabs for you\n" );
# this used to be a pipe to `col -x` for HP-UX
$self->_expand_tabs;
}
if( $self->{'__filter_nroff'} ) {
$self->debug( "filter_nroff is set, so filtering\n" );
$self->_remove_nroff_header;
$self->_remove_nroff_footer;
}
else {
$self->debug( "filter_nroff is not set, so not filtering\n" );
}
$self->_handle_unicode;
return 1;
}
# I don't think this does anything since there aren't two consecutive
# newlines in the Pod::Man output
sub _remove_nroff_header {
my( $self ) = @_;
$self->debug( "_remove_nroff_header is still a stub!\n" );
return 1;
# my @data = split /\n{2,}/, shift;
# shift @data while @data and $data[0] !~ /\S/; # Go to header
# shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
}
# I don't think this does anything since there aren't two consecutive
# newlines in the Pod::Man output
sub _remove_nroff_footer {
my( $self ) = @_;
$self->debug( "_remove_nroff_footer is still a stub!\n" );
return 1;
${ $self->{_text_ref} } =~ s/\n\n+.*\w.*\Z//m;
# my @data = split /\n{2,}/, shift;
# pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
# 28/Jan/99 perl 5.005, patch 53 1
}
sub _unicode_already_handled {
my( $self ) = @_;
$self->_have_groff_with_utf8 ||
1 # so, we don't have a case that needs _handle_unicode
;
}
sub _handle_unicode {
# this is the job of preconv
# we don't need this with groff 1.20 and later.
my( $self ) = @_;
return 1 if $self->_unicode_already_handled;
require Encode;
# it's UTF-8 here, but we need character data
my $text = Encode::decode( 'UTF-8', ${ $self->{_text_ref} } ) ;
# http://www.mail-archive.com/groff@gnu.org/msg01378.html
# http://linux.die.net/man/7/groff_char
# http://www.gnu.org/software/groff/manual/html_node/Using-Symbols.html
# http://lists.gnu.org/archive/html/groff/2011-05/msg00007.html
# http://www.simplicidade.org/notes/archives/2009/05/fixing_the_pod.html
# http://lists.freebsd.org/pipermail/freebsd-questions/2011-July/232239.html
$text =~ s/(\P{ASCII})/
sprintf '\\[u%04X]', ord $1
/eg;
# should we encode?
${ $self->{_text_ref} } = $text;
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToMan - let Perldoc render Pod as man pages
=head1 SYNOPSIS
perldoc -o man Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Man and C<groff> for reading Pod pages.
The following options are supported: center, date, fixed, fixedbold,
fixeditalic, fixedbolditalic, quotes, release, section
(Those options are explained in L<Pod::Man>.)
For example:
perldoc -o man -w center:Pod Some::Modulename
=head1 CAVEAT
This module may change to use a different pod-to-nroff formatter class
in the future, and this may change what options are supported.
=head1 SEE ALSO
L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2011 brian d foy. All rights reserved.
Copyright (c) 2002,3,4 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

105
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToNroff.pm Normal file
View file

@ -0,0 +1,105 @@
package Pod::Perldoc::ToNroff;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
$VERSION = '3.28';
# This is unlike ToMan.pm in that it emits the raw nroff source!
sub is_pageable { 1 } # well, if you ask for it...
sub write_with_binmode { 0 }
sub output_extension { 'man' }
use Pod::Man ();
sub center { shift->_perldoc_elem('center' , @_) }
sub date { shift->_perldoc_elem('date' , @_) }
sub fixed { shift->_perldoc_elem('fixed' , @_) }
sub fixedbold { shift->_perldoc_elem('fixedbold' , @_) }
sub fixeditalic { shift->_perldoc_elem('fixeditalic' , @_) }
sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub release { shift->_perldoc_elem('release' , @_) }
sub section { shift->_perldoc_elem('section' , @_) }
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my $self = shift;
my $file = $_[0];
my @options =
map {; $_, $self->{$_} }
grep !m/^_/s,
keys %$self
;
defined(&Pod::Perldoc::DEBUG)
and Pod::Perldoc::DEBUG()
and print "About to call new Pod::Man ",
$Pod::Man::VERSION ? "(v$Pod::Man::VERSION) " : '',
"with options: ",
@options ? "[@options]" : "(nil)", "\n";
;
Pod::Man->new(@options)->parse_from_file(@_);
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToNroff - let Perldoc convert Pod to nroff
=head1 SYNOPSIS
perldoc -o nroff -d something.3 Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Man as a formatter class.
The following options are supported: center, date, fixed, fixedbold,
fixeditalic, fixedbolditalic, quotes, release, section
Those options are explained in L<Pod::Man>.
For example:
perldoc -o nroff -w center:Pod -d something.3 Some::Modulename
=head1 CAVEAT
This module may change to use a different pod-to-nroff formatter class
in the future, and this may change what options are supported.
=head1 SEE ALSO
L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToMan>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

88
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToPod.pm Normal file
View file

@ -0,0 +1,88 @@
package Pod::Perldoc::ToPod;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);
use vars qw($VERSION);
$VERSION = '3.28';
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'pod' }
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my( $self, $in, $outfh ) = @_;
open(IN, "<", $in) or $self->die( "Can't read-open $in: $!\nAborting" );
my $cut_mode = 1;
# A hack for finding things between =foo and =cut, inclusive
local $_;
while (<IN>) {
if( m/^=(\w+)/s ) {
if($cut_mode = ($1 eq 'cut')) {
print $outfh "\n=cut\n\n";
# Pass thru the =cut line with some harmless
# (and occasionally helpful) padding
}
}
next if $cut_mode;
print $outfh $_ or $self->die( "Can't print to $outfh: $!" );
}
close IN or $self->die( "Can't close $in: $!" );
return;
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToPod - let Perldoc render Pod as ... Pod!
=head1 SYNOPSIS
perldoc -opod Some::Modulename
(That's currently the same as the following:)
perldoc -u Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to display Pod source as
itself! Pretty Zen, huh?
Currently this class works by just filtering out the non-Pod stuff from
a given input file.
=head1 SEE ALSO
L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallencpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

83
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToRtf.pm Normal file
View file

@ -0,0 +1,83 @@
package Pod::Perldoc::ToRtf;
use strict;
use warnings;
use parent qw( Pod::Simple::RTF );
use vars qw($VERSION);
$VERSION = '3.28';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
sub output_extension { 'rtf' }
sub page_for_perldoc {
my($self, $tempfile, $perldoc) = @_;
return unless $perldoc->IS_MSWin32;
my $rtf_pager = $ENV{'RTFREADER'} || 'write.exe';
$perldoc->aside( "About to launch <\"$rtf_pager\" \"$tempfile\">\n" );
return 1 if system( qq{"$rtf_pager"}, qq{"$tempfile"} ) == 0;
return 0;
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToRtf - let Perldoc render Pod as RTF
=head1 SYNOPSIS
perldoc -o rtf Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Simple::RTF as a formatter class.
This is actually a Pod::Simple::RTF subclass, and inherits
all its options.
You have to have Pod::Simple::RTF installed (from the Pod::Simple dist),
or this module won't work.
If Perldoc is running under MSWin and uses this class as a formatter,
the output will be opened with F<write.exe> or whatever program is
specified in the environment variable C<RTFREADER>. For example, to
specify that RTF files should be opened the same as they are when you
double-click them, you would do C<set RTFREADER=start.exe> in your
F<autoexec.bat>.
Handy tip: put C<set PERLDOC=-ortf> in your F<autoexec.bat>
and that will set this class as the default formatter to run when
you do C<perldoc whatever>.
=head1 SEE ALSO
L<Pod::Simple::RTF>, L<Pod::Simple>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

169
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToTerm.pm Normal file
View file

@ -0,0 +1,169 @@
package Pod::Perldoc::ToTerm;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '3.28';
use parent qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
use Pod::Text::Termcap ();
sub alt { shift->_perldoc_elem('alt' , @_) }
sub indent { shift->_perldoc_elem('indent' , @_) }
sub loose { shift->_perldoc_elem('loose' , @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub sentence { shift->_perldoc_elem('sentence', @_) }
sub width {
my $self = shift;
$self->_perldoc_elem('width' , @_) ||
$self->_get_columns_from_manwidth ||
$self->_get_columns_from_stty ||
$self->_get_default_width;
}
sub pager_configuration {
my($self, $pager, $perldoc) = @_;
# do not modify anything on Windows or DOS
return if ( $perldoc->is_mswin32 || $perldoc->is_dos );
if ( $pager =~ /less/ ) {
$self->_maybe_modify_environment('LESS');
}
elsif ( $pager =~ /more/ ) {
$self->_maybe_modify_environment('MORE');
}
return;
}
sub _maybe_modify_environment {
my($self, $name) = @_;
if ( ! defined $ENV{$name} ) {
$ENV{$name} = "-R";
}
# if the environment is set, don't modify
# anything
}
sub _get_stty { `stty -a` }
sub _get_columns_from_stty {
my $output = $_[0]->_get_stty;
if( $output =~ /\bcolumns\s+(\d+)/ ) { return $1; }
elsif( $output =~ /;\s*(\d+)\s+columns;/ ) { return $1; }
else { return 0 }
}
sub _get_columns_from_manwidth {
my( $self ) = @_;
return 0 unless defined $ENV{MANWIDTH};
unless( $ENV{MANWIDTH} =~ m/\A\d+\z/ ) {
$self->warn( "Ignoring non-numeric MANWIDTH ($ENV{MANWIDTH})\n" );
return 0;
}
if( $ENV{MANWIDTH} == 0 ) {
$self->warn( "Ignoring MANWIDTH of 0. Really? Why even run the program? :)\n" );
return 0;
}
if( $ENV{MANWIDTH} =~ m/\A(\d+)\z/ ) { return $1 }
return 0;
}
sub _get_default_width {
76
}
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my $self = shift;
$self->{width} = $self->width();
my @options =
map {; $_, $self->{$_} }
grep !m/^_/s,
keys %$self
;
defined(&Pod::Perldoc::DEBUG)
and Pod::Perldoc::DEBUG()
and print "About to call new Pod::Text::Termcap ",
$Pod::Text::VERSION ? "(v$Pod::Text::Termcap::VERSION) " : '',
"with options: ",
@options ? "[@options]" : "(nil)", "\n";
;
Pod::Text::Termcap->new(@options)->parse_from_file(@_);
}
1;
=head1 NAME
Pod::Perldoc::ToTerm - render Pod with terminal escapes
=head1 SYNOPSIS
perldoc -o term Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Text as a formatter class.
It supports the following options, which are explained in
L<Pod::Text>: alt, indent, loose, quotes, sentence, width
For example:
perldoc -o term -w indent:5 Some::Modulename
=head1 PAGER FORMATTING
Depending on the platform, and because this class emits terminal escapes it
will attempt to set the C<-R> flag on your pager by injecting the flag into
your environment variable for C<less> or C<more>.
On Windows and DOS, this class will not modify any environment variables.
=head1 CAVEAT
This module may change to use a different text formatter class in the
future, and this may change what options are supported.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2017 Mark Allen.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=head1 AUTHOR
Mark Allen C<< <mallen@cpan.org> >>
=cut

98
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToText.pm Normal file
View file

@ -0,0 +1,98 @@
package Pod::Perldoc::ToText;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '3.28';
use parent qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
use Pod::Text ();
sub alt { shift->_perldoc_elem('alt' , @_) }
sub indent { shift->_perldoc_elem('indent' , @_) }
sub loose { shift->_perldoc_elem('loose' , @_) }
sub quotes { shift->_perldoc_elem('quotes' , @_) }
sub sentence { shift->_perldoc_elem('sentence', @_) }
sub width { shift->_perldoc_elem('width' , @_) }
sub new { return bless {}, ref($_[0]) || $_[0] }
sub parse_from_file {
my $self = shift;
my @options =
map {; $_, $self->{$_} }
grep !m/^_/s,
keys %$self
;
defined(&Pod::Perldoc::DEBUG)
and Pod::Perldoc::DEBUG()
and print "About to call new Pod::Text ",
$Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '',
"with options: ",
@options ? "[@options]" : "(nil)", "\n";
;
Pod::Text->new(@options)->parse_from_file(@_);
}
1;
=head1 NAME
Pod::Perldoc::ToText - let Perldoc render Pod as plaintext
=head1 SYNOPSIS
perldoc -o text Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Text as a formatter class.
It supports the following options, which are explained in
L<Pod::Text>: alt, indent, loose, quotes, sentence, width
For example:
perldoc -o text -w indent:5 Some::Modulename
=head1 CAVEAT
This module may change to use a different text formatter class in the
future, and this may change what options are supported.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

154
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToTk.pm Normal file
View file

@ -0,0 +1,154 @@
package Pod::Perldoc::ToTk;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '3.28';
use parent qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' } # doesn't matter
sub if_zero_length { } # because it will be 0-length!
sub new { return bless {}, ref($_[0]) || $_[0] }
# TODO: document these and their meanings...
sub tree { shift->_perldoc_elem('tree' , @_) }
sub tk_opt { shift->_perldoc_elem('tk_opt' , @_) }
sub forky { shift->_perldoc_elem('forky' , @_) }
use Pod::Perldoc ();
use File::Spec::Functions qw(catfile);
BEGIN{ # Tk is not core, but this is
eval { require Tk } ||
__PACKAGE__->die( <<"HERE" );
You must have the Tk module to use Pod::Perldoc::ToTk.
If you have it installed, ensure it's in your Perl library
path.
HERE
__PACKAGE__->die(
__PACKAGE__,
" doesn't work nice with Tk.pm version $Tk::VERSION"
) if $Tk::VERSION eq '800.003';
}
BEGIN { eval { require Tk::FcyEntry; }; };
BEGIN{ # Tk::Pod is not core, but this is
eval { require Tk::Pod } ||
__PACKAGE__->die( <<"HERE" );
You must have the Tk::Pod module to use Pod::Perldoc::ToTk.
If you have it installed, ensure it's in your Perl library
path.
HERE
}
# The following was adapted from "tkpod" in the Tk-Pod dist.
sub parse_from_file {
my($self, $Input_File) = @_;
if($self->{'forky'}) {
return if fork; # i.e., parent process returns
}
$Input_File =~ s{\\}{/}g
if $self->is_mswin32 or $self->is_dos
# and maybe OS/2
;
my($tk_opt, $tree);
$tree = $self->{'tree' };
$tk_opt = $self->{'tk_opt'};
#require Tk::ErrorDialog;
# Add 'Tk' subdirectories to search path so, e.g.,
# 'Scrolled' will find doc in 'Tk/Scrolled'
if( $tk_opt ) {
push @INC, grep -d $_, map catfile($_,'Tk'), @INC;
}
my $mw = MainWindow->new();
#eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
$mw->withdraw;
# CDE use Font Settings if available
my $ufont = $mw->optionGet('userFont','UserFont'); # fixed width
my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional
if (defined($ufont) and defined($sfont)) {
foreach ($ufont, $sfont) { s/:$//; };
$mw->optionAdd('*Font', $sfont);
$mw->optionAdd('*Entry.Font', $ufont);
$mw->optionAdd('*Text.Font', $ufont);
}
$mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);
$mw->Pod(
'-file' => $Input_File,
(($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ())
)->focusNext;
# xxx dirty but it works. A simple $mw->destroy if $mw->children
# does not work because Tk::ErrorDialogs could be created.
# (they are withdrawn after Ok instead of destory'ed I guess)
if ($mw->children) {
$mw->repeat(1000, sub {
# ErrorDialog is withdrawn not deleted :-(
foreach ($mw->children) {
return if "$_" =~ /^Tk::Pod/ # ->isa('Tk::Pod')
}
$mw->destroy;
});
} else {
$mw->destroy;
}
#$mw->WidgetDump;
MainLoop();
exit if $self->{'forky'}; # we were the child! so exit now!
return;
}
1;
__END__
=head1 NAME
Pod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod
=head1 SYNOPSIS
perldoc -o tk Some::Modulename &
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Tk::Pod as a formatter class.
You have to have installed Tk::Pod first, or this class won't load.
=head1 SEE ALSO
L<Tk::Pod>, L<Pod::Perldoc>
=head1 AUTHOR
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>;
Sean M. Burke C<< <sburke@cpan.org> >>;
significant portions copied from
F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.
=cut

63
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Perldoc/ToXml.pm Normal file
View file

@ -0,0 +1,63 @@
package Pod::Perldoc::ToXml;
use strict;
use warnings;
use vars qw($VERSION);
use parent qw( Pod::Simple::XMLOutStream );
use vars qw($VERSION);
$VERSION = '3.28';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
sub output_extension { 'xml' }
1;
__END__
=head1 NAME
Pod::Perldoc::ToXml - let Perldoc render Pod as XML
=head1 SYNOPSIS
perldoc -o xml -d out.xml Some::Modulename
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
Pod::Simple::XMLOutStream as a formatter class.
This is actually a Pod::Simple::XMLOutStream subclass, and inherits
all its options.
You have to have installed Pod::Simple::XMLOutStream (from the Pod::Simple
dist), or this class won't work.
=head1 SEE ALSO
L<Pod::Simple::XMLOutStream>, L<Pod::Simple>, L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002 Sean M. Burke. All rights reserved.
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
Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>
=cut

1635
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple.pm Normal file
View file

File diff suppressed because it is too large Load diff

455
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple.pod Normal file
View file

@ -0,0 +1,455 @@
=head1 NAME
Pod::Simple - framework for parsing Pod
=head1 SYNOPSIS
TODO
=head1 DESCRIPTION
Pod::Simple is a Perl library for parsing text in the Pod ("plain old
documentation") markup language that is typically used for writing
documentation for Perl and for Perl modules. The Pod format is explained
in L<perlpod>; the most common formatter is called C<perldoc>.
Be sure to read L</ENCODING> if your Pod contains non-ASCII characters.
Pod formatters can use Pod::Simple to parse Pod documents and render them into
plain text, HTML, or any number of other formats. Typically, such formatters
will be subclasses of Pod::Simple, and so they will inherit its methods, like
C<parse_file>. But note that Pod::Simple doesn't understand and
properly parse Perl itself, so if you have a file which contains a Perl
program that has a multi-line quoted string which has lines that look
like pod, Pod::Simple will treat them as pod. This can be avoided if
the file makes these into indented here documents instead.
If you're reading this document just because you have a Pod-processing
subclass that you want to use, this document (plus the documentation for the
subclass) is probably all you need to read.
If you're reading this document because you want to write a formatter
subclass, continue reading it and then read L<Pod::Simple::Subclassing>, and
then possibly even read L<perlpodspec> (some of which is for parser-writers,
but much of which is notes to formatter-writers).
=head1 MAIN METHODS
=over
=item C<< $parser = I<SomeClass>->new(); >>
This returns a new parser object, where I<C<SomeClass>> is a subclass
of Pod::Simple.
=item C<< $parser->output_fh( *OUT ); >>
This sets the filehandle that C<$parser>'s output will be written to.
You can pass C<*STDOUT> or C<*STDERR>, otherwise you should probably do
something like this:
my $outfile = "output.txt";
open TXTOUT, ">$outfile" or die "Can't write to $outfile: $!";
$parser->output_fh(*TXTOUT);
...before you call one of the C<< $parser->parse_I<whatever> >> methods.
=item C<< $parser->output_string( \$somestring ); >>
This sets the string that C<$parser>'s output will be sent to,
instead of any filehandle.
=item C<< $parser->parse_file( I<$some_filename> ); >>
=item C<< $parser->parse_file( *INPUT_FH ); >>
This reads the Pod content of the file (or filehandle) that you specify,
and processes it with that C<$parser> object, according to however
C<$parser>'s class works, and according to whatever parser options you
have set up for this C<$parser> object.
=item C<< $parser->parse_string_document( I<$all_content> ); >>
This works just like C<parse_file> except that it reads the Pod
content not from a file, but from a string that you have already
in memory.
=item C<< $parser->parse_lines( I<...@lines...>, undef ); >>
This processes the lines in C<@lines> (where each list item must be a
defined value, and must contain exactly one line of content -- so no
items like C<"foo\nbar"> are allowed). The final C<undef> is used to
indicate the end of document being parsed.
The other C<parser_I<whatever>> methods are meant to be called only once
per C<$parser> object; but C<parse_lines> can be called as many times per
C<$parser> object as you want, as long as the last call (and only
the last call) ends with an C<undef> value.
=item C<< $parser->content_seen >>
This returns true only if there has been any real content seen for this
document. Returns false in cases where the document contains content,
but does not make use of any Pod markup.
=item C<< I<SomeClass>->filter( I<$filename> ); >>
=item C<< I<SomeClass>->filter( I<*INPUT_FH> ); >>
=item C<< I<SomeClass>->filter( I<\$document_content> ); >>
This is a shortcut method for creating a new parser object, setting the
output handle to STDOUT, and then processing the specified file (or
filehandle, or in-memory document). This is handy for one-liners like
this:
perl -MPod::Simple::Text -e "Pod::Simple::Text->filter('thingy.pod')"
=back
=head1 SECONDARY METHODS
Some of these methods might be of interest to general users, as
well as of interest to formatter-writers.
Note that the general pattern here is that the accessor-methods
read the attribute's value with C<< $value = $parser->I<attribute> >>
and set the attribute's value with
C<< $parser->I<attribute>(I<newvalue>) >>. For each accessor, I typically
only mention one syntax or another, based on which I think you are actually
most likely to use.
=over
=item C<< $parser->parse_characters( I<SOMEVALUE> ) >>
The Pod parser normally expects to read octets and to convert those octets
to characters based on the C<=encoding> declaration in the Pod source. Set
this option to a true value to indicate that the Pod source is already a Perl
character stream. This tells the parser to ignore any C<=encoding> command
and to skip all the code paths involving decoding octets.
=item C<< $parser->no_whining( I<SOMEVALUE> ) >>
If you set this attribute to a true value, you will suppress the
parser's complaints about irregularities in the Pod coding. By default,
this attribute's value is false, meaning that irregularities will
be reported.
Note that turning this attribute to true won't suppress one or two kinds
of complaints about rarely occurring unrecoverable errors.
=item C<< $parser->no_errata_section( I<SOMEVALUE> ) >>
If you set this attribute to a true value, you will stop the parser from
generating a "POD ERRORS" section at the end of the document. By
default, this attribute's value is false, meaning that an errata section
will be generated, as necessary.
=item C<< $parser->complain_stderr( I<SOMEVALUE> ) >>
If you set this attribute to a true value, it will send reports of
parsing errors to STDERR. By default, this attribute's value is false,
meaning that no output is sent to STDERR.
Setting C<complain_stderr> also sets C<no_errata_section>.
=item C<< $parser->source_filename >>
This returns the filename that this parser object was set to read from.
=item C<< $parser->doc_has_started >>
This returns true if C<$parser> has read from a source, and has seen
Pod content in it.
=item C<< $parser->source_dead >>
This returns true if C<$parser> has read from a source, and come to the
end of that source.
=item C<< $parser->strip_verbatim_indent( I<SOMEVALUE> ) >>
The perlpod spec for a Verbatim paragraph is "It should be reproduced
exactly...", which means that the whitespace you've used to indent your
verbatim blocks will be preserved in the output. This can be annoying for
outputs such as HTML, where that whitespace will remain in front of every
line. It's an unfortunate case where syntax is turned into semantics.
If the POD you're parsing adheres to a consistent indentation policy, you can
have such indentation stripped from the beginning of every line of your
verbatim blocks. This method tells Pod::Simple what to strip. For two-space
indents, you'd use:
$parser->strip_verbatim_indent(' ');
For tab indents, you'd use a tab character:
$parser->strip_verbatim_indent("\t");
If the POD is inconsistent about the indentation of verbatim blocks, but you
have figured out a heuristic to determine how much a particular verbatim block
is indented, you can pass a code reference instead. The code reference will be
executed with one argument, an array reference of all the lines in the
verbatim block, and should return the value to be stripped from each line. For
example, if you decide that you're fine to use the first line of the verbatim
block to set the standard for indentation of the rest of the block, you can
look at the first line and return the appropriate value, like so:
$new->strip_verbatim_indent(sub {
my $lines = shift;
(my $indent = $lines->[0]) =~ s/\S.*//;
return $indent;
});
If you'd rather treat each line individually, you can do that, too, by just
transforming them in-place in the code reference and returning C<undef>. Say
that you don't want I<any> lines indented. You can do something like this:
$new->strip_verbatim_indent(sub {
my $lines = shift;
sub { s/^\s+// for @{ $lines },
return undef;
});
=item C<< $parser->expand_verbatim_tabs( I<n> ) >>
Default: 8
If after any stripping of indentation in verbatim blocks, there remain
tabs, this method call indicates what to do with them. C<0>
means leave them as tabs, any other number indicates that each tab is to
be translated so as to have tab stops every C<n> columns.
This is independent of other methods (except that it operates after any
verbatim input stripping is done).
Like the other methods, the input parameter is not checked for validity.
C<undef> or containing non-digits has the same effect as 8.
=back
=head1 TERTIARY METHODS
=over
=item C<< $parser->abandon_output_fh() >>X<abandon_output_fh>
Cancel output to the file handle. Any POD read by the C<$parser> is not
effected.
=item C<< $parser->abandon_output_string() >>X<abandon_output_string>
Cancel output to the output string. Any POD read by the C<$parser> is not
effected.
=item C<< $parser->accept_code( @codes ) >>X<accept_code>
Alias for L<< accept_codes >>.
=item C<< $parser->accept_codes( @codes ) >>X<accept_codes>
Allows C<$parser> to accept a list of L<perlpod/Formatting Codes>. This can be
used to implement user-defined codes.
=item C<< $parser->accept_directive_as_data( @directives ) >>X<accept_directive_as_data>
Allows C<$parser> to accept a list of directives for data paragraphs. A
directive is the label of a L<perlpod/Command Paragraph>. A data paragraph is
one delimited by C<< =begin/=for/=end >> directives. This can be used to
implement user-defined directives.
=item C<< $parser->accept_directive_as_processed( @directives ) >>X<accept_directive_as_processed>
Allows C<$parser> to accept a list of directives for processed paragraphs. A
directive is the label of a L<perlpod/Command Paragraph>. A processed
paragraph is also known as L<perlpod/Ordinary Paragraph>. This can be used to
implement user-defined directives.
=item C<< $parser->accept_directive_as_verbatim( @directives ) >>X<accept_directive_as_verbatim>
Allows C<$parser> to accept a list of directives for L<perlpod/Verbatim
Paragraph>. A directive is the label of a L<perlpod/Command Paragraph>. This
can be used to implement user-defined directives.
=item C<< $parser->accept_target( @targets ) >>X<accept_target>
Alias for L<< accept_targets >>.
=item C<< $parser->accept_target_as_text( @targets ) >>X<accept_target_as_text>
Alias for L<< accept_targets_as_text >>.
=item C<< $parser->accept_targets( @targets ) >>X<accept_targets>
Accepts targets for C<< =begin/=for/=end >> sections of the POD.
=item C<< $parser->accept_targets_as_text( @targets ) >>X<accept_targets_as_text>
Accepts targets for C<< =begin/=for/=end >> sections that should be parsed as
POD. For details, see L<< perlpodspec/About Data Paragraphs >>.
=item C<< $parser->any_errata_seen() >>X<any_errata_seen>
Used to check if any errata was seen.
I<Example:>
die "too many errors\n" if $parser->any_errata_seen();
=item C<< $parser->errata_seen() >>X<errata_seen>
Returns a hash reference of all errata seen, both whines and screams. The hash reference's keys are the line number and the value is an array reference of the errors for that line.
I<Example:>
if ( $parser->any_errata_seen() ) {
$logger->log( $parser->errata_seen() );
}
=item C<< $parser->detected_encoding() >>X<detected_encoding>
Return the encoding corresponding to C<< =encoding >>, but only if the
encoding was recognized and handled.
=item C<< $parser->encoding() >>X<encoding>
Return encoding of the document, even if the encoding is not correctly
handled.
=item C<< $parser->parse_from_file( $source, $to ) >>X<parse_from_file>
Parses from C<$source> file to C<$to> file. Similar to L<<
Pod::Parser/parse_from_file >>.
=item C<< $parser->scream( @error_messages ) >>X<scream>
Log an error that can't be ignored.
=item C<< $parser->unaccept_code( @codes ) >>X<unaccept_code>
Alias for L<< unaccept_codes >>.
=item C<< $parser->unaccept_codes( @codes ) >>X<unaccept_codes>
Removes C<< @codes >> as valid codes for the parse.
=item C<< $parser->unaccept_directive( @directives ) >>X<unaccept_directive>
Alias for L<< unaccept_directives >>.
=item C<< $parser->unaccept_directives( @directives ) >>X<unaccept_directives>
Removes C<< @directives >> as valid directives for the parse.
=item C<< $parser->unaccept_target( @targets ) >>X<unaccept_target>
Alias for L<< unaccept_targets >>.
=item C<< $parser->unaccept_targets( @targets ) >>X<unaccept_targets>
Removes C<< @targets >> as valid targets for the parse.
=item C<< $parser->version_report() >>X<version_report>
Returns a string describing the version.
=item C<< $parser->whine( @error_messages ) >>X<whine>
Log an error unless C<< $parser->no_whining( TRUE ); >>.
=back
=head1 ENCODING
The Pod::Simple parser expects to read B<octets>. The parser will decode the
octets into Perl's internal character string representation using the value of
the C<=encoding> declaration in the POD source.
If the POD source does not include an C<=encoding> declaration, the parser will
attempt to guess the encoding (selecting one of UTF-8 or CP 1252) by examining
the first non-ASCII bytes and applying the heuristic described in
L<perlpodspec>. (If the POD source contains only ASCII bytes, the
encoding is assumed to be ASCII.)
If you set the C<parse_characters> option to a true value the parser will
expect characters rather than octets; will ignore any C<=encoding>; and will
make no attempt to decode the input.
=head1 SEE ALSO
L<Pod::Simple::Subclassing>
L<perlpod|perlpod>
L<perlpodspec|perlpodspec>
L<Pod::Escapes|Pod::Escapes>
L<perldoc>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Please use L<https://github.com/perl-pod/pod-simple/issues/new> to file a bug
report.
=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>
=item * Karl Williamson C<khw@cpan.org>
=back
Documentation has been contributed by:
=over
=item * Gabor Szabo C<szabgab@gmail.com>
=item * Shawn H Corey C<SHCOREY at cpan.org>
=back
=cut

2437
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/BlackBox.pm Normal file
View file

File diff suppressed because it is too large Load diff

195
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Checker.pm Normal file
View file

@ -0,0 +1,195 @@
# A quite dimwitted pod2plaintext that need only know how to format whatever
# text comes out of Pod::BlackBox's _gen_errata
package Pod::Simple::Checker;
use strict;
use warnings;
use Carp ();
use Pod::Simple::Methody ();
use Pod::Simple ();
our $VERSION = '3.45';
our @ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
: sub() {0}
}
use Text::Wrap 98.112902 (); # was 2001.0131, but I don't think we need that
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub any_errata_seen { # read-only accessor
return $_[1]->{'Errata_seen'};
}
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->nix_X_codes(1);
$new->nbsp_for_S(1);
$new->{'Thispara'} = '';
$new->{'Indent'} = 0;
$new->{'Indentstring'} = ' ';
$new->{'Errata_seen'} = 0;
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub handle_text { $_[0]{'Errata_seen'} and $_[0]{'Thispara'} .= $_[1] }
sub start_Para { $_[0]{'Thispara'} = '' }
sub start_head1 {
if($_[0]{'Errata_seen'}) {
$_[0]{'Thispara'} = '';
} else {
if($_[1]{'errata'}) { # start of errata!
$_[0]{'Errata_seen'} = 1;
$_[0]{'Thispara'} = $_[0]{'source_filename'} ?
"$_[0]{'source_filename'} -- " : ''
}
}
}
sub start_head2 { $_[0]{'Thispara'} = '' }
sub start_head3 { $_[0]{'Thispara'} = '' }
sub start_head4 { $_[0]{'Thispara'} = '' }
sub start_Verbatim { $_[0]{'Thispara'} = '' }
sub start_item_bullet { $_[0]{'Thispara'} = '* ' }
sub start_item_number { $_[0]{'Thispara'} = "$_[1]{'number'}. " }
sub start_item_text { $_[0]{'Thispara'} = '' }
sub start_over_bullet { ++$_[0]{'Indent'} }
sub start_over_number { ++$_[0]{'Indent'} }
sub start_over_text { ++$_[0]{'Indent'} }
sub start_over_block { ++$_[0]{'Indent'} }
sub end_over_bullet { --$_[0]{'Indent'} }
sub end_over_number { --$_[0]{'Indent'} }
sub end_over_text { --$_[0]{'Indent'} }
sub end_over_block { --$_[0]{'Indent'} }
# . . . . . Now the actual formatters:
sub end_head1 { $_[0]->emit_par(-4) }
sub end_head2 { $_[0]->emit_par(-3) }
sub end_head3 { $_[0]->emit_par(-2) }
sub end_head4 { $_[0]->emit_par(-1) }
sub end_Para { $_[0]->emit_par( 0) }
sub end_item_bullet { $_[0]->emit_par( 0) }
sub end_item_number { $_[0]->emit_par( 0) }
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);
# 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;
local $Text::Wrap::wrap = 'overflow';
my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n");
$out =~ s/$Pod::Simple::nbsp/ /g;
print {$self->{'output_fh'}} $out,
#"\n"
;
$self->{'Thispara'} = '';
return;
}
# . . . . . . . . . . And then off by its lonesome:
sub end_Verbatim {
return unless $_[0]{'Errata_seen'};
my $self = shift;
$self->{'Thispara'} =~ s/$Pod::Simple::nbsp/ /g;
$self->{'Thispara'} =~ s/$Pod::Simple::shy//g;
my $i = ' ' x ( 2 * $self->{'Indent'} + 4);
$self->{'Thispara'} =~ s/^/$i/mg;
print { $self->{'output_fh'} } '',
$self->{'Thispara'},
"\n\n"
;
$self->{'Thispara'} = '';
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::Checker -- check the Pod syntax of a document
=head1 SYNOPSIS
perl -MPod::Simple::Checker -e \
"exit Pod::Simple::Checker->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
This class is for checking the syntactic validity of Pod.
It works by basically acting like a simple-minded version of
L<Pod::Simple::Text> that formats only the "Pod Errors" section
(if Pod::Simple even generates one for the given document).
This is a subclass of L<Pod::Simple> and inherits all its methods.
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Checker>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

176
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Debug.pm Normal file
View file

@ -0,0 +1,176 @@
package Pod::Simple::Debug;
use strict;
our $VERSION = '3.45';
sub import {
my($value,$variable);
if(@_ == 2) {
$value = $_[1];
} elsif(@_ == 3) {
($variable, $value) = @_[1,2];
($variable, $value) = ($value, $variable)
if defined $value and ref($value) eq 'SCALAR'
and not(defined $variable and ref($variable) eq 'SCALAR')
; # tolerate getting it backwards
unless( defined $variable and ref($variable) eq 'SCALAR') {
require Carp;
Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
. "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
}
} else {
require Carp;
Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
. "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
}
if( defined &Pod::Simple::DEBUG ) {
require Carp;
Carp::croak("It's too late to call Pod::Simple::Debug -- "
. "Pod::Simple has already loaded\nAborting");
}
$value = 0 unless defined $value;
unless($value =~ m/^-?\d+$/) {
require Carp;
Carp::croak( "$value isn't a numeric value."
. "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor"
. "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
}
if( defined $variable ) {
# make a not-really-constant
*Pod::Simple::DEBUG = sub () { $$variable } ;
$$variable = $value;
print STDERR "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n";
} else {
*Pod::Simple::DEBUG = eval " sub () { $value } ";
print STDERR "# Starting Pod::Simple::DEBUG = $value\n";
}
require Pod::Simple;
return;
}
1;
__END__
=head1 NAME
Pod::Simple::Debug -- put Pod::Simple into trace/debug mode
=head1 SYNOPSIS
use Pod::Simple::Debug (5); # or some integer
Or:
my $debuglevel;
use Pod::Simple::Debug (\$debuglevel, 0);
...some stuff that uses Pod::Simple to do stuff, but which
you don't want debug output from...
$debug_level = 4;
...some stuff that uses Pod::Simple to do stuff, but which
you DO want debug output from...
$debug_level = 0;
=head1 DESCRIPTION
This is an internal module for controlling the debug level (a.k.a. trace
level) of Pod::Simple. This is of interest only to Pod::Simple
developers.
=head1 CAVEATS
Note that you should load this module I<before> loading Pod::Simple (or
any Pod::Simple-based class). If you try loading Pod::Simple::Debug
after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will
throw a fatal error to the effect that
"It's too late to call Pod::Simple::Debug".
Note that the C<use Pod::Simple::Debug (\$x, I<somenum>)> mode will make
Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't
be a constant sub anymore, and so Pod::Simple (et al) won't compile with
constant-folding.
=head1 GUTS
Doing this:
use Pod::Simple::Debug (5); # or some integer
is basically equivalent to:
BEGIN { sub Pod::Simple::DEBUG () {5} } # or some integer
use Pod::Simple ();
And this:
use Pod::Simple::Debug (\$debug_level,0); # or some integer
is basically equivalent to this:
my $debug_level;
BEGIN { $debug_level = 0 }
BEGIN { sub Pod::Simple::DEBUG () { $debug_level }
use Pod::Simple ();
=head1 SEE ALSO
L<Pod::Simple>
The article "Constants in Perl", in I<The Perl Journal> issue
21. See L<http://interglacial.com/tpj/21/>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut
use warnings;

154
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/DumpAsText.pm Normal file
View file

@ -0,0 +1,154 @@
package Pod::Simple::DumpAsText;
use strict;
our $VERSION = '3.45';
use Pod::Simple ();
BEGIN { our @ISA = ('Pod::Simple')}
use Carp ();
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->accept_codes('VerbatimFormatted');
$new->keep_encoding_directive(1);
return $new;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub _handle_element_start {
# ($self, $element_name, $attr_hash_r)
my $fh = $_[0]{'output_fh'};
my($key, $value);
DEBUG and print STDERR "++ $_[1]\n";
print $fh ' ' x ($_[0]{'indent'} || 0), "++", $_[1], "\n";
$_[0]{'indent'}++;
while(($key,$value) = each %{$_[2]}) {
unless($key =~ m/^~/s) {
next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
_perly_escape($key);
_perly_escape($value);
printf $fh qq{%s \\ "%s" => "%s"\n},
' ' x ($_[0]{'indent'} || 0), $key, $value;
}
}
return;
}
sub _handle_text {
DEBUG and print STDERR "== \"$_[1]\"\n";
if(length $_[1]) {
my $indent = ' ' x $_[0]{'indent'};
my $text = $_[1];
_perly_escape($text);
$text =~ # A not-totally-brilliant wrapping algorithm:
s/(
[^\n]{55} # Snare some characters from a line
[^\n\ ]{0,50} # and finish any current word
)
\ {1,10}(?!\n) # capture some spaces not at line-end
/$1"\n$indent . "/gx # => line-break here
;
print {$_[0]{'output_fh'}} $indent, '* "', $text, "\"\n";
}
return;
}
sub _handle_element_end {
DEBUG and print STDERR "-- $_[1]\n";
print {$_[0]{'output_fh'}}
' ' x --$_[0]{'indent'}, "--", $_[1], "\n";
return;
}
# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
sub _perly_escape {
foreach my $x (@_) {
$x =~ s/([^\x00-\xFF])/sprintf'\x{%X}',ord($1)/eg;
# Escape things very cautiously:
$x =~ s/([^-\n\t \&\<\>\'!\#\%\(\)\*\+,\.\/\:\;=\?\~\[\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf'\x%02X',ord($1)/eg;
}
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::DumpAsText -- dump Pod-parsing events as text
=head1 SYNOPSIS
perl -MPod::Simple::DumpAsText -e \
"exit Pod::Simple::DumpAsText->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
This class is for dumping, as text, the events gotten from parsing a Pod
document. This class is of interest to people writing Pod formatters
based on Pod::Simple. It is useful for seeing exactly what events you
get out of some Pod that you feed in.
This is a subclass of L<Pod::Simple> and inherits all its methods.
=head1 SEE ALSO
L<Pod::Simple::DumpAsXML>
L<Pod::Simple>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut
use warnings;

165
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/DumpAsXML.pm Normal file
View file

@ -0,0 +1,165 @@
package Pod::Simple::DumpAsXML;
use strict;
our $VERSION = '3.45';
use Pod::Simple ();
BEGIN {our @ISA = ('Pod::Simple')}
use Carp ();
use Text::Wrap qw(wrap);
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->accept_codes('VerbatimFormatted');
$new->keep_encoding_directive(1);
return $new;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub _handle_element_start {
# ($self, $element_name, $attr_hash_r)
my $fh = $_[0]{'output_fh'};
my($key, $value);
DEBUG and print STDERR "++ $_[1]\n";
print $fh ' ' x ($_[0]{'indent'} || 0), "<", $_[1];
foreach my $key (sort keys %{$_[2]}) {
unless($key =~ m/^~/s) {
next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
_xml_escape($value = $_[2]{$key});
print $fh ' ', $key, '="', $value, '"';
}
}
print $fh ">\n";
$_[0]{'indent'}++;
return;
}
sub _handle_text {
DEBUG and print STDERR "== \"$_[1]\"\n";
if(length $_[1]) {
my $indent = ' ' x $_[0]{'indent'};
my $text = $_[1];
_xml_escape($text);
local $Text::Wrap::huge = 'overflow';
$text = wrap('', $indent, $text);
print {$_[0]{'output_fh'}} $indent, $text, "\n";
}
return;
}
sub _handle_element_end {
DEBUG and print STDERR "-- $_[1]\n";
print {$_[0]{'output_fh'}}
' ' x --$_[0]{'indent'}, "</", $_[1], ">\n";
return;
}
# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
sub _xml_escape {
foreach my $x (@_) {
# Escape things very cautiously:
if ($] ge 5.007_003) {
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
} else { # Is broken for non-ASCII platforms on early perls
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
}
# Yes, stipulate the list without a range, so that this can work right on
# all charsets that this module happens to run under.
}
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::DumpAsXML -- turn Pod into XML
=head1 SYNOPSIS
perl -MPod::Simple::DumpAsXML -e \
"exit Pod::Simple::DumpAsXML->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
Pod::Simple::DumpAsXML is a subclass of L<Pod::Simple> that parses Pod
and turns it into indented and wrapped XML. This class is of
interest to people writing Pod formatters based on Pod::Simple.
Pod::Simple::DumpAsXML inherits methods from
L<Pod::Simple>.
=head1 SEE ALSO
L<Pod::Simple::XMLOutStream> is rather like this class.
Pod::Simple::XMLOutStream's output is space-padded in a way
that's better for sending to an XML processor (that is, it has
no ignorable whitespace). But
Pod::Simple::DumpAsXML's output is much more human-readable, being
(more-or-less) one token per line, with line-wrapping.
L<Pod::Simple::DumpAsText> is rather like this class,
except that it doesn't dump with XML syntax. Try them and see
which one you like best!
L<Pod::Simple>, L<Pod::Simple::DumpAsXML>
The older libraries L<Pod::PXML>, L<Pod::XML>, L<Pod::SAX>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut
use warnings;

1163
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/HTML.pm Normal file
View file

File diff suppressed because it is too large Load diff

1363
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/HTMLBatch.pm Normal file
View file

File diff suppressed because it is too large Load diff

102
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/HTMLLegacy.pm Normal file
View file

@ -0,0 +1,102 @@
package Pod::Simple::HTMLLegacy;
use strict;
use warnings;
use Getopt::Long;
our $VERSION = "5.02";
#--------------------------------------------------------------------------
#
# This class is meant to thinly emulate bad old Pod::Html
#
# TODO: some basic docs
sub pod2html {
my @args = (@_);
my( $verbose, $infile, $outfile, $title );
my $index = 1;
{
my($help);
my($netscape); # dummy
local @ARGV = @args;
GetOptions(
"help" => \$help,
"verbose!" => \$verbose,
"infile=s" => \$infile,
"outfile=s" => \$outfile,
"title=s" => \$title,
"index!" => \$index,
"netscape!" => \$netscape,
) or return bad_opts(@args);
bad_opts(@args) if @ARGV; # it should be all switches!
return help_message() if $help;
}
for($infile, $outfile) { $_ = undef unless defined and length }
if($verbose) {
warn sprintf "%s version %s\n", __PACKAGE__, $VERSION;
warn "OK, processed args [@args] ...\n";
warn sprintf
" Verbose: %s\n Index: %s\n Infile: %s\n Outfile: %s\n Title: %s\n",
map defined($_) ? $_ : "(nil)",
$verbose, $index, $infile, $outfile, $title,
;
*Pod::Simple::HTML::DEBUG = sub(){1};
}
require Pod::Simple::HTML;
Pod::Simple::HTML->VERSION(3);
die "No such input file as $infile\n"
if defined $infile and ! -e $infile;
my $pod = Pod::Simple::HTML->new;
$pod->force_title($title) if defined $title;
$pod->index($index);
return $pod->parse_from_file($infile, $outfile);
}
#--------------------------------------------------------------------------
sub bad_opts { die _help_message(); }
sub help_message { print STDOUT _help_message() }
#--------------------------------------------------------------------------
sub _help_message {
join '',
"[", __PACKAGE__, " version ", $VERSION, qq~]
Usage: pod2html --help --infile=<name> --outfile=<name>
--verbose --index --noindex
Options:
--help - prints this message.
--[no]index - generate an index at the top of the resulting html
(default behavior).
--infile - filename for the pod to convert (input taken from stdin
by default).
--outfile - filename for the resulting html file (output sent to
stdout by default).
--title - title that will appear in resulting html file.
--[no]verbose - self-explanatory (off by default).
Note that pod2html is DEPRECATED, and this version implements only
some of the options known to older versions.
For more information, see 'perldoc pod2html'.
~;
}
1;
__END__
OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!!

365
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/JustPod.pm Normal file
View file

@ -0,0 +1,365 @@
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_head5 { shift->_generic_start('=head5', @_); }
sub start_head6 { shift->_generic_start('=head6', @_); }
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_head5 = *_end_generic;
*end_head6 = *_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<https://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

170
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/LinkSection.pm Normal file
View file

@ -0,0 +1,170 @@
package Pod::Simple::LinkSection;
# Based somewhat dimly on Array::Autojoin
use strict;
use warnings;
use Pod::Simple::BlackBox;
our $VERSION = '3.45';
use overload( # So it'll stringify nice
'""' => \&Pod::Simple::BlackBox::stringify_lol,
'bool' => \&Pod::Simple::BlackBox::stringify_lol,
# '.=' => \&tack_on, # grudgingly support
'fallback' => 1, # turn on cleverness
);
sub tack_on {
$_[0] = ['', {}, "$_[0]" ];
return $_[0][2] .= $_[1];
}
sub as_string {
goto &Pod::Simple::BlackBox::stringify_lol;
}
sub stringify {
goto &Pod::Simple::BlackBox::stringify_lol;
}
sub new {
my $class = shift;
$class = ref($class) || $class;
my $new;
if(@_ == 1) {
if (!ref($_[0] || '')) { # most common case: one bare string
return bless ['', {}, $_[0] ], $class;
} elsif( ref($_[0] || '') eq 'ARRAY') {
$new = [ @{ $_[0] } ];
} else {
Carp::croak( "$class new() doesn't know to clone $new" );
}
} else { # misc stuff
$new = [ '', {}, @_ ];
}
# By now it's a treelet: [ 'foo', {}, ... ]
foreach my $x (@$new) {
if(ref($x || '') eq 'ARRAY') {
$x = $class->new($x); # recurse
} elsif(ref($x || '') eq 'HASH') {
$x = { %$x };
}
# otherwise leave it.
}
return bless $new, $class;
}
# Not much in this class is likely to be link-section specific --
# but it just so happens that link-sections are about the only treelets
# that are exposed to the user.
1;
__END__
# TODO: let it be an option whether a given subclass even wants little treelets?
__END__
=head1 NAME
Pod::Simple::LinkSection -- represent "section" attributes of L codes
=head1 SYNOPSIS
# a long story
=head1 DESCRIPTION
This class is not of interest to general users.
Pod::Simple uses this class for representing the value of the
"section" attribute of "L" start-element events. Most applications
can just use the normal stringification of objects of this class;
they stringify to just the text content of the section,
such as "foo" for
C<< LZ<><Stuff/foo> >>, and "bar" for
C<< LZ<><Stuff/bIZ<><ar>> >>.
However, anyone particularly interested in getting the full value of
the treelet, can just traverse the content of the treeleet
@$treelet_object. To wit:
% perl -MData::Dumper -e
"use base qw(Pod::Simple::Methody);
sub start_L { print Dumper($_[1]{'section'} ) }
__PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>')
"
Output:
$VAR1 = bless( [
'',
{},
'b',
bless( [
'I',
{},
'ar'
], 'Pod::Simple::LinkSection' ),
'baz'
], 'Pod::Simple::LinkSection' );
But stringify it and you get just the text content:
% perl -MData::Dumper -e
"use base qw(Pod::Simple::Methody);
sub start_L { print Dumper( '' . $_[1]{'section'} ) }
__PACKAGE__->new->parse_string_document('=head1 L<Foo/bI<ar>baz>>')
"
Output:
$VAR1 = 'barbaz';
=head1 SEE ALSO
L<Pod::Simple>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<bug-pod-simple@rt.cpan.org>.
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2004 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
=cut

150
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Methody.pm Normal file
View file

@ -0,0 +1,150 @@
package Pod::Simple::Methody;
use strict;
use warnings;
use Pod::Simple ();
our $VERSION = '3.45';
our @ISA = ('Pod::Simple');
# Yes, we could use named variables, but I want this to be impose
# as little an additional performance hit as possible.
sub _handle_element_start {
$_[1] =~ tr/-:./__/;
( $_[0]->can( 'start_' . $_[1] )
|| return
)->(
$_[0], $_[2]
);
}
sub _handle_text {
( $_[0]->can( 'handle_text' )
|| return
)->(
@_
);
}
sub _handle_element_end {
$_[1] =~ tr/-:./__/;
( $_[0]->can( 'end_' . $_[1] )
|| return
)->(
$_[0], $_[2]
);
}
1;
__END__
=head1 NAME
Pod::Simple::Methody -- turn Pod::Simple events into method calls
=head1 SYNOPSIS
require 5;
use strict;
package SomePodFormatter;
use base qw(Pod::Simple::Methody);
sub handle_text {
my($self, $text) = @_;
...
}
sub start_head1 {
my($self, $attrs) = @_;
...
}
sub end_head1 {
my($self) = @_;
...
}
...and start_/end_ methods for whatever other events you want to catch.
=head1 DESCRIPTION
This class is of
interest to people writing Pod formatters based on Pod::Simple.
This class (which is very small -- read the source) overrides
Pod::Simple's _handle_element_start, _handle_text, and
_handle_element_end methods so that parser events are turned into method
calls. (Otherwise, this is a subclass of L<Pod::Simple> and inherits all
its methods.)
You can use this class as the base class for a Pod formatter/processor.
=head1 METHOD CALLING
When Pod::Simple sees a "=head1 Hi there", for example, it basically does
this:
$parser->_handle_element_start( "head1", \%attributes );
$parser->_handle_text( "Hi there" );
$parser->_handle_element_end( "head1" );
But if you subclass Pod::Simple::Methody, it will instead do this
when it sees a "=head1 Hi there":
$parser->start_head1( \%attributes ) if $parser->can('start_head1');
$parser->handle_text( "Hi there" ) if $parser->can('handle_text');
$parser->end_head1() if $parser->can('end_head1');
If Pod::Simple sends an event where the element name has a dash,
period, or colon, the corresponding method name will have a underscore
in its place. For example, "foo.bar:baz" becomes start_foo_bar_baz
and end_foo_bar_baz.
See the source for Pod::Simple::Text for an example of using this class.
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::Subclassing>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

93
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Progress.pm Normal file
View file

@ -0,0 +1,93 @@
package Pod::Simple::Progress;
use strict;
use warnings;
our $VERSION = '3.45';
# Objects of this class are used for noting progress of an
# operation every so often. Messages delivered more often than that
# are suppressed.
#
# There's actually nothing in here that's specific to Pod processing;
# but it's ad-hoc enough that I'm not willing to give it a name that
# implies that it's generally useful, like "IO::Progress" or something.
#
# -- sburke
#
#--------------------------------------------------------------------------
sub new {
my($class,$delay) = @_;
my $self = bless {'quiet_until' => 1}, ref($class) || $class;
$self->to(*STDOUT{IO});
$self->delay(defined($delay) ? $delay : 5);
return $self;
}
sub copy {
my $orig = shift;
bless {%$orig, 'quiet_until' => 1}, ref($orig);
}
#--------------------------------------------------------------------------
sub reach {
my($self, $point, $note) = @_;
if( (my $now = time) >= $self->{'quiet_until'}) {
my $goal;
my $to = $self->{'to'};
print $to join('',
($self->{'quiet_until'} == 1) ? () : '... ',
(defined $point) ? (
'#',
($goal = $self->{'goal'}) ? (
' ' x (length($goal) - length($point)),
$point, '/', $goal,
) : $point,
$note ? ': ' : (),
) : (),
$note || '',
"\n"
);
$self->{'quiet_until'} = $now + $self->{'delay'};
}
return $self;
}
#--------------------------------------------------------------------------
sub done {
my($self, $note) = @_;
$self->{'quiet_until'} = 1;
return $self->reach( undef, $note );
}
#--------------------------------------------------------------------------
# Simple accessors:
sub delay {
return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
sub goal {
return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
sub to {
return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] }
#--------------------------------------------------------------------------
unless(caller) { # Simple self-test:
my $p = __PACKAGE__->new->goal(5);
$p->reach(1, "Primus!");
sleep 1;
$p->reach(2, "Secundus!");
sleep 3;
$p->reach(3, "Tertius!");
sleep 5;
$p->reach(4);
$p->reach(5, "Quintus!");
sleep 1;
$p->done("All done");
}
#--------------------------------------------------------------------------
1;
__END__

852
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/PullParser.pm Normal file
View file

@ -0,0 +1,852 @@
package Pod::Simple::PullParser;
use strict;
our $VERSION = '3.45';
use Pod::Simple ();
BEGIN {our @ISA = ('Pod::Simple')}
use Carp ();
use Pod::Simple::PullParserStartToken;
use Pod::Simple::PullParserEndToken;
use Pod::Simple::PullParserTextToken;
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
__PACKAGE__->_accessorize(
'source_fh', # the filehandle we're reading from
'source_scalar_ref', # the scalarref we're reading from
'source_arrayref', # the arrayref we're reading from
);
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
#
# And here is how we implement a pull-parser on top of a push-parser...
sub filter {
my($self, $source) = @_;
$self = $self->new unless ref $self;
$source = *STDIN{IO} unless defined $source;
$self->set_source($source);
$self->output_fh(*STDOUT{IO});
$self->run; # define run() in a subclass if you want to use filter()!
return $self;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub parse_string_document {
my $this = shift;
$this->set_source(\ $_[0]);
$this->run;
}
sub parse_file {
my($this, $filename) = @_;
$this->set_source($filename);
$this->run;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# In case anyone tries to use them:
sub run {
use Carp ();
if( __PACKAGE__ eq (ref($_[0]) || $_[0])) { # I'm not being subclassed!
Carp::croak "You can call run() only on subclasses of "
. __PACKAGE__;
} else {
Carp::croak join '',
"You can't call run() because ",
ref($_[0]) || $_[0], " didn't define a run() method";
}
}
sub parse_lines {
use Carp ();
Carp::croak "Use set_source with ", __PACKAGE__,
" and subclasses, not parse_lines";
}
sub parse_line {
use Carp ();
Carp::croak "Use set_source with ", __PACKAGE__,
" and subclasses, not parse_line";
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
die "Couldn't construct for $class" unless $self;
$self->{'token_buffer'} ||= [];
$self->{'start_token_class'} ||= 'Pod::Simple::PullParserStartToken';
$self->{'text_token_class'} ||= 'Pod::Simple::PullParserTextToken';
$self->{'end_token_class'} ||= 'Pod::Simple::PullParserEndToken';
DEBUG > 1 and print STDERR "New pullparser object: $self\n";
return $self;
}
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
sub get_token {
my $self = shift;
DEBUG > 1 and print STDERR "\nget_token starting up on $self.\n";
DEBUG > 2 and print STDERR " Items in token-buffer (",
scalar( @{ $self->{'token_buffer'} } ) ,
") :\n", map(
" " . $_->dump . "\n", @{ $self->{'token_buffer'} }
),
@{ $self->{'token_buffer'} } ? '' : ' (no tokens)',
"\n"
;
until( @{ $self->{'token_buffer'} } ) {
DEBUG > 3 and print STDERR "I need to get something into my empty token buffer...\n";
if($self->{'source_dead'}) {
DEBUG and print STDERR "$self 's source is dead.\n";
push @{ $self->{'token_buffer'} }, undef;
} elsif(exists $self->{'source_fh'}) {
my @lines;
my $fh = $self->{'source_fh'}
|| Carp::croak('You have to call set_source before you can call get_token');
DEBUG and print STDERR "$self 's source is filehandle $fh.\n";
# Read those many lines at a time
for(my $i = Pod::Simple::MANY_LINES; $i--;) {
DEBUG > 3 and print STDERR " Fetching a line from source filehandle $fh...\n";
local $/ = $Pod::Simple::NL;
push @lines, scalar(<$fh>); # readline
DEBUG > 3 and print STDERR " Line is: ",
defined($lines[-1]) ? $lines[-1] : "<undef>\n";
unless( defined $lines[-1] ) {
DEBUG and print STDERR "That's it for that source fh! Killing.\n";
delete $self->{'source_fh'}; # so it can be GC'd
last;
}
# but pass thru the undef, which will set source_dead to true
# TODO: look to see if $lines[-1] is =encoding, and if so,
# do horribly magic things
}
if(DEBUG > 8) {
print STDERR "* I've gotten ", scalar(@lines), " lines:\n";
foreach my $l (@lines) {
if(defined $l) {
print STDERR " line {$l}\n";
} else {
print STDERR " line undef\n";
}
}
print STDERR "* end of ", scalar(@lines), " lines\n";
}
$self->SUPER::parse_lines(@lines);
} elsif(exists $self->{'source_arrayref'}) {
DEBUG and print STDERR "$self 's source is arrayref $self->{'source_arrayref'}, with ",
scalar(@{$self->{'source_arrayref'}}), " items left in it.\n";
DEBUG > 3 and print STDERR " Fetching ", Pod::Simple::MANY_LINES, " lines.\n";
$self->SUPER::parse_lines(
splice @{ $self->{'source_arrayref'} },
0,
Pod::Simple::MANY_LINES
);
unless( @{ $self->{'source_arrayref'} } ) {
DEBUG and print STDERR "That's it for that source arrayref! Killing.\n";
$self->SUPER::parse_lines(undef);
delete $self->{'source_arrayref'}; # so it can be GC'd
}
# to make sure that an undef is always sent to signal end-of-stream
} elsif(exists $self->{'source_scalar_ref'}) {
DEBUG and print STDERR "$self 's source is scalarref $self->{'source_scalar_ref'}, with ",
length(${ $self->{'source_scalar_ref'} }) -
(pos(${ $self->{'source_scalar_ref'} }) || 0),
" characters left to parse.\n";
DEBUG > 3 and print STDERR " Fetching a line from source-string...\n";
if( ${ $self->{'source_scalar_ref'} } =~
m/([^\n\r]*)((?:\r?\n)?)/g
) {
#print(">> $1\n"),
$self->SUPER::parse_lines($1)
if length($1) or length($2)
or pos( ${ $self->{'source_scalar_ref'} })
!= length( ${ $self->{'source_scalar_ref'} });
# I.e., unless it's a zero-length "empty line" at the very
# end of "foo\nbar\n" (i.e., between the \n and the EOS).
} else { # that's the end. Byebye
$self->SUPER::parse_lines(undef);
delete $self->{'source_scalar_ref'};
DEBUG and print STDERR "That's it for that source scalarref! Killing.\n";
}
} else {
die "What source??";
}
}
DEBUG and print STDERR "get_token about to return ",
Pod::Simple::pretty( @{$self->{'token_buffer'}}
? $self->{'token_buffer'}[-1] : undef
), "\n";
return shift @{$self->{'token_buffer'}}; # that's an undef if empty
}
sub unget_token {
my $self = shift;
DEBUG and print STDERR "Ungetting ", scalar(@_), " tokens: ",
@_ ? "@_\n" : "().\n";
foreach my $t (@_) {
Carp::croak "Can't unget that, because it's not a token -- it's undef!"
unless defined $t;
Carp::croak "Can't unget $t, because it's not a token -- it's a string!"
unless ref $t;
Carp::croak "Can't unget $t, because it's not a token object!"
unless UNIVERSAL::can($t, 'type');
}
unshift @{$self->{'token_buffer'}}, @_;
DEBUG > 1 and print STDERR "Token buffer now has ",
scalar(@{$self->{'token_buffer'}}), " items in it.\n";
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# $self->{'source_filename'} = $source;
sub set_source {
my $self = shift @_;
return $self->{'source_fh'} unless @_;
Carp::croak("Cannot assign new source to pull parser; create a new instance, instead")
if $self->{'source_fh'} || $self->{'source_scalar_ref'} || $self->{'source_arrayref'};
my $handle;
if(!defined $_[0]) {
Carp::croak("Can't use empty-string as a source for set_source");
} elsif(ref(\( $_[0] )) eq 'GLOB') {
$self->{'source_filename'} = '' . ($handle = $_[0]);
DEBUG and print STDERR "$self 's source is glob $_[0]\n";
# and fall thru
} elsif(ref( $_[0] ) eq 'SCALAR') {
$self->{'source_scalar_ref'} = $_[0];
DEBUG and print STDERR "$self 's source is scalar ref $_[0]\n";
return;
} elsif(ref( $_[0] ) eq 'ARRAY') {
$self->{'source_arrayref'} = $_[0];
DEBUG and print STDERR "$self 's source is array ref $_[0]\n";
return;
} elsif(ref $_[0]) {
$self->{'source_filename'} = '' . ($handle = $_[0]);
DEBUG and print STDERR "$self 's source is fh-obj $_[0]\n";
} elsif(!length $_[0]) {
Carp::croak("Can't use empty-string as a source for set_source");
} else { # It's a filename!
DEBUG and print STDERR "$self 's source is filename $_[0]\n";
{
local *PODSOURCE;
open(PODSOURCE, "<$_[0]") || Carp::croak "Can't open $_[0]: $!";
$handle = *PODSOURCE{IO};
}
$self->{'source_filename'} = $_[0];
DEBUG and print STDERR " Its name is $_[0].\n";
# TODO: file-discipline things here!
}
$self->{'source_fh'} = $handle;
DEBUG and print STDERR " Its handle is $handle\n";
return 1;
}
# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
sub get_title_short { shift->get_short_title(@_) } # alias
sub get_short_title {
my $title = shift->get_title(@_);
$title = $1 if $title =~ m/^(\S{1,60})\s+--?\s+./s;
# turn "Foo::Bar -- bars for your foo" into "Foo::Bar"
return $title;
}
sub get_title { shift->_get_titled_section(
'NAME', max_token => 50, desperate => 1, @_)
}
sub get_version { shift->_get_titled_section(
'VERSION',
max_token => 400,
accept_verbatim => 1,
max_content_length => 3_000,
@_,
);
}
sub get_description { shift->_get_titled_section(
'DESCRIPTION',
max_token => 400,
max_content_length => 3_000,
@_,
) }
sub get_authors { shift->get_author(@_) } # a harmless alias
sub get_author {
my $this = shift;
# Max_token is so high because these are
# typically at the end of the document:
$this->_get_titled_section('AUTHOR' , max_token => 10_000, @_) ||
$this->_get_titled_section('AUTHORS', max_token => 10_000, @_);
}
#--------------------------------------------------------------------------
sub _get_titled_section {
# Based on a get_title originally contributed by Graham Barr
my($self, $titlename, %options) = (@_);
my $max_token = delete $options{'max_token'};
my $desperate_for_title = delete $options{'desperate'};
my $accept_verbatim = delete $options{'accept_verbatim'};
my $max_content_length = delete $options{'max_content_length'};
my $nocase = delete $options{'nocase'};
$max_content_length = 120 unless defined $max_content_length;
Carp::croak( "Unknown " . ((1 == keys %options) ? "option: " : "options: ")
. join " ", map "[$_]", sort keys %options
)
if keys %options;
my %content_containers;
$content_containers{'Para'} = 1;
if($accept_verbatim) {
$content_containers{'Verbatim'} = 1;
$content_containers{'VerbatimFormatted'} = 1;
}
my $token_count = 0;
my $title;
my @to_unget;
my $state = 0;
my $depth = 0;
Carp::croak "What kind of titlename is \"$titlename\"?!" unless
defined $titlename and $titlename =~ m/^[A-Z ]{1,60}$/s; #sanity
my $titlename_re = quotemeta($titlename);
my $head1_text_content;
my $para_text_content;
my $skipX;
while(
++$token_count <= ($max_token || 1_000_000)
and defined(my $token = $self->get_token)
) {
push @to_unget, $token;
if ($state == 0) { # seeking =head1
if( $token->is_start and $token->tagname eq 'head1' ) {
DEBUG and print STDERR " Found head1. Seeking content...\n";
++$state;
$head1_text_content = '';
}
}
elsif($state == 1) { # accumulating text until end of head1
if( $token->is_text ) {
unless ($skipX) {
DEBUG and print STDERR " Adding \"", $token->text, "\" to head1-content.\n";
$head1_text_content .= $token->text;
}
} elsif( $token->is_tagname('X') ) {
# We're going to want to ignore X<> stuff.
$skipX = $token->is_start;
DEBUG and print STDERR +($skipX ? 'Start' : 'End'), 'ing ignoring of X<> tag';
} elsif( $token->is_end and $token->tagname eq 'head1' ) {
DEBUG and print STDERR " Found end of head1. Considering content...\n";
$head1_text_content = uc $head1_text_content if $nocase;
if($head1_text_content eq $titlename
or $head1_text_content =~ m/\($titlename_re\)/s
# We accept "=head1 Nomen Modularis (NAME)" for sake of i18n
) {
DEBUG and print STDERR " Yup, it was $titlename. Seeking next para-content...\n";
++$state;
} elsif(
$desperate_for_title
# if we're so desperate we'll take the first
# =head1's content as a title
and $head1_text_content =~ m/\S/
and $head1_text_content !~ m/^[ A-Z]+$/s
and $head1_text_content !~
m/\((?:
NAME | TITLE | VERSION | AUTHORS? | DESCRIPTION | SYNOPSIS
| COPYRIGHT | LICENSE | NOTES? | FUNCTIONS? | METHODS?
| CAVEATS? | BUGS? | SEE\ ALSO | SWITCHES | ENVIRONMENT
)\)/sx
# avoid accepting things like =head1 Thingy Thongy (DESCRIPTION)
and ($max_content_length
? (length($head1_text_content) <= $max_content_length) # sanity
: 1)
) {
# Looks good; trim it
($title = $head1_text_content) =~ s/\s+$//;
DEBUG and print STDERR " It looks titular: \"$title\".\n\n Using that.\n";
last;
} else {
--$state;
DEBUG and print STDERR " Didn't look titular ($head1_text_content).\n",
"\n Dropping back to seeking-head1-content mode...\n";
}
}
}
elsif($state == 2) {
# seeking start of para (which must immediately follow)
if($token->is_start and $content_containers{ $token->tagname }) {
DEBUG and print STDERR " Found start of Para. Accumulating content...\n";
$para_text_content = '';
++$state;
} else {
DEBUG and print
" Didn't see an immediately subsequent start-Para. Reseeking H1\n";
$state = 0;
}
}
elsif($state == 3) {
# accumulating text until end of Para
if( $token->is_text ) {
DEBUG and print STDERR " Adding \"", $token->text, "\" to para-content.\n";
$para_text_content .= $token->text;
# and keep looking
} elsif( $token->is_end and $content_containers{ $token->tagname } ) {
DEBUG and print STDERR " Found end of Para. Considering content: ",
$para_text_content, "\n";
if( $para_text_content =~ m/\S/
and ($max_content_length
? (length($para_text_content) <= $max_content_length)
: 1)
) {
# Some minimal sanity constraints, I think.
DEBUG and print STDERR " It looks contentworthy, I guess. Using it.\n";
$title = $para_text_content;
last;
} else {
DEBUG and print STDERR " Doesn't look at all contentworthy!\n Giving up.\n";
undef $title;
last;
}
}
}
else {
die "IMPOSSIBLE STATE $state!\n"; # should never happen
}
}
# Put it all back!
$self->unget_token(@to_unget);
if(DEBUG) {
if(defined $title) { print STDERR " Returning title <$title>\n" }
else { print STDERR "Returning title <>\n" }
}
return '' unless defined $title;
$title =~ s/^\s+//;
return $title;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
#
# Methods that actually do work at parse-time:
sub _handle_element_start {
my $self = shift; # leaving ($element_name, $attr_hash_r)
DEBUG > 2 and print STDERR "++ $_[0] (", map("<$_> ", %{$_[1]}), ")\n";
push @{ $self->{'token_buffer'} },
$self->{'start_token_class'}->new(@_);
return;
}
sub _handle_text {
my $self = shift; # leaving ($text)
DEBUG > 2 and print STDERR "== $_[0]\n";
push @{ $self->{'token_buffer'} },
$self->{'text_token_class'}->new(@_);
return;
}
sub _handle_element_end {
my $self = shift; # leaving ($element_name);
DEBUG > 2 and print STDERR "-- $_[0]\n";
push @{ $self->{'token_buffer'} },
$self->{'end_token_class'}->new(@_);
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::PullParser -- a pull-parser interface to parsing Pod
=head1 SYNOPSIS
my $parser = SomePodProcessor->new;
$parser->set_source( "whatever.pod" );
$parser->run;
Or:
my $parser = SomePodProcessor->new;
$parser->set_source( $some_filehandle_object );
$parser->run;
Or:
my $parser = SomePodProcessor->new;
$parser->set_source( \$document_source );
$parser->run;
Or:
my $parser = SomePodProcessor->new;
$parser->set_source( \@document_lines );
$parser->run;
And elsewhere:
require 5;
package SomePodProcessor;
use strict;
use base qw(Pod::Simple::PullParser);
sub run {
my $self = shift;
Token:
while(my $token = $self->get_token) {
...process each token...
}
}
=head1 DESCRIPTION
This class is for using Pod::Simple to build a Pod processor -- but
one that uses an interface based on a stream of token objects,
instead of based on events.
This is a subclass of L<Pod::Simple> and inherits all its methods.
A subclass of Pod::Simple::PullParser should define a C<run> method
that calls C<< $token = $parser->get_token >> to pull tokens.
See the source for Pod::Simple::RTF for an example of a formatter
that uses Pod::Simple::PullParser.
=head1 METHODS
=over
=item my $token = $parser->get_token
This returns the next token object (which will be of a subclass of
L<Pod::Simple::PullParserToken>), or undef if the parser-stream has hit
the end of the document.
=item $parser->unget_token( $token )
=item $parser->unget_token( $token1, $token2, ... )
This restores the token object(s) to the front of the parser stream.
=back
The source has to be set before you can parse anything. The lowest-level
way is to call C<set_source>:
=over
=item $parser->set_source( $filename )
=item $parser->set_source( $filehandle_object )
=item $parser->set_source( \$document_source )
=item $parser->set_source( \@document_lines )
=back
Or you can call these methods, which Pod::Simple::PullParser has defined
to work just like Pod::Simple's same-named methods:
=over
=item $parser->parse_file(...)
=item $parser->parse_string_document(...)
=item $parser->filter(...)
=item $parser->parse_from_file(...)
=back
For those to work, the Pod-processing subclass of
Pod::Simple::PullParser has to have defined a $parser->run method --
so it is advised that all Pod::Simple::PullParser subclasses do so.
See the Synopsis above, or the source for Pod::Simple::RTF.
Authors of formatter subclasses might find these methods useful to
call on a parser object that you haven't started pulling tokens
from yet:
=over
=item my $title_string = $parser->get_title
This tries to get the title string out of $parser, by getting some tokens,
and scanning them for the title, and then ungetting them so that you can
process the token-stream from the beginning.
For example, suppose you have a document that starts out:
=head1 NAME
Hoo::Boy::Wowza -- Stuff B<wow> yeah!
$parser->get_title on that document will return "Hoo::Boy::Wowza --
Stuff wow yeah!". If the document starts with:
=head1 Name
Hoo::Boy::W00t -- Stuff B<w00t> yeah!
Then you'll need to pass the C<nocase> option in order to recognize "Name":
$parser->get_title(nocase => 1);
In cases where get_title can't find the title, it will return empty-string
("").
=item my $title_string = $parser->get_short_title
This is just like get_title, except that it returns just the modulename, if
the title seems to be of the form "SomeModuleName -- description".
For example, suppose you have a document that starts out:
=head1 NAME
Hoo::Boy::Wowza -- Stuff B<wow> yeah!
then $parser->get_short_title on that document will return
"Hoo::Boy::Wowza".
But if the document starts out:
=head1 NAME
Hooboy, stuff B<wow> yeah!
then $parser->get_short_title on that document will return "Hooboy,
stuff wow yeah!". If the document starts with:
=head1 Name
Hoo::Boy::W00t -- Stuff B<w00t> yeah!
Then you'll need to pass the C<nocase> option in order to recognize "Name":
$parser->get_short_title(nocase => 1);
If the title can't be found, then get_short_title returns empty-string
("").
=item $author_name = $parser->get_author
This works like get_title except that it returns the contents of the
"=head1 AUTHOR\n\nParagraph...\n" section, assuming that that section
isn't terribly long. To recognize a "=head1 Author\n\nParagraph\n"
section, pass the C<nocase> option:
$parser->get_author(nocase => 1);
(This method tolerates "AUTHORS" instead of "AUTHOR" too.)
=item $description_name = $parser->get_description
This works like get_title except that it returns the contents of the
"=head1 DESCRIPTION\n\nParagraph...\n" section, assuming that that section
isn't terribly long. To recognize a "=head1 Description\n\nParagraph\n"
section, pass the C<nocase> option:
$parser->get_description(nocase => 1);
=item $version_block = $parser->get_version
This works like get_title except that it returns the contents of
the "=head1 VERSION\n\n[BIG BLOCK]\n" block. Note that this does NOT
return the module's C<$VERSION>!! To recognize a
"=head1 Version\n\n[BIG BLOCK]\n" section, pass the C<nocase> option:
$parser->get_version(nocase => 1);
=back
=head1 NOTE
You don't actually I<have> to define a C<run> method. If you're
writing a Pod-formatter class, you should define a C<run> just so
that users can call C<parse_file> etc, but you don't I<have> to.
And if you're not writing a formatter class, but are instead just
writing a program that does something simple with a Pod::PullParser
object (and not an object of a subclass), then there's no reason to
bother subclassing to add a C<run> method.
=head1 SEE ALSO
L<Pod::Simple>
L<Pod::Simple::PullParserToken> -- and its subclasses
L<Pod::Simple::PullParserStartToken>,
L<Pod::Simple::PullParserTextToken>, and
L<Pod::Simple::PullParserEndToken>.
L<HTML::TokeParser>, which inspired this.
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut
JUNK:
sub _old_get_title { # some witchery in here
my $self = $_[0];
my $title;
my @to_unget;
while(1) {
push @to_unget, $self->get_token;
unless(defined $to_unget[-1]) { # whoops, short doc!
pop @to_unget;
last;
}
DEBUG and print STDERR "-Got token ", $to_unget[-1]->dump, "\n";
(DEBUG and print STDERR "Too much in the buffer.\n"),
last if @to_unget > 25; # sanity
my $pattern = '';
if( #$to_unget[-1]->type eq 'end'
#and $to_unget[-1]->tagname eq 'Para'
#and
($pattern = join('',
map {;
($_->type eq 'start') ? ("<" . $_->tagname .">")
: ($_->type eq 'end' ) ? ("</". $_->tagname .">")
: ($_->type eq 'text' ) ? ($_->text =~ m<^([A-Z]+)$>s ? $1 : 'X')
: "BLORP"
} @to_unget
)) =~ m{<head1>NAME</head1><Para>(X|</?[BCIFLS]>)+</Para>$}s
) {
# Whee, it fits the pattern
DEBUG and print STDERR "Seems to match =head1 NAME pattern.\n";
$title = '';
foreach my $t (reverse @to_unget) {
last if $t->type eq 'start' and $t->tagname eq 'Para';
$title = $t->text . $title if $t->type eq 'text';
}
undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
last;
} elsif ($pattern =~ m{<head(\d)>(.+)</head\d>$}
and !( $1 eq '1' and $2 eq 'NAME' )
) {
# Well, it fits a fallback pattern
DEBUG and print STDERR "Seems to match NAMEless pattern.\n";
$title = '';
foreach my $t (reverse @to_unget) {
last if $t->type eq 'start' and $t->tagname =~ m/^head\d$/s;
$title = $t->text . $title if $t->type eq 'text';
}
undef $title if $title =~ m<^\s*$>; # make sure it's contentful!
last;
} else {
DEBUG and $pattern and print STDERR "Leading pattern: $pattern\n";
}
}
# Put it all back:
$self->unget_token(@to_unget);
if(DEBUG) {
if(defined $title) { print STDERR " Returning title <$title>\n" }
else { print STDERR "Returning title <>\n" }
}
return '' unless defined $title;
return $title;
}
use warnings;

118
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/PullParserEndToken.pm Normal file
View file

@ -0,0 +1,118 @@
package Pod::Simple::PullParserEndToken;
use strict;
use warnings;
use Pod::Simple::PullParserToken ();
our @ISA = ('Pod::Simple::PullParserToken');
our $VERSION = '3.45';
sub new { # Class->new(tagname);
my $class = shift;
return bless ['end', @_], ref($class) || $class;
}
# Purely accessors:
sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
sub tag { shift->tagname(@_) }
# shortcut:
sub is_tagname { $_[0][1] eq $_[1] }
sub is_tag { shift->is_tagname(@_) }
1;
__END__
=head1 NAME
Pod::Simple::PullParserEndToken -- end-tokens from Pod::Simple::PullParser
=head1 SYNOPSIS
(See L<Pod::Simple::PullParser>)
=head1 DESCRIPTION
When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might
get an object of this class.
This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
and adds these methods:
=over
=item $token->tagname
This returns the tagname for this end-token object.
For example, parsing a "=head1 ..." line will give you
a start-token with the tagname of "head1", token(s) for its
content, and then an end-token with the tagname of "head1".
=item $token->tagname(I<somestring>)
This changes the tagname for this end-token object.
You probably won't need to do this.
=item $token->tag(...)
A shortcut for $token->tagname(...)
=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>)
These are shortcuts for C<< $token->tag() eq I<somestring> >>
=back
You're unlikely to ever need to construct an object of this class for
yourself, but if you want to, call
C<<
Pod::Simple::PullParserEndToken->new( I<tagname> )
>>
=head1 SEE ALSO
L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

159
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/PullParserStartToken.pm Normal file
View file

@ -0,0 +1,159 @@
package Pod::Simple::PullParserStartToken;
use strict;
use warnings;
use Pod::Simple::PullParserToken ();
our @ISA = ('Pod::Simple::PullParserToken');
our $VERSION = '3.45';
sub new { # Class->new(tagname, optional_attrhash);
my $class = shift;
return bless ['start', @_], ref($class) || $class;
}
# Purely accessors:
sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
sub tag { shift->tagname(@_) }
sub is_tagname { $_[0][1] eq $_[1] }
sub is_tag { shift->is_tagname(@_) }
sub attr_hash { $_[0][2] ||= {} }
sub attr {
if(@_ == 2) { # Reading: $token->attr('attrname')
${$_[0][2] || return undef}{ $_[1] };
} elsif(@_ > 2) { # Writing: $token->attr('attrname', 'newval')
${$_[0][2] ||= {}}{ $_[1] } = $_[2];
} else {
require Carp;
Carp::croak(
'usage: $object->attr("val") or $object->attr("key", "newval")');
return undef;
}
}
1;
__END__
=head1 NAME
Pod::Simple::PullParserStartToken -- start-tokens from Pod::Simple::PullParser
=head1 SYNOPSIS
(See L<Pod::Simple::PullParser>)
=head1 DESCRIPTION
When you do $parser->get_token on a L<Pod::Simple::PullParser> object, you might
get an object of this class.
This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
and adds these methods:
=over
=item $token->tagname
This returns the tagname for this start-token object.
For example, parsing a "=head1 ..." line will give you
a start-token with the tagname of "head1", token(s) for its
content, and then an end-token with the tagname of "head1".
=item $token->tagname(I<somestring>)
This changes the tagname for this start-token object.
You probably won't need
to do this.
=item $token->tag(...)
A shortcut for $token->tagname(...)
=item $token->is_tag(I<somestring>) or $token->is_tagname(I<somestring>)
These are shortcuts for C<< $token->tag() eq I<somestring> >>
=item $token->attr(I<attrname>)
This returns the value of the I<attrname> attribute for this start-token
object, or undef.
For example, parsing a LZ<><Foo/"Bar"> link will produce a start-token
with a "to" attribute with the value "Foo", a "type" attribute with the
value "pod", and a "section" attribute with the value "Bar".
=item $token->attr(I<attrname>, I<newvalue>)
This sets the I<attrname> attribute for this start-token object to
I<newvalue>. You probably won't need to do this.
=item $token->attr_hash
This returns the hashref that is the attribute set for this start-token.
This is useful if (for example) you want to ask what all the attributes
are -- you can just do C<< keys %{$token->attr_hash} >>
=back
You're unlikely to ever need to construct an object of this class for
yourself, but if you want to, call
C<<
Pod::Simple::PullParserStartToken->new( I<tagname>, I<attrhash> )
>>
=head1 SEE ALSO
L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
=head1 SEE ALSO
L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

132
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/PullParserTextToken.pm Normal file
View file

@ -0,0 +1,132 @@
package Pod::Simple::PullParserTextToken;
use strict;
use warnings;
use Pod::Simple::PullParserToken ();
our @ISA = ('Pod::Simple::PullParserToken');
our $VERSION = '3.45';
sub new { # Class->new(text);
my $class = shift;
return bless ['text', @_], ref($class) || $class;
}
# Purely accessors:
sub text { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }
sub text_r { \ $_[0][1] }
1;
__END__
=head1 NAME
Pod::Simple::PullParserTextToken -- text-tokens from Pod::Simple::PullParser
=head1 SYNOPSIS
(See L<Pod::Simple::PullParser>)
=head1 DESCRIPTION
When you do $parser->get_token on a L<Pod::Simple::PullParser>, you might
get an object of this class.
This is a subclass of L<Pod::Simple::PullParserToken> and inherits all its methods,
and adds these methods:
=over
=item $token->text
This returns the text that this token holds. For example, parsing
CZ<><foo> will return a C start-token, a text-token, and a C end-token. And
if you want to get the "foo" out of the text-token, call C<< $token->text >>
=item $token->text(I<somestring>)
This changes the string that this token holds. You probably won't need
to do this.
=item $token->text_r()
This returns a scalar reference to the string that this token holds.
This can be useful if you don't want to memory-copy the potentially
large text value (well, as large as a paragraph or a verbatim block)
as calling $token->text would do.
Or, if you want to alter the value, you can even do things like this:
for ( ${ $token->text_r } ) { # Aliases it with $_ !!
s/ The / the /g; # just for example
if( 'A' eq chr(65) ) { # (if in an ASCII world)
tr/\xA0/ /;
tr/\xAD//d;
}
...or however you want to alter the value...
(Note that starting with Perl v5.8, you can use, e.g.,
my $nbsp = chr utf8::unicode_to_native(0xA0);
s/$nbsp/ /g;
to handle the above regardless if it's an ASCII world or not)
}
=back
You're unlikely to ever need to construct an object of this class for
yourself, but if you want to, call
C<<
Pod::Simple::PullParserTextToken->new( I<text> )
>>
=head1 SEE ALSO
L<Pod::Simple::PullParserToken>, L<Pod::Simple>, L<Pod::Simple::Subclassing>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

162
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/PullParserToken.pm Normal file
View file

@ -0,0 +1,162 @@
package Pod::Simple::PullParserToken;
# Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token
our @ISA = ();
our $VERSION = '3.45';
use strict;
sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway
my $class = shift;
return bless [@_], ref($class) || $class;
}
sub type { $_[0][0] } # Can't change the type of an object
sub dump { Pod::Simple::pretty( [ @{ $_[0] } ] ) }
sub is_start { $_[0][0] eq 'start' }
sub is_end { $_[0][0] eq 'end' }
sub is_text { $_[0][0] eq 'text' }
1;
__END__
sub dump { '[' . _esc( @{ $_[0] } ) . ']' }
# JUNK:
sub _esc {
return '' unless @_;
my @out;
foreach my $in (@_) {
push @out, '"' . $in . '"';
$out[-1] =~ s/([^- \:\:\.\,\'\>\<\"\/\=\?\+\|\[\]\{\}\_a-zA-Z0-9_\`\~\!\#\%\^\&\*\(\)])/
sprintf( (ord($1) < 256) ? "\\x%02X" : "\\x{%X}", ord($1))
/eg;
}
return join ', ', @out;
}
__END__
=head1 NAME
Pod::Simple::PullParserToken -- tokens from Pod::Simple::PullParser
=head1 SYNOPSIS
Given a $parser that's an object of class Pod::Simple::PullParser
(or a subclass)...
while(my $token = $parser->get_token) {
$DEBUG and print STDERR "Token: ", $token->dump, "\n";
if($token->is_start) {
...access $token->tagname, $token->attr, etc...
} elsif($token->is_text) {
...access $token->text, $token->text_r, etc...
} elsif($token->is_end) {
...access $token->tagname...
}
}
(Also see L<Pod::Simple::PullParser>)
=head1 DESCRIPTION
When you do $parser->get_token on a L<Pod::Simple::PullParser>, you should
get an object of a subclass of Pod::Simple::PullParserToken.
Subclasses will add methods, and will also inherit these methods:
=over
=item $token->type
This returns the type of the token. This will be either the string
"start", the string "text", or the string "end".
Once you know what the type of an object is, you then know what
subclass it belongs to, and therefore what methods it supports.
Yes, you could probably do the same thing with code like
$token->isa('Pod::Simple::PullParserEndToken'), but that's not so
pretty as using just $token->type, or even the following shortcuts:
=item $token->is_start
This is a shortcut for C<< $token->type() eq "start" >>
=item $token->is_text
This is a shortcut for C<< $token->type() eq "text" >>
=item $token->is_end
This is a shortcut for C<< $token->type() eq "end" >>
=item $token->dump
This returns a handy stringified value of this object. This
is useful for debugging, as in:
while(my $token = $parser->get_token) {
$DEBUG and print STDERR "Token: ", $token->dump, "\n";
...
}
=back
=head1 SEE ALSO
My subclasses:
L<Pod::Simple::PullParserStartToken>,
L<Pod::Simple::PullParserTextToken>, and
L<Pod::Simple::PullParserEndToken>.
L<Pod::Simple::PullParser> and L<Pod::Simple>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut
use warnings;

743
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/RTF.pm Normal file
View file

@ -0,0 +1,743 @@
package Pod::Simple::RTF;
use strict;
use warnings;
#sub DEBUG () {4};
#sub Pod::Simple::DEBUG () {4};
#sub Pod::Simple::PullParser::DEBUG () {4};
our $VERSION = '3.45';
use Pod::Simple::PullParser ();
our @ISA;
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|~';
our $WRAP;
$WRAP = 1 unless defined $WRAP;
our %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" => "}",
);
# 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";
# Then convert to patterns
$escaped_sans_hyphen = qr/[\Q$escaped_sans_hyphen \E]/;
$escaped= qr/[\Q$escaped\E]/;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub _openclose {
return map {;
m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?";
( $1, "{\\$2\n", "/$1", "}" );
} @_;
}
my @_to_accept;
our %Tagmap = (
# 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}')
_openclose(
'B=cs18\b',
'I=cs16\i',
'C=cs19\f1\lang1024\noproof',
'F=cs17\i\lang1024\noproof',
'VerbatimI=cs26\i',
'VerbatimB=cs27\b',
'VerbatimBI=cs28\b\i',
map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
qw[
underline=ul smallcaps=scaps shadow=shad
superscript=super subscript=sub strikethrough=strike
outline=outl emboss=embo engrave=impr
dotted-underline=uld dash-underline=uldash
dot-dash-underline=uldashd dot-dot-dash-underline=uldashdd
double-underline=uldb thick-underline=ulth
word-underline=ulw wave-underline=ulwave
]
# But no double-strikethrough, because MSWord can't agree with the
# RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!)
),
# Bit of a hack here:
'L=pod' => '{\cs22\i'."\n",
'L=url' => '{\cs23\i'."\n",
'L=man' => '{\cs24\i'."\n",
'/L' => '}',
'Data' => "\n",
'/Data' => "\n",
'Verbatim' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
'/Verbatim' => "\n\\par}\n",
'VerbatimFormatted' => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
'/VerbatimFormatted' => "\n\\par}\n",
'Para' => "\n{\\pard\\li#rtfindent#\\sa180\n",
'/Para' => "\n\\par}\n",
'head1' => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n",
'/head1' => "\n}\\par}\n",
'head2' => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n",
'/head2' => "\n}\\par}\n",
'head3' => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n",
'/head3' => "\n}\\par}\n",
'head4' => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n",
'/head4' => "\n}\\par}\n",
# wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2
'item-bullet' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
'/item-bullet' => "\n\\par}\n",
'item-number' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
'/item-number' => "\n\\par}\n",
'item-text' => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
'/item-text' => "\n\\par}\n",
# we don't need any styles for over-* and /over-*
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
my $new = shift->SUPER::new(@_);
$new->nix_X_codes(1);
$new->nbsp_for_S(1);
$new->accept_targets( 'rtf', 'RTF' );
$new->{'Tagmap'} = {%Tagmap};
$new->accept_codes(@_to_accept);
$new->accept_codes('VerbatimFormatted');
DEBUG > 2 and print STDERR "To accept: ", join(' ',@_to_accept), "\n";
$new->doc_lang(
( $ENV{'RTFDEFLANG'} || '') =~ m/^(\d{1,10})$/s ? $1
: ($ENV{'RTFDEFLANG'} || '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1)
# yes, tolerate hex!
: ($ENV{'RTFDEFLANG'} || '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1)
# yes, tolerate even more hex!
: '1033'
);
$new->head1_halfpoint_size(32);
$new->head2_halfpoint_size(28);
$new->head3_halfpoint_size(25);
$new->head4_halfpoint_size(22);
$new->codeblock_halfpoint_size(18);
$new->header_halfpoint_size(17);
$new->normal_halfpoint_size(25);
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
__PACKAGE__->_accessorize(
'doc_lang',
'head1_halfpoint_size',
'head2_halfpoint_size',
'head3_halfpoint_size',
'head4_halfpoint_size',
'codeblock_halfpoint_size',
'header_halfpoint_size',
'normal_halfpoint_size',
'no_proofing_exemptions',
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub run {
my $self = $_[0];
return $self->do_middle if $self->bare_output;
return
$self->do_beginning && $self->do_middle && $self->do_end;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# 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'};
my($token, $type, $tagname, $scratch);
my @stack;
my @indent_stack;
$self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'};
while($token = $self->get_token) {
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
print $fh $scratch;
next;
}
DEBUG > 1 and print STDERR " $type " , $token->text, "\n";
$scratch = $token->text;
$scratch =~ tr/\t\cb\cc/ /d;
$self->{'no_proofing_exemptions'} or $scratch =~
s/(?:
^
|
(?<=[\r\n\t "\[\<\(])
) # start on whitespace, sequence-start, or quote
( # something looking like a Perl token:
(?:
[\$\@\:\<\*\\_]\S+ # either starting with a sigil, etc.
)
|
# or starting alpha, but containing anything strange:
(?:
${id_re}[\$\@\:_<>\(\\\*]\S+
)
)
/\cb$1\cc/xsg
;
rtf_esc(1, $scratch); # 1 => escape hyphen
$scratch =~
s/(
[^\r\n]{65} # Snare 65 characters from a line
[^\r\n ]{0,50} # and finish any current word
)
(\ {1,10})(?![\r\n]) # capture some spaces not at line-end
/$1$2\n/gx # and put a NL before those spaces
if $WRAP;
# This may wrap at well past the 65th column, but not past the 120th.
print $fh $scratch;
} elsif( $type eq 'start' ) {
DEBUG > 1 and print STDERR " +$type ",$token->tagname,
" (", map("<$_> ", %{$token->attr_hash}), ")\n";
if( ($tagname = $token->tagname) eq 'Verbatim'
or $tagname eq 'VerbatimFormatted'
) {
++$self->{'rtfverbatim'};
my $next = $self->get_token;
next unless defined $next;
my $line_count = 1;
if($next->type eq 'text') {
my $t = $next->text_r;
while( $$t =~ m/$/mg ) {
last if ++$line_count > 15; # no point in counting further
}
DEBUG > 3 and print STDERR " verbatim line count: $line_count\n";
}
$self->unget_token($next);
$self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ;
} elsif( $tagname =~ m/^item-/s ) {
my @to_unget;
my $text_count_here = 0;
$self->{'rtfitemkeepn'} = '';
# Some heuristics to stop item-*'s functioning as subheadings
# from getting split from the things they're subheadings for.
#
# It's not terribly pretty, but it really does make things pretty.
#
while(1) {
push @to_unget, $self->get_token;
pop(@to_unget), last unless defined $to_unget[-1];
# Erroneously used to be "unshift" instead of pop! Adds instead
# of removes, and operates on the beginning instead of the end!
if($to_unget[-1]->type eq 'text') {
if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){
DEBUG > 1 and print STDERR " item-* is too long to be keepn'd.\n";
last;
}
} elsif (@to_unget > 1 and
$to_unget[-2]->type eq 'end' and
$to_unget[-2]->tagname =~ m/^item-/s
) {
# Bail out here, after setting rtfitemkeepn yea or nay.
$self->{'rtfitemkeepn'} = '\keepn' if
$to_unget[-1]->type eq 'start' and
$to_unget[-1]->tagname eq 'Para';
DEBUG > 1 and printf STDERR " item-* before %s(%s) %s keepn'd.\n",
$to_unget[-1]->type,
$to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '',
$self->{'rtfitemkeepn'} ? "gets" : "doesn't get";
last;
} elsif (@to_unget > 40) {
DEBUG > 1 and print STDERR " item-* now has too many tokens (",
scalar(@to_unget),
(DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (),
") to be keepn'd.\n";
last; # give up
}
# else keep while'ing along
}
# Now put it aaaaall back...
$self->unget_token(@to_unget);
} elsif( $tagname =~ m/^over-/s ) {
push @stack, $1;
push @indent_stack,
int($token->attr('indent') * 4 * $self->normal_halfpoint_size);
DEBUG and print STDERR "Indenting over $indent_stack[-1] twips.\n";
$self->{'rtfindent'} += $indent_stack[-1];
} elsif ($tagname eq 'L') {
$tagname .= '=' . ($token->attr('type') || 'pod');
} elsif ($tagname eq 'Data') {
my $next = $self->get_token;
next unless defined $next;
unless( $next->type eq 'text' ) {
$self->unget_token($next);
next;
}
DEBUG and print STDERR " raw text ", $next->text, "\n";
printf $fh "\n" . $next->text . "\n";
next;
}
defined($scratch = $self->{'Tagmap'}{$tagname}) or next;
$scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
print $fh $scratch;
if ($tagname eq 'item-number') {
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}");
}
} elsif( $type eq 'end' ) {
DEBUG > 1 and print STDERR " -$type ",$token->tagname,"\n";
if( ($tagname = $token->tagname) =~ m/^over-/s ) {
DEBUG and print STDERR "Indenting back $indent_stack[-1] twips.\n";
$self->{'rtfindent'} -= pop @indent_stack;
pop @stack;
} elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') {
--$self->{'rtfverbatim'};
}
defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next;
$scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
print $fh $scratch;
}
}
return 1;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub do_beginning {
my $self = $_[0];
my $fh = $self->{'output_fh'};
return print $fh join '',
$self->doc_init,
$self->font_table,
$self->stylesheet,
$self->color_table,
$self->doc_info,
$self->doc_start,
"\n"
;
}
sub do_end {
my $self = $_[0];
my $fh = $self->{'output_fh'};
return print $fh '}'; # that should do it
}
###########################################################################
sub stylesheet {
return sprintf <<'END',
{\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\fs%s\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\fs%s\ul\sbasedon0 \snext0 pod-head1;}
{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;}
{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;}
{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;}
}
END
$_[0]->codeblock_halfpoint_size(),
$_[0]->head1_halfpoint_size(),
$_[0]->head2_halfpoint_size(),
$_[0]->head3_halfpoint_size(),
$_[0]->head4_halfpoint_size(),
;
}
###########################################################################
# Override these as necessary for further customization
sub font_table {
return <<'END'; # text font, code font, heading font
{\fonttbl
{\f0\froman Times New Roman;}
{\f1\fmodern Courier New;}
{\f2\fswiss Arial;}
}
END
}
sub doc_init {
return <<'END';
{\rtf1\ansi\deff0
END
}
sub color_table {
return <<'END';
{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}
END
}
sub doc_info {
my $self = $_[0];
my $class = ref($self) || $self;
my $tag = __PACKAGE__ . ' ' . $VERSION;
unless($class eq __PACKAGE__) {
$tag = " ($tag)";
$tag = " v" . $self->VERSION . $tag if defined $self->VERSION;
$tag = $class . $tag;
}
return sprintf <<'END',
{\info{\doccomm
%s
using %s v%s
under Perl v%s at %s GMT}
{\author [see doc]}{\company [see doc]}{\operator [see doc]}
}
END
# None of the following things should need escaping, I dare say!
$tag,
$ISA[0], $ISA[0]->VERSION(),
$], scalar(gmtime($ENV{SOURCE_DATE_EPOCH} || time)),
;
}
sub doc_start {
my $self = $_[0];
my $title = $self->get_short_title();
DEBUG and print STDERR "Short Title: <$title>\n";
$title .= ' ' if length $title;
$title =~ s/ *$/ /s;
$title =~ s/^ //s;
$title =~ s/ $/, /s;
# make sure it ends in a comma and a space, unless it's 0-length
my $is_obviously_module_name;
$is_obviously_module_name = 1
if $title =~ m/^\S+$/s and $title =~ m/::/s;
# catches the most common case, at least
DEBUG and print STDERR "Title0: <$title>\n";
$title = rtf_esc(1, $title); # 1 => escape hyphen
DEBUG and print STDERR "Title1: <$title>\n";
$title = '\lang1024\noproof ' . $title
if $is_obviously_module_name;
return sprintf <<'END',
\deflang%s\plain\lang%s\widowctrl
{\header\pard\qr\plain\f2\fs%s
%s
p.\chpgn\par}
\fs%s
END
($self->doc_lang) x 2,
$self->header_halfpoint_size,
$title,
$self->normal_halfpoint_size,
;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#-------------------------------------------------------------------------
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;
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
# 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($_);
}
return;
} elsif(wantarray) { # return an array
return map {; ($x = $_) =~
s/($escape_re)/$Escape{$1}/g; # ESCAPER
$x = esc_uni($x);
$x;
} @_;
} else { # return a single scalar
($x = ((@_ == 1) ? $_[0] : join '', @_)
) =~ s/($escape_re)/$Escape{$1}/g; # ESCAPER
# Escape \, {, }, -, control chars, and 7f-ff.
$x = esc_uni($x);
return $x;
}
}
1;
__END__
=head1 NAME
Pod::Simple::RTF -- format Pod as RTF
=head1 SYNOPSIS
perl -MPod::Simple::RTF -e \
"exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \
thingy.pod > thingy.rtf
=head1 DESCRIPTION
This class is a formatter that takes Pod and renders it as RTF, good for
viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc.
This is a subclass of L<Pod::Simple> and inherits all its methods.
=head1 FORMAT CONTROL ATTRIBUTES
You can set these attributes on the parser object before you
call C<parse_file> (or a similar method) on it:
=over
=item $parser->head1_halfpoint_size( I<halfpoint_integer> );
=item $parser->head2_halfpoint_size( I<halfpoint_integer> );
=item $parser->head3_halfpoint_size( I<halfpoint_integer> );
=item $parser->head4_halfpoint_size( I<halfpoint_integer> );
These methods set the size (in half-points, like 52 for 26-point)
that these heading levels will appear as.
=item $parser->codeblock_halfpoint_size( I<halfpoint_integer> );
This method sets the size (in half-points, like 21 for 10.5-point)
that codeblocks ("verbatim sections") will appear as.
=item $parser->header_halfpoint_size( I<halfpoint_integer> );
This method sets the size (in half-points, like 15 for 7.5-point)
that the header on each page will appear in. The header
is usually just "I<modulename> p. I<pagenumber>".
=item $parser->normal_halfpoint_size( I<halfpoint_integer> );
This method sets the size (in half-points, like 26 for 13-point)
that normal paragraphic text will appear in.
=item $parser->no_proofing_exemptions( I<true_or_false> );
Set this value to true if you don't want the formatter to try
putting a hidden code on all Perl symbols (as best as it can
notice them) that labels them as being not in English, and
so not worth spellchecking.
=item $parser->doc_lang( I<microsoft_decimal_language_code> )
This sets the language code to tag this document as being in. By
default, it is currently the value of the environment variable
C<RTFDEFLANG>, or if that's not set, then the value
1033 (for US English).
Setting this appropriately is useful if you want to use the RTF
to spellcheck, and/or if you want it to hyphenate right.
Here are some notable values:
1033 US English
2057 UK English
3081 Australia English
4105 Canada English
1034 Spain Spanish
2058 Mexico Spanish
1031 Germany German
1036 France French
3084 Canada French
1035 Finnish
1044 Norwegian (Bokmal)
2068 Norwegian (Nynorsk)
=back
If you are particularly interested in customizing this module's output
even more, see the source and/or write to me.
=head1 SEE ALSO
L<Pod::Simple>, L<RTF::Writer>, L<RTF::Cookbook>, L<RTF::Document>,
L<RTF::Generator>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

1092
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Search.pm Normal file
View file

File diff suppressed because it is too large Load diff

177
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/SimpleTree.pm Normal file
View file

@ -0,0 +1,177 @@
package Pod::Simple::SimpleTree;
use strict;
use warnings;
use Carp ();
use Pod::Simple ();
our $VERSION = '3.45';
BEGIN {
our @ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
}
__PACKAGE__->_accessorize(
'root', # root of the tree
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub _handle_element_start { # self, tagname, attrhash
DEBUG > 2 and print STDERR "Handling $_[1] start-event\n";
my $x = [$_[1], $_[2]];
if($_[0]{'_currpos'}) {
push @{ $_[0]{'_currpos'}[0] }, $x; # insert in parent's child-list
unshift @{ $_[0]{'_currpos'} }, $x; # prefix to stack
} else {
DEBUG and print STDERR " And oo, it gets to be root!\n";
$_[0]{'_currpos'} = [ $_[0]{'root'} = $x ];
# first event! set to stack, and set as root.
}
DEBUG > 3 and print STDERR "Stack is now: ",
join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
return;
}
sub _handle_element_end { # self, tagname
DEBUG > 2 and print STDERR "Handling $_[1] end-event\n";
shift @{$_[0]{'_currpos'}};
DEBUG > 3 and print STDERR "Stack is now: ",
join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n";
return;
}
sub _handle_text { # self, text
DEBUG > 2 and print STDERR "Handling $_[1] text-event\n";
push @{ $_[0]{'_currpos'}[0] }, $_[1];
return;
}
# A bit of evil from the black box... please avert your eyes, kind souls.
sub _traverse_treelet_bit {
DEBUG > 2 and print STDERR "Handling $_[1] paragraph event\n";
my $self = shift;
push @{ $self->{'_currpos'}[0] }, [@_];
return;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
__END__
=head1 NAME
Pod::Simple::SimpleTree -- parse Pod into a simple parse tree
=head1 SYNOPSIS
% cat ptest.pod
=head1 PIE
I like B<pie>!
% perl -MPod::Simple::SimpleTree -MData::Dumper -e \
"print Dumper(Pod::Simple::SimpleTree->new->parse_file(shift)->root)" \
ptest.pod
$VAR1 = [
'Document',
{ 'start_line' => 1 },
[
'head1',
{ 'start_line' => 1 },
'PIE'
],
[
'Para',
{ 'start_line' => 3 },
'I like ',
[
'B',
{},
'pie'
],
'!'
]
];
=head1 DESCRIPTION
This class is of interest to people writing a Pod processor/formatter.
This class takes Pod and parses it, returning a parse tree made just
of arrayrefs, and hashrefs, and strings.
This is a subclass of L<Pod::Simple> and inherits all its methods.
This class is inspired by XML::Parser's "Tree" parsing-style, although
it doesn't use exactly the same LoL format.
=head1 METHODS
At the end of the parse, call C<< $parser->root >> to get the
tree's top node.
=head1 Tree Contents
Every element node in the parse tree is represented by an arrayref of
the form: C<[ I<elementname>, \%attributes, I<...subnodes...> ]>.
See the example tree dump in the Synopsis, above.
Every text node in the tree is represented by a simple (non-ref)
string scalar. So you can test C<ref($node)> to see whether you have
an element node or just a text node.
The top node in the tree is C<[ 'Document', \%attributes,
I<...subnodes...> ]>
=head1 SEE ALSO
L<Pod::Simple>
L<perllol>
L<The "Tree" subsubsection in XML::Parser|XML::Parser/"Tree">
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

1094
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Subclassing.pod Normal file
View file

File diff suppressed because it is too large Load diff

184
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Text.pm Normal file
View file

@ -0,0 +1,184 @@
package Pod::Simple::Text;
use strict;
use warnings;
use Carp ();
use Pod::Simple::Methody ();
use Pod::Simple ();
our $VERSION = '3.45';
our @ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
: sub() {0}
}
our $FREAKYMODE;
use Text::Wrap 98.112902 ();
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->accept_target_as_text(qw( text plaintext plain ));
$new->nix_X_codes(1);
$new->nbsp_for_S(1);
$new->{'Thispara'} = '';
$new->{'Indent'} = 0;
$new->{'Indentstring'} = ' ';
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub handle_text { $_[0]{'Thispara'} .= $_[1] }
sub start_Para { $_[0]{'Thispara'} = '' }
sub start_head1 { $_[0]{'Thispara'} = '' }
sub start_head2 { $_[0]{'Thispara'} = '' }
sub start_head3 { $_[0]{'Thispara'} = '' }
sub start_head4 { $_[0]{'Thispara'} = '' }
sub start_Verbatim { $_[0]{'Thispara'} = '' }
sub start_item_bullet { $_[0]{'Thispara'} = $FREAKYMODE ? '' : '* ' }
sub start_item_number { $_[0]{'Thispara'} = $FREAKYMODE ? '' : "$_[1]{'number'}. " }
sub start_item_text { $_[0]{'Thispara'} = '' }
sub start_over_bullet { ++$_[0]{'Indent'} }
sub start_over_number { ++$_[0]{'Indent'} }
sub start_over_text { ++$_[0]{'Indent'} }
sub start_over_block { ++$_[0]{'Indent'} }
sub end_over_bullet { --$_[0]{'Indent'} }
sub end_over_number { --$_[0]{'Indent'} }
sub end_over_text { --$_[0]{'Indent'} }
sub end_over_block { --$_[0]{'Indent'} }
# . . . . . Now the actual formatters:
sub end_head1 { $_[0]->emit_par(-4) }
sub end_head2 { $_[0]->emit_par(-3) }
sub end_head3 { $_[0]->emit_par(-2) }
sub end_head4 { $_[0]->emit_par(-1) }
sub end_Para { $_[0]->emit_par( 0) }
sub end_item_bullet { $_[0]->emit_par( 0) }
sub end_item_number { $_[0]->emit_par( 0) }
sub end_item_text { $_[0]->emit_par(-2) }
sub start_L { $_[0]{'Link'} = $_[1] if $_[1]->{type} eq 'url' }
sub end_L {
if (my $link = delete $_[0]{'Link'}) {
# Append the URL to the output unless it's already present.
$_[0]{'Thispara'} .= " <$link->{to}>"
unless $_[0]{'Thispara'} =~ /\b\Q$link->{to}/;
}
}
sub emit_par {
my($self, $tweak_indent) = splice(@_,0,2);
my $indent = ' ' x ( 2 * $self->{'Indent'} + 4 + ($tweak_indent||0) );
# Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0
$self->{'Thispara'} =~ s/$Pod::Simple::shy//g;
local $Text::Wrap::huge = 'overflow';
my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n");
$out =~ s/$Pod::Simple::nbsp/ /g;
print {$self->{'output_fh'}} $out, "\n";
$self->{'Thispara'} = '';
return;
}
# . . . . . . . . . . And then off by its lonesome:
sub end_Verbatim {
my $self = shift;
$self->{'Thispara'} =~ s/$Pod::Simple::nbsp/ /g;
$self->{'Thispara'} =~ s/$Pod::Simple::shy//g;
my $i = ' ' x ( 2 * $self->{'Indent'} + 4);
#my $i = ' ' x (4 + $self->{'Indent'});
$self->{'Thispara'} =~ s/^/$i/mg;
print { $self->{'output_fh'} } '',
$self->{'Thispara'},
"\n\n"
;
$self->{'Thispara'} = '';
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::Text -- format Pod as plaintext
=head1 SYNOPSIS
perl -MPod::Simple::Text -e \
"exit Pod::Simple::Text->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
This class is a formatter that takes Pod and renders it as
wrapped plaintext.
Its wrapping is done by L<Text::Wrap>, so you can change
C<$Text::Wrap::columns> as you like.
This is a subclass of L<Pod::Simple> and inherits all its methods.
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::TextContent>, L<Pod::Text>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

107
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/TextContent.pm Normal file
View file

@ -0,0 +1,107 @@
package Pod::Simple::TextContent;
use strict;
use warnings;
use Carp ();
use Pod::Simple ();
our $VERSION = '3.45';
our @ISA = ('Pod::Simple');
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->nix_X_codes(1);
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub _handle_element_start {
print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s;
return;
}
sub _handle_text {
$_[1] =~ s/$Pod::Simple::shy//g;
$_[1] =~ s/$Pod::Simple::nbsp/ /g;
print {$_[0]{'output_fh'}} $_[1];
return;
}
sub _handle_element_end {
print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s;
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::TextContent -- get the text content of Pod
=head1 SYNOPSIS
TODO
perl -MPod::Simple::TextContent -e \
"exit Pod::Simple::TextContent->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
This class is that parses Pod and dumps just the text content. It is
mainly meant for use by the Pod::Simple test suite, but you may find
some other use for it.
This is a subclass of L<Pod::Simple> and inherits all its methods.
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<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
=cut

104
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/TiedOutFH.pm Normal file
View file

@ -0,0 +1,104 @@
package Pod::Simple::TiedOutFH;
use strict;
use warnings;
use Symbol ('gensym');
use Carp ();
our $VERSION = '3.45';
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub handle_on { # some horrible frightening things are encapsulated in here
my $class = shift;
$class = ref($class) || $class;
Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;
my $x = (defined($_[0]) and ref($_[0]))
? $_[0]
: ( \( $_[0] ) )[0]
;
$$x = '' unless defined $$x;
#Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n";
my $new = gensym();
tie *$new, $class, $x;
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub TIEHANDLE { # Ties to just a scalar ref
my($class, $scalar_ref) = @_;
$$scalar_ref = '' unless defined $$scalar_ref;
return bless \$scalar_ref, ref($class) || $class;
}
sub PRINT {
my $it = shift;
foreach my $x (@_) { $$$it .= $x }
#Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n";
return 1;
}
sub FETCH {
return ${$_[0]};
}
sub PRINTF {
my $it = shift;
my $format = shift;
$$$it .= sprintf $format, @_;
return 1;
}
sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number
sub CLOSE { 1 }
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
__END__
Chole
* 1 large red onion
* 2 tomatillos
* 4 or 5 roma tomatoes (optionally with the pulp discarded)
* 1 tablespoons chopped ginger root (or more, to taste)
* 2 tablespoons canola oil (or vegetable oil)
* 1 tablespoon garam masala
* 1/2 teaspoon red chili powder, or to taste
* Salt, to taste (probably quite a bit)
* 2 (15-ounce) cans chick peas or garbanzo beans, drained and rinsed
* juice of one smallish lime
* a dash of balsamic vinegar (to taste)
* cooked rice, preferably long-grain white rice (whether plain,
basmati rice, jasmine rice, or even a mild pilaf)
In a blender or food processor, puree the onions, tomatoes, tomatillos,
and ginger root. You can even do it with a Braun hand "mixer", if you
chop things finer to start with, and work at it.
In a saucepan set over moderate heat, warm the oil until hot.
Add the puree and the balsamic vinegar, and cook, stirring occasionally,
for 20 to 40 minutes. (Cooking it longer will make it sweeter.)
Add the Garam Masala, chili powder, and cook, stirring occasionally, for
5 minutes.
Add the salt and chick peas and cook, stirring, until heated through.
Stir in the lime juice, and optionally one or two teaspoons of tahini.
You can let it simmer longer, depending on how much softer you want the
garbanzos to get.
Serve over rice, like a curry.
Yields 5 to 7 servings.

34
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/Transcode.pm Normal file
View file

@ -0,0 +1,34 @@
package Pod::Simple::Transcode;
use strict;
our $VERSION = '3.45';
BEGIN {
if(defined &DEBUG) {;} # Okay
elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG; }
else { *DEBUG = sub () {0}; }
}
our @ISA;
foreach my $class (
'Pod::Simple::TranscodeSmart',
'Pod::Simple::TranscodeDumb',
'',
) {
$class or die "Couldn't load any encoding classes";
DEBUG and print STDERR "About to try loading $class...\n";
eval "require $class;";
if($@) {
DEBUG and print STDERR "Couldn't load $class: $@\n";
} else {
DEBUG and print STDERR "OK, loaded $class.\n";
@ISA = ($class);
last;
}
}
sub _blorp { return; } # just to avoid any "empty class" warning
1;
__END__

82
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/TranscodeDumb.pm Normal file
View file

@ -0,0 +1,82 @@
package Pod::Simple::TranscodeDumb;
use strict;
our $VERSION = '3.45';
# This module basically pretends it knows how to transcode, except
# only for null-transcodings! We use this when Encode isn't
# available.
our %Supported = (
'ascii' => 1,
'ascii-ctrl' => 1,
'iso-8859-1' => 1,
'cp1252' => 1,
'null' => 1,
'latin1' => 1,
'latin-1' => 1,
%Supported,
);
sub is_dumb {1}
sub is_smart {0}
sub all_encodings {
return sort keys %Supported;
}
sub encoding_is_available {
return exists $Supported{lc $_[1]};
}
sub encmodver {
return __PACKAGE__ . " v" .($VERSION || '?');
}
sub make_transcoder {
my ($e) = $_[1];
die "WHAT ENCODING!?!?" unless $e;
# No-op for all but CP1252.
return sub {;} if $e !~ /^cp-?1252$/i;
# Replace CP1252 nerbles with their ASCII equivalents.
return sub {
# Copied from Encode::ZapCP1252.
my %ascii_for = (
# http://en.wikipedia.org/wiki/Windows-1252
"\x80" => 'e', # EURO SIGN
"\x82" => ',', # SINGLE LOW-9 QUOTATION MARK
"\x83" => 'f', # LATIN SMALL LETTER F WITH HOOK
"\x84" => ',,', # DOUBLE LOW-9 QUOTATION MARK
"\x85" => '...', # HORIZONTAL ELLIPSIS
"\x86" => '+', # DAGGER
"\x87" => '++', # DOUBLE DAGGER
"\x88" => '^', # MODIFIER LETTER CIRCUMFLEX ACCENT
"\x89" => '%', # PER MILLE SIGN
"\x8a" => 'S', # LATIN CAPITAL LETTER S WITH CARON
"\x8b" => '<', # SINGLE LEFT-POINTING ANGLE QUOTATION MARK
"\x8c" => 'OE', # LATIN CAPITAL LIGATURE OE
"\x8e" => 'Z', # LATIN CAPITAL LETTER Z WITH CARON
"\x91" => "'", # LEFT SINGLE QUOTATION MARK
"\x92" => "'", # RIGHT SINGLE QUOTATION MARK
"\x93" => '"', # LEFT DOUBLE QUOTATION MARK
"\x94" => '"', # RIGHT DOUBLE QUOTATION MARK
"\x95" => '*', # BULLET
"\x96" => '-', # EN DASH
"\x97" => '--', # EM DASH
"\x98" => '~', # SMALL TILDE
"\x99" => '(tm)', # TRADE MARK SIGN
"\x9a" => 's', # LATIN SMALL LETTER S WITH CARON
"\x9b" => '>', # SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
"\x9c" => 'oe', # LATIN SMALL LIGATURE OE
"\x9e" => 'z', # LATIN SMALL LETTER Z WITH CARON
"\x9f" => 'Y', # LATIN CAPITAL LETTER Y WITH DIAERESIS
);
s{([\x80-\x9f])}{$ascii_for{$1} || $1}emxsg for @_;
};
}
1;
use warnings;

42
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/TranscodeSmart.pm Normal file
View file

@ -0,0 +1,42 @@
use 5.008;
## Anything before 5.8.0 is GIMPY!
## This module is to be use()'d only by Pod::Simple::Transcode
package Pod::Simple::TranscodeSmart;
use strict;
use warnings;
use Pod::Simple;
use Encode;
our $VERSION = '3.45';
sub is_dumb {0}
sub is_smart {1}
sub all_encodings {
return Encode::->encodings(':all');
}
sub encoding_is_available {
return Encode::resolve_alias($_[1]);
}
sub encmodver {
return "Encode.pm v" .($Encode::VERSION || '?');
}
sub make_transcoder {
my $e = Encode::find_encoding($_[1]);
die "WHAT ENCODING!?!?" unless $e;
my $x;
return sub {
foreach $x (@_) {
$x = $e->decode($x) unless Encode::is_utf8($x);
}
return;
};
}
1;

932
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/XHTML.pm Normal file
View file

@ -0,0 +1,932 @@
=pod
=head1 NAME
Pod::Simple::XHTML -- format Pod as validating XHTML
=head1 SYNOPSIS
use Pod::Simple::XHTML;
my $parser = Pod::Simple::XHTML->new();
...
$parser->parse_file('path/to/file.pod');
=head1 DESCRIPTION
This class is a formatter that takes Pod and renders it as XHTML
validating HTML.
This is a subclass of L<Pod::Simple::Methody> and inherits all its
methods. The implementation is entirely different than
L<Pod::Simple::HTML>, but it largely preserves the same interface.
=head2 Minimal code
use Pod::Simple::XHTML;
my $psx = Pod::Simple::XHTML->new;
$psx->output_string(\my $html);
$psx->parse_file('path/to/Module/Name.pm');
open my $out, '>', 'out.html' or die "Cannot open 'out.html': $!\n";
print $out $html;
You can also control the character encoding and entities. For example, if
you're sure that the POD is properly encoded (using the C<=encoding> command),
you can prevent high-bit characters from being encoded as HTML entities and
declare the output character set as UTF-8 before parsing, like so:
$psx->html_charset('UTF-8');
use warnings;
$psx->html_encode_chars(q{&<>'"});
=cut
package Pod::Simple::XHTML;
use strict;
our $VERSION = '3.45';
use Pod::Simple::Methody ();
our @ISA = ('Pod::Simple::Methody');
our $HAS_HTML_ENTITIES;
BEGIN {
$HAS_HTML_ENTITIES = eval "require HTML::Entities; 1";
}
my %entities = (
q{>} => 'gt',
q{<} => 'lt',
q{'} => '#39',
q{"} => 'quot',
q{&} => 'amp',
);
sub encode_entities {
my $self = shift;
my $ents = $self->html_encode_chars;
return HTML::Entities::encode_entities( $_[0], $ents ) if $HAS_HTML_ENTITIES;
if (defined $ents) {
$ents =~ s,(?<!\\)([]/]),\\$1,g;
$ents =~ s,(?<!\\)\\\z,\\\\,;
} else {
$ents = join '', keys %entities;
}
my $str = $_[0];
$str =~ s/([$ents])/'&' . ($entities{$1} || sprintf '#x%X', ord $1) . ';'/ge;
return $str;
}
my %entity_to_char = reverse %entities;
my ($entity_re) = map qr{$_}, join '|', map quotemeta, sort keys %entity_to_char;
sub decode_entities {
my ($self, $string) = @_;
return HTML::Entities::decode_entities( $string ) if $HAS_HTML_ENTITIES;
$string =~ s{&(?:($entity_re)|#x([0123456789abcdefABCDEF]+)|#([0123456789]+));}{
defined $1 ? $entity_to_char{$1}
: defined $2 ? chr(hex($2))
: defined $3 ? chr($3)
: die;
}ge;
return $string;
}
sub encode_url {
my ($self, $string) = @_;
$string =~ s{([^-_.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZZ0123456789])}{
sprintf('%%%02X', ord($1))
}eg;
return $string;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=head1 METHODS
Pod::Simple::XHTML offers a number of methods that modify the format of
the HTML output. Call these after creating the parser object, but before
the call to C<parse_file>:
my $parser = Pod::PseudoPod::HTML->new();
$parser->set_optional_param("value");
$parser->parse_file($file);
=head2 perldoc_url_prefix
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/".
=head2 perldoc_url_postfix
What to put after "Foo%3a%3aBar" in the URL. This option is not set by
default.
=head2 man_url_prefix
In turning C<< L<crontab(5)> >> into http://whatever/man/1/crontab, what
to put before the "1/crontab". The default value is
"http://man.he.net/man".
=head2 man_url_postfix
What to put after "1/crontab" in the URL. This option is not set by default.
=head2 title_prefix, title_postfix
What to put before and after the title in the head. The values should
already be &-escaped.
=head2 html_css
$parser->html_css('path/to/style.css');
The URL or relative path of a CSS file to include. This option is not
set by default.
=head2 html_javascript
The URL or relative path of a JavaScript file to pull in. This option is
not set by default.
=head2 html_doctype
A document type tag for the file. This option is not set by default.
=head2 html_charset
The character set to declare in the Content-Type meta tag created by default
for C<html_header_tags>. Note that this option will be ignored if the value of
C<html_header_tags> is changed. Defaults to "ISO-8859-1".
=head2 html_header_tags
Additional arbitrary HTML tags for the header of the document. The
default value is just a content type header tag:
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
Add additional meta tags here, or blocks of inline CSS or JavaScript
(wrapped in the appropriate tags).
=head3 html_encode_chars
A string containing all characters that should be encoded as HTML entities,
specified using the regular expression character class syntax (what you find
within brackets in regular expressions). This value will be passed as the
second argument to the C<encode_entities> function of L<HTML::Entities>. If
L<HTML::Entities> is not installed, then any characters other than C<&<>"'>
will be encoded numerically.
=head2 html_h_level
This is the level of HTML "Hn" element to which a Pod "head1" corresponds. For
example, if C<html_h_level> is set to 2, a head1 will produce an H2, a head2
will produce an H3, and so on.
=head2 default_title
Set a default title for the page if no title can be determined from the
content. The value of this string should already be &-escaped.
=head2 force_title
Force a title for the page (don't try to determine it from the content).
The value of this string should already be &-escaped.
=head2 html_header, html_footer
Set the HTML output at the beginning and end of each file. The default
header includes a title, a doctype tag (if C<html_doctype> is set), a
content tag (customized by C<html_header_tags>), a tag for a CSS file
(if C<html_css> is set), and a tag for a Javascript file (if
C<html_javascript> is set). The default footer simply closes the C<html>
and C<body> tags.
The options listed above customize parts of the default header, but
setting C<html_header> or C<html_footer> completely overrides the
built-in header or footer. These may be useful if you want to use
template tags instead of literal HTML headers and footers or are
integrating converted POD pages in a larger website.
If you want no headers or footers output in the HTML, set these options
to the empty string.
=head2 index
Whether to add a table-of-contents at the top of each page (called an
index for the sake of tradition).
=head2 anchor_items
Whether to anchor every definition C<=item> directive. This needs to be
enabled if you want to be able to link to specific C<=item> directives, which
are output as C<< <dt> >> elements. Disabled by default.
=head2 backlink
Whether to turn every =head1 directive into a link pointing to the top
of the page (specifically, the opening body tag).
=cut
__PACKAGE__->_accessorize(
'perldoc_url_prefix',
'perldoc_url_postfix',
'man_url_prefix',
'man_url_postfix',
'title_prefix', 'title_postfix',
'html_css',
'html_javascript',
'html_doctype',
'html_charset',
'html_encode_chars',
'html_h_level',
'title', # Used internally for the title extracted from the content
'default_title',
'force_title',
'html_header',
'html_footer',
'index',
'anchor_items',
'backlink',
'batch_mode', # whether we're in batch mode
'batch_mode_current_level',
# When in batch mode, how deep the current module is: 1 for "LWP",
# 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=head1 SUBCLASSING
If the standard options aren't enough, you may want to subclass
Pod::Simple::XHMTL. These are the most likely candidates for methods
you'll want to override when subclassing.
=cut
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->perldoc_url_prefix('https://metacpan.org/pod/');
$new->man_url_prefix('http://man.he.net/man');
$new->html_charset('ISO-8859-1');
$new->nix_X_codes(1);
$new->{'scratch'} = '';
$new->{'to_index'} = [];
$new->{'output'} = [];
$new->{'saved'} = [];
$new->{'ids'} = { '_podtop_' => 1 }; # used in <body>
$new->{'in_li'} = [];
$new->{'__region_targets'} = [];
$new->{'__literal_targets'} = {};
$new->accept_targets_as_html( 'html', 'HTML' );
return $new;
}
sub html_header_tags {
my $self = shift;
return $self->{html_header_tags} = shift if @_;
return $self->{html_header_tags}
||= '<meta http-equiv="Content-Type" content="text/html; charset='
. $self->html_charset . '" />';
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=head2 handle_text
This method handles the body of text within any element: it's the body
of a paragraph, or everything between a "=begin" tag and the
corresponding "=end" tag, or the text within an L entity, etc. You would
want to override this if you are adding a custom element type that does
more than just display formatted text. Perhaps adding a way to generate
HTML tables from an extended version of POD.
So, let's say you want to add a custom element called 'foo'. In your
subclass's C<new> method, after calling C<SUPER::new> you'd call:
$new->accept_targets_as_text( 'foo' );
Then override the C<start_for> method in the subclass to check for when
"$flags->{'target'}" is equal to 'foo' and set a flag that marks that
you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the
C<handle_text> method to check for the flag, and pass $text to your
custom subroutine to construct the HTML output for 'foo' elements,
something like:
sub handle_text {
my ($self, $text) = @_;
if ($self->{'in_foo'}) {
$self->{'scratch'} .= build_foo_html($text);
return;
}
$self->SUPER::handle_text($text);
}
=head2 handle_code
This method handles the body of text that is marked up to be code.
You might for instance override this to plug in a syntax highlighter.
The base implementation just escapes the text.
The callback methods C<start_code> and C<end_code> emits the C<code> tags
before and after C<handle_code> is invoked, so you might want to override these
together with C<handle_code> if this wrapping isn't suitable.
Note that the code might be broken into multiple segments if there are
nested formatting codes inside a C<< CE<lt>...> >> sequence. In between the
calls to C<handle_code> other markup tags might have been emitted in that
case. The same is true for verbatim sections if the C<codes_in_verbatim>
option is turned on.
=head2 accept_targets_as_html
This method behaves like C<accept_targets_as_text>, but also marks the region
as one whose content should be emitted literally, without HTML entity escaping
or wrapping in a C<div> element.
=cut
sub __in_literal_xhtml_region {
return unless @{ $_[0]{__region_targets} };
my $target = $_[0]{__region_targets}[-1];
return $_[0]{__literal_targets}{ $target };
}
sub accept_targets_as_html {
my ($self, @targets) = @_;
$self->accept_targets(@targets);
$self->{__literal_targets}{$_} = 1 for @targets;
}
sub handle_text {
# escape special characters in HTML (<, >, &, etc)
my $text = $_[1];
my $html;
if ($_[0]->__in_literal_xhtml_region) {
$html = $text;
$text =~ s{<[^>]+?>}{}g;
$text = $_[0]->decode_entities($text);
}
else {
$html = $_[0]->encode_entities($text);
}
if ($_[0]{'in_code'} && @{$_[0]{'in_code'}}) {
# Intentionally use the raw text in $_[1], even if we're not in a
# literal xhtml region, since handle_code calls encode_entities.
$_[0]->handle_code( $_[1], $_[0]{'in_code'}[-1] );
} else {
if ($_[0]->{in_for}) {
my $newlines = $_[0]->__in_literal_xhtml_region ? "\n\n" : '';
if ($_[0]->{started_for}) {
if ($html =~ /\S/) {
delete $_[0]->{started_for};
$_[0]{'scratch'} .= $html . $newlines;
}
# Otherwise, append nothing until we have something to append.
} else {
# The parser sometimes preserves newlines and sometimes doesn't!
$html =~ s/\n\z//;
$_[0]{'scratch'} .= $html . $newlines;
}
} else {
# Just plain text.
$_[0]{'scratch'} .= $html;
}
}
$_[0]{hhtml} .= $html if $_[0]{'in_head'};
$_[0]{htext} .= $text if $_[0]{'in_head'};
$_[0]{itext} .= $text if $_[0]{'in_item_text'};
}
sub start_code {
$_[0]{'scratch'} .= '<code>';
}
sub end_code {
$_[0]{'scratch'} .= '</code>';
}
sub handle_code {
$_[0]{'scratch'} .= $_[0]->encode_entities( $_[1] );
}
sub start_Para {
$_[0]{'scratch'} .= '<p>';
}
sub start_Verbatim {
$_[0]{'scratch'} = '<pre>';
push(@{$_[0]{'in_code'}}, 'Verbatim');
$_[0]->start_code($_[0]{'in_code'}[-1]);
}
sub start_head1 { $_[0]{'in_head'} = 1; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_head2 { $_[0]{'in_head'} = 2; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_head3 { $_[0]{'in_head'} = 3; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_head4 { $_[0]{'in_head'} = 4; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_head5 { $_[0]{'in_head'} = 5; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_head6 { $_[0]{'in_head'} = 6; $_[0]{htext} = $_[0]{hhtml} = ''; }
sub start_item_number {
$_[0]{'scratch'} = "</li>\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}});
$_[0]{'scratch'} .= '<li><p>';
push @{$_[0]{'in_li'}}, 1;
}
sub start_item_bullet {
$_[0]{'scratch'} = "</li>\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}});
$_[0]{'scratch'} .= '<li><p>';
push @{$_[0]{'in_li'}}, 1;
}
sub start_item_text {
$_[0]{'in_item_text'} = 1; $_[0]{itext} = '';
# see end_item_text
}
sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; push @{$_[0]{'in_li'}}, 0; $_[0]->emit }
sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
sub start_over_number { $_[0]{'scratch'} = '<ol>'; push @{$_[0]{'in_li'}}, 0; $_[0]->emit }
sub start_over_text {
$_[0]{'scratch'} = '<dl>';
$_[0]{'dl_level'}++;
$_[0]{'in_dd'} ||= [];
$_[0]->emit
}
sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
sub end_over_number {
$_[0]{'scratch'} = "</li>\n" if ( pop @{$_[0]{'in_li'}} );
$_[0]{'scratch'} .= '</ol>';
pop @{$_[0]{'in_li'}};
$_[0]->emit;
}
sub end_over_bullet {
$_[0]{'scratch'} = "</li>\n" if ( pop @{$_[0]{'in_li'}} );
$_[0]{'scratch'} .= '</ul>';
pop @{$_[0]{'in_li'}};
$_[0]->emit;
}
sub end_over_text {
if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) {
$_[0]{'scratch'} = "</dd>\n";
$_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0;
}
$_[0]{'scratch'} .= '</dl>';
$_[0]{'dl_level'}--;
$_[0]->emit;
}
# . . . . . Now the actual formatters:
sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
sub end_Verbatim {
$_[0]->end_code(pop(@{$_[0]->{'in_code'}}));
$_[0]{'scratch'} .= '</pre>';
$_[0]->emit;
}
sub _end_head {
my $h = delete $_[0]{in_head};
my $add = $_[0]->html_h_level;
$add = 1 unless defined $add;
$h += $add - 1;
my $id = $_[0]->idify(delete $_[0]{htext});
my $text = $_[0]{scratch};
my $head = qq{<h$h id="} . $_[0]->encode_entities($id) . qq{">$text</h$h>};
$_[0]{'scratch'} = $_[0]->backlink && ($h - $add == 0)
# backlinks enabled && =head1
? qq{<a href="#_podtop_">$head</a>}
: $head;
$_[0]->emit;
push @{ $_[0]{'to_index'} }, [$h, $id, delete $_[0]{'hhtml'}];
}
sub end_head1 { shift->_end_head(@_); }
sub end_head2 { shift->_end_head(@_); }
sub end_head3 { shift->_end_head(@_); }
sub end_head4 { shift->_end_head(@_); }
sub end_head5 { shift->_end_head(@_); }
sub end_head6 { shift->_end_head(@_); }
sub end_item_bullet { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
sub end_item_number { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
sub end_item_text {
# idify and anchor =item content if wanted
my $dt_id = $_[0]{'anchor_items'}
? ' id="'. $_[0]->encode_entities($_[0]->idify($_[0]{'itext'})) .'"'
: '';
# reset scratch
my $text = $_[0]{scratch};
$_[0]{'scratch'} = '';
if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) {
$_[0]{'scratch'} = "</dd>\n";
$_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0;
}
$_[0]{'scratch'} .= qq{<dt$dt_id>$text</dt>\n<dd>};
$_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 1;
$_[0]->emit;
}
# This handles =begin and =for blocks of all kinds.
sub start_for {
my ($self, $flags) = @_;
push @{ $self->{__region_targets} }, $flags->{target_matching};
$self->{started_for} = 1;
$self->{in_for} = 1;
unless ($self->__in_literal_xhtml_region) {
$self->{scratch} .= '<div';
$self->{scratch} .= qq( class="$flags->{target}") if $flags->{target};
$self->{scratch} .= ">\n\n";
}
}
sub end_for {
my ($self) = @_;
delete $self->{started_for};
delete $self->{in_for};
if ($self->__in_literal_xhtml_region) {
# Remove trailine newlines.
$self->{'scratch'} =~ s/\s+\z//s;
} else {
$self->{'scratch'} .= '</div>';
}
pop @{ $self->{__region_targets} };
$self->emit;
}
sub start_Document {
my ($self) = @_;
if (defined $self->html_header) {
$self->{'scratch'} .= $self->html_header;
$self->emit unless $self->html_header eq "";
} else {
my ($doctype, $title, $metatags, $bodyid);
$doctype = $self->html_doctype || '';
$title = $self->force_title || $self->title || $self->default_title || '';
$metatags = $self->html_header_tags || '';
if (my $css = $self->html_css) {
if ($css !~ /<link/) {
# this is required to be compatible with Pod::Simple::BatchHTML
$metatags .= '<link rel="stylesheet" href="'
. $self->encode_entities($css) . '" type="text/css" />';
} else {
$metatags .= $css;
}
}
if ($self->html_javascript) {
$metatags .= qq{\n<script type="text/javascript" src="} .
$self->html_javascript . '"></script>';
}
$bodyid = $self->backlink ? ' id="_podtop_"' : '';
$self->{'scratch'} .= <<"HTML";
$doctype
<html>
<head>
<title>$title</title>
$metatags
</head>
<body$bodyid>
HTML
$self->emit;
}
}
sub build_index {
my ($self, $to_index) = @_;
my @out;
my $level = 0;
my $indent = -1;
my $space = '';
my $id = ' id="index"';
for my $h (@{ $to_index }, [0]) {
my $target_level = $h->[0];
# Get to target_level by opening or closing ULs
if ($level == $target_level) {
$out[-1] .= '</li>';
} elsif ($level > $target_level) {
$out[-1] .= '</li>' if $out[-1] =~ /^\s+<li>/;
while ($level > $target_level) {
--$level;
push @out, (' ' x --$indent) . '</li>' if @out && $out[-1] =~ m{^\s+<\/ul};
push @out, (' ' x --$indent) . '</ul>';
}
push @out, (' ' x --$indent) . '</li>' if $level;
} else {
while ($level < $target_level) {
++$level;
push @out, (' ' x ++$indent) . '<li>' if @out && $out[-1]=~ /^\s*<ul/;
push @out, (' ' x ++$indent) . "<ul$id>";
$id = '';
}
++$indent;
}
next unless $level;
$space = ' ' x $indent;
my $fragment = $self->encode_entities($self->encode_url($h->[1]));
push @out, sprintf '%s<li><a href="#%s">%s</a>',
$space, $fragment, $h->[2];
}
return join "\n", @out;
}
sub end_Document {
my ($self) = @_;
my $to_index = $self->{'to_index'};
if ($self->index && @{ $to_index } ) {
my $index = $self->build_index($to_index);
# Splice the index in between the HTML headers and the first element.
my $offset = defined $self->html_header ? $self->html_header eq '' ? 0 : 1 : 1;
splice @{ $self->{'output'} }, $offset, 0, $index;
}
if (defined $self->html_footer) {
$self->{'scratch'} .= $self->html_footer;
$self->emit unless $self->html_footer eq "";
} else {
$self->{'scratch'} .= "</body>\n</html>";
$self->emit;
}
if ($self->index) {
print {$self->{'output_fh'}} join ("\n\n", @{ $self->{'output'} }), "\n\n";
@{$self->{'output'}} = ();
}
}
# Handling code tags
sub start_B { $_[0]{'scratch'} .= '<b>' }
sub end_B { $_[0]{'scratch'} .= '</b>' }
sub start_C { push(@{$_[0]{'in_code'}}, 'C'); $_[0]->start_code($_[0]{'in_code'}[-1]); }
sub end_C { $_[0]->end_code(pop(@{$_[0]{'in_code'}})); }
sub start_F { $_[0]{'scratch'} .= '<i>' }
sub end_F { $_[0]{'scratch'} .= '</i>' }
sub start_I { $_[0]{'scratch'} .= '<i>' }
sub end_I { $_[0]{'scratch'} .= '</i>' }
sub start_L {
my ($self, $flags) = @_;
my ($type, $to, $section) = @{$flags}{'type', 'to', 'section'};
my $url = $self->encode_entities(
$type eq 'url' ? $to
: $type eq 'pod' ? $self->resolve_pod_page_link($to, $section)
: $type eq 'man' ? $self->resolve_man_page_link($to, $section)
: undef
);
# If it's an unknown type, use an attribute-less <a> like HTML.pm.
$self->{'scratch'} .= '<a' . ($url ? ' href="'. $url . '">' : '>');
}
sub end_L { $_[0]{'scratch'} .= '</a>' }
sub start_S { $_[0]{'scratch'} .= '<span style="white-space: nowrap;">' }
sub end_S { $_[0]{'scratch'} .= '</span>' }
sub emit {
my($self) = @_;
if ($self->index) {
push @{ $self->{'output'} }, $self->{'scratch'};
} else {
print {$self->{'output_fh'}} $self->{'scratch'}, "\n\n";
}
$self->{'scratch'} = '';
return;
}
=head2 resolve_pod_page_link
my $url = $pod->resolve_pod_page_link('Net::Ping', 'INSTALL');
my $url = $pod->resolve_pod_page_link('perlpodspec');
my $url = $pod->resolve_pod_page_link(undef, 'SYNOPSIS');
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
#SYNOPSIS
Note that when there is only a section argument the URL will simply be a link
to a section in the current document.
=cut
sub resolve_pod_page_link {
my ($self, $to, $section) = @_;
return undef unless defined $to || defined $section;
if (defined $section) {
my $id = $self->idify($section, 1);
$section = '#' . $self->encode_url($id);
return $section unless defined $to;
} else {
$section = ''
}
return ($self->perldoc_url_prefix || '')
. $to . $section
. ($self->perldoc_url_postfix || '');
}
=head2 resolve_man_page_link
my $url = $pod->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE');
my $url = $pod->resolve_man_page_link('crontab');
Resolves a man page link target and numeric section to a URL. The resulting
link will be returned for the above examples as:
http://man.he.net/man5/crontab
http://man.he.net/man1/crontab
Note that the first argument is required. The section number will be parsed
from it, and if it's missing will default to 1. The second argument is
currently ignored, as L<man.he.net|http://man.he.net> does not currently
include linkable IDs or anchor names in its pages. Subclass to link to a
different man page HTTP server.
=cut
sub resolve_man_page_link {
my ($self, $to, $section) = @_;
return undef unless defined $to;
my ($page, $part) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/;
return undef unless $page;
return ($self->man_url_prefix || '')
. ($part || 1) . "/" . $self->encode_entities($page)
. ($self->man_url_postfix || '');
}
=head2 idify
my $id = $pod->idify($text);
my $hash = $pod->idify($text, 1);
This method turns an arbitrary string into a valid XHTML ID attribute value.
The rules enforced, following
L<http://webdesign.about.com/od/htmltags/a/aa031707.htm>, are:
=over
=item *
The id must start with a letter (a-z or A-Z)
=item *
All subsequent characters can be letters, numbers (0-9), hyphens (-),
underscores (_), colons (:), and periods (.).
=item *
The final character can't be a hyphen, colon, or period. URLs ending with these
characters, while allowed by XHTML, can be awkward to extract from plain text.
=item *
Each id must be unique within the document.
=back
In addition, the returned value will be unique within the context of the
Pod::Simple::XHTML object unless a second argument is passed a true value. ID
attributes should always be unique within a single XHTML document, but pass
the true value if you are creating not an ID but a URL hash to point to
an ID (i.e., if you need to put the "#foo" in C<< <a href="#foo">foo</a> >>.
=cut
sub idify {
my ($self, $t, $not_unique) = @_;
for ($t) {
s/[<>&'"]//g; # Strip HTML special characters
s/^\s+//; s/\s+$//; # Strip white space.
s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
s/^[^a-zA-Z]+//; # First char must be a letter.
s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
s/[-:.]+$//; # Strip trailing punctuation.
}
return $t if $not_unique;
my $i = '';
$i++ while $self->{ids}{"$t$i"}++;
return "$t$i";
}
=head2 batch_mode_page_object_init
$pod->batch_mode_page_object_init($batchconvobj, $module, $infile, $outfile, $depth);
Called by L<Pod::Simple::HTMLBatch> so that the class has a chance to
initialize the converter. Internally it sets the C<batch_mode> property to
true and sets C<batch_mode_current_level()>, but Pod::Simple::XHTML does not
currently use those features. Subclasses might, though.
=cut
sub batch_mode_page_object_init {
my ($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_;
$self->batch_mode(1);
$self->batch_mode_current_level($depth);
return $self;
}
sub html_header_after_title {
}
1;
__END__
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<bug-pod-simple@rt.cpan.org>.
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2003-2005 Allison Randal.
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 ACKNOWLEDGEMENTS
Thanks to L<Hurricane Electric|http://he.net/> for permission to use its
L<Linux man pages online|http://man.he.net/> site for man page links.
Thanks to L<search.cpan.org|http://search.cpan.org/> for permission to use the
site for Perl module links.
=head1 AUTHOR
Pod::Simpele::XHTML was created by Allison Randal <allison@perl.org>.
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
=cut

175
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Simple/XMLOutStream.pm Normal file
View file

@ -0,0 +1,175 @@
package Pod::Simple::XMLOutStream;
use strict;
use warnings;
use Carp ();
use Pod::Simple ();
our $VERSION = '3.45';
BEGIN {
our @ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
}
our $ATTR_PAD;
$ATTR_PAD = "\n" unless defined $ATTR_PAD;
# Don't mess with this unless you know what you're doing.
our $SORT_ATTRS;
$SORT_ATTRS = 0 unless defined $SORT_ATTRS;
sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
$new->keep_encoding_directive(1);
#$new->accept_codes('VerbatimFormatted');
return $new;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub _handle_element_start {
# ($self, $element_name, $attr_hash_r)
my $fh = $_[0]{'output_fh'};
my($key, $value);
DEBUG and print STDERR "++ $_[1]\n";
print $fh "<", $_[1];
if($SORT_ATTRS) {
foreach my $key (sort keys %{$_[2]}) {
unless($key =~ m/^~/s) {
next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
_xml_escape($value = $_[2]{$key});
print $fh $ATTR_PAD, $key, '="', $value, '"';
}
}
} else { # faster
while(($key,$value) = each %{$_[2]}) {
unless($key =~ m/^~/s) {
next if $key eq 'start_line' and $_[0]{'hide_line_numbers'};
_xml_escape($value);
print $fh $ATTR_PAD, $key, '="', $value, '"';
}
}
}
print $fh ">";
return;
}
sub _handle_text {
DEBUG and print STDERR "== \"$_[1]\"\n";
if(length $_[1]) {
my $text = $_[1];
_xml_escape($text);
print {$_[0]{'output_fh'}} $text;
}
return;
}
sub _handle_element_end {
DEBUG and print STDERR "-- $_[1]\n";
print {$_[0]{'output_fh'}} "</", $_[1], ">";
return;
}
# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub _xml_escape {
foreach my $x (@_) {
# Escape things very cautiously:
if ($] ge 5.007_003) {
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg;
} else { # Is broken for non-ASCII platforms on early perls
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg;
}
# Yes, stipulate the list without a range, so that this can work right on
# all charsets that this module happens to run under.
}
return;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;
__END__
=head1 NAME
Pod::Simple::XMLOutStream -- turn Pod into XML
=head1 SYNOPSIS
perl -MPod::Simple::XMLOutStream -e \
"exit Pod::Simple::XMLOutStream->filter(shift)->any_errata_seen" \
thingy.pod
=head1 DESCRIPTION
Pod::Simple::XMLOutStream is a subclass of L<Pod::Simple> that parses
Pod and turns it into XML.
Pod::Simple::XMLOutStream inherits methods from
L<Pod::Simple>.
=head1 SEE ALSO
L<Pod::Simple::DumpAsXML> is rather like this class; see its
documentation for a discussion of the differences.
L<Pod::Simple>, L<Pod::Simple::DumpAsXML>, L<Pod::SAX>
L<Pod::Simple::Subclassing>
The older (and possibly obsolete) libraries L<Pod::PXML>, L<Pod::XML>
=head1 ABOUT EXTENDING POD
TODO: An example or two of =extend, then point to Pod::Simple::Subclassing
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<https://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<bug-pod-simple@rt.cpan.org>.
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002-2004 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
=cut

1247
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Text.pm Normal file
View file

File diff suppressed because it is too large Load diff

212
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Text/Color.pm Normal file
View file

@ -0,0 +1,212 @@
# Convert POD data to formatted color ASCII text
#
# This is just a basic proof of concept. It should later be modified to make
# better use of color, take options changing what colors are used for what
# text, and the like.
#
# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
##############################################################################
# Modules and declarations
##############################################################################
package Pod::Text::Color;
use 5.010;
use strict;
use warnings;
use Pod::Text ();
use Term::ANSIColor qw(color colored);
our @ISA = qw(Pod::Text);
our $VERSION = '5.01_02';
$VERSION =~ tr/_//d;
##############################################################################
# Overrides
##############################################################################
# Make level one headings bold.
sub cmd_head1 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
local $Term::ANSIColor::EACHLINE = "\n";
$self->SUPER::cmd_head1 ($attrs, colored ($text, 'bold'));
}
# Make level two headings bold.
sub cmd_head2 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$self->SUPER::cmd_head2 ($attrs, colored ($text, 'bold'));
}
# Fix the various formatting codes.
sub cmd_b { return colored ($_[2], 'bold') }
sub cmd_f { return colored ($_[2], 'cyan') }
sub cmd_i { return colored ($_[2], 'yellow') }
# Analyze a single line and return any formatting codes in effect at the end
# of that line.
sub end_format {
my ($self, $line) = @_;
my $reset = color ('reset');
my $current;
while ($line =~ /(\e\[[\d;]+m)/g) {
my $code = $1;
if ($code eq $reset) {
undef $current;
} else {
$current .= $code;
}
}
return $current;
}
# Output any included code in green.
sub output_code {
my ($self, $code) = @_;
local $Term::ANSIColor::EACHLINE = "\n";
$code = colored ($code, 'green');
$self->output ($code);
}
# Strip all of the formatting from a provided string, returning the stripped
# version. We will eventually want to use colorstrip() from Term::ANSIColor,
# but it's fairly new so avoid the tight dependency.
sub strip_format {
my ($self, $text) = @_;
$text =~ s/\e\[[\d;]*m//g;
return $text;
}
# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the escape sequences.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{opt_width} - $$self{MARGIN};
# $codes matches a single special sequence. $char matches any number of
# special sequences preceding a single character other than a newline.
# $shortchar matches some sequence of $char ending in codes followed by
# whitespace or the end of the string. $longchar matches exactly $width
# $chars, used when we have to truncate and hard wrap.
my $code = '(?:\e\[[\d;]+m)';
my $char = "(?>$code*[^\\n])";
my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
my $longchar = '^(' . $char . "{$width})";
while (length > $width) {
if (s/$shortchar// || s/$longchar//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
# less -R always resets terminal attributes at the end of each line, so we
# need to clear attributes at the end of lines and then set them again at
# the start of the next line. This requires a second pass through the
# wrapped string, accumulating any attributes we see, remembering them,
# and then inserting the appropriate sequences at the newline.
if ($output =~ /\n/) {
my @lines = split (/\n/, $output);
my $start_format;
for my $line (@lines) {
if ($start_format && $line =~ /\S/) {
$line =~ s/^(\s*)(\S)/$1$start_format$2/;
}
$start_format = $self->end_format ($line);
if ($start_format) {
$line .= color ('reset');
}
}
$output = join ("\n", @lines);
}
# Fix up trailing whitespace and return the results.
$output =~ s/\s+$/\n\n/;
$output;
}
##############################################################################
# Module return value and documentation
##############################################################################
1;
__END__
=for stopwords
Allbery
=head1 NAME
Pod::Text::Color - Convert POD data to formatted color ASCII text
=head1 SYNOPSIS
use Pod::Text::Color;
my $parser = Pod::Text::Color->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::Text::Color is a simple subclass of Pod::Text that highlights output
text using ANSI color escape sequences. Apart from the color, it in all
ways functions like Pod::Text. See L<Pod::Text> for details and available
options.
Term::ANSIColor is used to get colors and therefore must be installed to use
this module.
=head1 COMPATIBILITY
Pod::Text::Color 0.05 (based on L<Pod::Parser>) was the first version of this
module included with Perl, in Perl 5.6.0.
The current API based on L<Pod::Simple> was added in Pod::Text::Color 2.00.
Pod::Text::Color 2.01 was included in Perl 5.9.3, the first version of Perl to
incorporate those changes.
Several problems with wrapping and line length were fixed as recently as
Pod::Text::Color 4.11, included in Perl 5.29.1.
This module inherits its API and most behavior from Pod::Text, so the details
in L<Pod::Text/COMPATIBILITY> also apply. Pod::Text and Pod::Text::Color have
had the same module version since 4.00, included in Perl 5.23.7. (They
unfortunately diverge in confusing ways prior to that.)
=head1 AUTHOR
Russ Allbery <rra@cpan.org>.
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2018-2019, 2022 Russ Allbery
<rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Simple>
The current version of this module is always available from its web site at
L<https://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=cut
# Local Variables:
# copyright-at-end-flag: t
# End:

219
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Text/Overstrike.pm Normal file
View file

@ -0,0 +1,219 @@
# Convert POD data to formatted overstrike text
#
# This was written because the output from:
#
# pod2text Text.pm > plain.txt; less plain.txt
#
# is not as rich as the output from
#
# pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
#
# and because both Pod::Text::Color and Pod::Text::Termcap are not device
# independent.
#
# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
##############################################################################
# Modules and declarations
##############################################################################
package Pod::Text::Overstrike;
use 5.010;
use strict;
use warnings;
use Pod::Text ();
our @ISA = qw(Pod::Text);
our $VERSION = '5.01_02';
$VERSION =~ tr/_//d;
##############################################################################
# Overrides
##############################################################################
# Make level one headings bold, overriding any existing formatting.
sub cmd_head1 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$text = $self->strip_format ($text);
$text =~ s/(.)/$1\b$1/g;
return $self->SUPER::cmd_head1 ($attrs, $text);
}
# Make level two headings bold, overriding any existing formatting.
sub cmd_head2 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$text = $self->strip_format ($text);
$text =~ s/(.)/$1\b$1/g;
return $self->SUPER::cmd_head2 ($attrs, $text);
}
# Make level three headings underscored, overriding any existing formatting.
sub cmd_head3 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$text = $self->strip_format ($text);
$text =~ s/(.)/_\b$1/g;
return $self->SUPER::cmd_head3 ($attrs, $text);
}
# Level four headings look like level three headings.
sub cmd_head4 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$text = $self->strip_format ($text);
$text =~ s/(.)/_\b$1/g;
return $self->SUPER::cmd_head4 ($attrs, $text);
}
# The common code for handling all headers. We have to override to avoid
# interpolating twice and because we don't want to honor alt.
sub heading {
my ($self, $text, $indent, $marker) = @_;
$self->item ("\n\n") if defined $$self{ITEM};
$text .= "\n" if $$self{opt_loose};
my $margin = ' ' x ($$self{opt_margin} + $indent);
$self->output ($margin . $text . "\n");
return '';
}
# Fix the various formatting codes.
sub cmd_b { local $_ = $_[0]->strip_format ($_[2]); s/(.)/$1\b$1/g; $_ }
sub cmd_f { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
sub cmd_i { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
# Output any included code in bold.
sub output_code {
my ($self, $code) = @_;
$code =~ s/(.)/$1\b$1/g;
$self->output ($code);
}
# Strip all of the formatting from a provided string, returning the stripped
# version.
sub strip_format {
my ($self, $text) = @_;
$text =~ s/(.)[\b]\1/$1/g;
$text =~ s/_[\b]//g;
return $text;
}
# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the backspaces.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{opt_width} - $$self{MARGIN};
while (length > $width) {
# This regex represents a single character, that's possibly underlined
# or in bold (in which case, it's three characters; the character, a
# backspace, and a character). Use [^\n] rather than . to protect
# against odd settings of $*.
my $char = '(?:[^\n][\b])?[^\n]';
if (s/^((?>$char){0,$width})(?:\Z|\s+)//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
$output =~ s/\s+$/\n\n/;
return $output;
}
##############################################################################
# Module return value and documentation
##############################################################################
1;
__END__
=for stopwords
overstrike overstruck Overstruck Allbery terminal's
=head1 NAME
Pod::Text::Overstrike - Convert POD data to formatted overstrike text
=head1 SYNOPSIS
use Pod::Text::Overstrike;
my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
output text using overstrike sequences, in a manner similar to nroff.
Characters in bold text are overstruck (character, backspace, character)
and characters in underlined text are converted to overstruck underscores
(underscore, backspace, character). This format was originally designed
for hard-copy terminals and/or line printers, yet is readable on soft-copy
(CRT) terminals.
Overstruck text is best viewed by page-at-a-time programs that take
advantage of the terminal's B<stand-out> and I<underline> capabilities, such
as the less program on Unix.
Apart from the overstrike, it in all ways functions like Pod::Text. See
L<Pod::Text> for details and available options.
=head1 BUGS
Currently, the outermost formatting instruction wins, so for example
underlined text inside a region of bold text is displayed as simply bold.
There may be some better approach possible.
=head1 COMPATIBILITY
Pod::Text::Overstrike 1.01 (based on L<Pod::Parser>) was the first version of
this module included with Perl, in Perl 5.6.1.
The current API based on L<Pod::Simple> was added in Pod::Text::Overstrike
2.00, included in Perl 5.9.3.
Several problems with wrapping and line length were fixed as recently as
Pod::Text::Overstrike 2.04, included in Perl 5.11.5.
This module inherits its API and most behavior from Pod::Text, so the details
in L<Pod::Text/COMPATIBILITY> also apply. Pod::Text and Pod::Text::Overstrike
have had the same module version since 4.00, included in Perl 5.23.7. (They
unfortunately diverge in confusing ways prior to that.)
=head1 AUTHOR
Originally written by Joe Smith <Joe.Smith@inwap.com>, using the framework
created by Russ Allbery <rra@cpan.org>. Subsequently updated by Russ Allbery.
=head1 COPYRIGHT AND LICENSE
Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>
Copyright 2001, 2004, 2008, 2014, 2018-2019, 2022 by Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Simple>
The current version of this module is always available from its web site at
L<https://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=cut
# Local Variables:
# copyright-at-end-flag: t
# End:

283
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Text/Termcap.pm Normal file
View file

@ -0,0 +1,283 @@
# Convert POD data to ASCII text with format escapes.
#
# This is a simple subclass of Pod::Text that overrides a few key methods to
# output the right termcap escape sequences for formatted text on the current
# terminal type.
#
# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
##############################################################################
# Modules and declarations
##############################################################################
package Pod::Text::Termcap;
use 5.010;
use strict;
use warnings;
use Pod::Text ();
use POSIX ();
use Term::Cap;
our @ISA = qw(Pod::Text);
our $VERSION = '5.01_02';
$VERSION =~ tr/_//d;
##############################################################################
# Overrides
##############################################################################
# In the initialization method, grab our terminal characteristics as well as
# do all the stuff we normally do.
sub new {
my ($self, %args) = @_;
my ($ospeed, $term, $termios);
# Fall back on a hard-coded terminal speed if POSIX::Termios isn't
# available (such as on VMS).
eval { $termios = POSIX::Termios->new };
if ($@) {
$ospeed = 9600;
} else {
$termios->getattr;
$ospeed = $termios->getospeed || 9600;
}
# Get data from Term::Cap if possible.
my ($bold, $undl, $norm, $width);
eval {
my $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
$bold = $term->Tputs('md');
$undl = $term->Tputs('us');
$norm = $term->Tputs('me');
if (defined $$term{_co}) {
$width = $$term{_co};
$width =~ s/^\#//;
}
};
# Figure out the terminal width before calling the Pod::Text constructor,
# since it will otherwise force 76 characters. Pod::Text::Termcap has
# historically used 2 characters less than the width of the screen, while
# the other Pod::Text classes have used 76. This is weirdly inconsistent,
# but there's probably no good reason to change it now.
unless (defined $args{width}) {
$args{width} = $ENV{COLUMNS} || $width || 80;
$args{width} -= 2;
}
# Initialize Pod::Text.
$self = $self->SUPER::new (%args);
# If we were unable to get any of the formatting sequences, don't attempt
# that type of formatting. This will do weird things if bold or underline
# were available but normal wasn't, but hopefully that will never happen.
$$self{BOLD} = $bold || q{};
$$self{UNDL} = $undl || q{};
$$self{NORM} = $norm || q{};
return $self;
}
# Make level one headings bold.
sub cmd_head1 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}");
}
# Make level two headings bold.
sub cmd_head2 {
my ($self, $attrs, $text) = @_;
$text =~ s/\s+$//;
$self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}");
}
# Fix up B<> and I<>. Note that we intentionally don't do F<>.
sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" }
sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" }
# Return a regex that matches a formatting sequence. This will only be valid
# if we were able to get at least some termcap information.
sub format_regex {
my ($self) = @_;
my @codes = ($self->{BOLD}, $self->{UNDL}, $self->{NORM});
return join(q{|}, map { $_ eq q{} ? () : "\Q$_\E" } @codes);
}
# Analyze a single line and return any formatting codes in effect at the end
# of that line.
sub end_format {
my ($self, $line) = @_;
my $pattern = "(" . $self->format_regex() . ")";
my $current;
while ($line =~ /$pattern/g) {
my $code = $1;
if ($code eq $$self{NORM}) {
undef $current;
} else {
$current .= $code;
}
}
return $current;
}
# Output any included code in bold.
sub output_code {
my ($self, $code) = @_;
$self->output ($$self{BOLD} . $code . $$self{NORM});
}
# Strip all of the formatting from a provided string, returning the stripped
# version.
sub strip_format {
my ($self, $text) = @_;
$text =~ s/\Q$$self{BOLD}//g;
$text =~ s/\Q$$self{UNDL}//g;
$text =~ s/\Q$$self{NORM}//g;
return $text;
}
# Override the wrapping code to ignore the special sequences.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{opt_width} - $$self{MARGIN};
# If we were unable to find any termcap sequences, use Pod::Text wrapping.
if ($self->{BOLD} eq q{} && $self->{UNDL} eq q{} && $self->{NORM} eq q{}) {
return $self->SUPER::wrap($_);
}
# $code matches a single special sequence. $char matches any number of
# special sequences preceding a single character other than a newline.
# $shortchar matches some sequence of $char ending in codes followed by
# whitespace or the end of the string. $longchar matches exactly $width
# $chars, used when we have to truncate and hard wrap.
my $code = "(?:" . $self->format_regex() . ")";
my $char = "(?>$code*[^\\n])";
my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
my $longchar = '^(' . $char . "{$width})";
while (length > $width) {
if (s/$shortchar// || s/$longchar//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
# less -R always resets terminal attributes at the end of each line, so we
# need to clear attributes at the end of lines and then set them again at
# the start of the next line. This requires a second pass through the
# wrapped string, accumulating any attributes we see, remembering them,
# and then inserting the appropriate sequences at the newline.
if ($output =~ /\n/) {
my @lines = split (/\n/, $output);
my $start_format;
for my $line (@lines) {
if ($start_format && $line =~ /\S/) {
$line =~ s/^(\s*)(\S)/$1$start_format$2/;
}
$start_format = $self->end_format ($line);
if ($start_format) {
$line .= $$self{NORM};
}
}
$output = join ("\n", @lines);
}
# Fix up trailing whitespace and return the results.
$output =~ s/\s+$/\n\n/;
return $output;
}
##############################################################################
# Module return value and documentation
##############################################################################
1;
__END__
=for stopwords
ECMA-48 VT100 Allbery Solaris TERMPATH unformatted
=head1 NAME
Pod::Text::Termcap - Convert POD data to ASCII text with format escapes
=head1 SYNOPSIS
use Pod::Text::Termcap;
my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output
text using the correct termcap escape sequences for the current terminal.
Apart from the format codes, it in all ways functions like Pod::Text. See
L<Pod::Text> for details and available options.
This module uses L<Term::Cap> to find the correct terminal settings. See the
documentation of that module for how it finds terminal database information
and how to override that behavior if necessary. If unable to find control
strings for bold and underscore formatting, that formatting is skipped,
resulting in the same output as Pod::Text.
=head1 COMPATIBILITY
Pod::Text::Termcap 0.04 (based on L<Pod::Parser>) was the first version of
this module included with Perl, in Perl 5.6.0.
The current API based on L<Pod::Simple> was added in Pod::Text::Termcap 2.00.
Pod::Text::Termcap 2.01 was included in Perl 5.9.3, the first version of Perl
to incorporate those changes.
Several problems with wrapping and line length were fixed as recently as
Pod::Text::Termcap 4.11, included in Perl 5.29.1.
Pod::Text::Termcap 4.13 stopped setting the TERMPATH environment variable
during module load. It also stopped falling back on VT100 escape sequences if
Term::Cap was not able to find usable escape sequences, instead producing
unformatted output for better results on dumb terminals. The next version to
be incorporated into Perl, 4.14, was included in Perl 5.31.8.
This module inherits its API and most behavior from Pod::Text, so the details
in L<Pod::Text/COMPATIBILITY> also apply. Pod::Text and Pod::Text::Termcap
have had the same module version since 4.00, included in Perl 5.23.7. (They
unfortunately diverge in confusing ways prior to that.)
=head1 AUTHOR
Russ Allbery <rra@cpan.org>
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2001-2002, 2004, 2006, 2008-2009, 2014-2015, 2018-2019, 2022
Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Simple>, L<Term::Cap>
The current version of this module is always available from its web site at
L<https://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=cut
# Local Variables:
# copyright-at-end-flag: t
# End:

931
Agent-Windows/OGP64/usr/share/perl5/5.40/Pod/Usage.pm Normal file
View file

@ -0,0 +1,931 @@
#############################################################################
# Pod/Usage.pm -- print usage messages for the running script.
#
# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
# Copyright (c) 2001-2016 by Marek Rouchal.
# This file is part of "Pod-Usage". Pod-Usage is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Usage;
use strict;
require 5.006; ## requires this Perl version or later
use Carp;
use Config;
use Exporter;
use File::Spec;
our $VERSION = '2.03';
our @EXPORT = qw(&pod2usage);
our @ISA;
BEGIN {
$Pod::Usage::Formatter ||= 'Pod::Text';
eval "require $Pod::Usage::Formatter";
die $@ if $@;
@ISA = ( $Pod::Usage::Formatter );
}
our $MAX_HEADING_LEVEL = 3;
##---------------------------------------------------------------------------
##---------------------------------
## Function definitions begin here
##---------------------------------
sub pod2usage {
local($_) = shift;
my %opts;
## Collect arguments
if (@_ > 0) {
## Too many arguments - assume that this is a hash and
## the user forgot to pass a reference to it.
%opts = ($_, @_);
}
elsif (!defined $_) {
$_ = '';
}
elsif (ref $_) {
## User passed a ref to a hash
%opts = %{$_} if (ref($_) eq 'HASH');
}
elsif (/^[-+]?\d+$/) {
## User passed in the exit value to use
$opts{'-exitval'} = $_;
}
else {
## User passed in a message to print before issuing usage.
$_ and $opts{'-message'} = $_;
}
## Need this for backward compatibility since we formerly used
## options that were all uppercase words rather than ones that
## looked like Unix command-line options.
## to be uppercase keywords)
%opts = map {
my ($key, $val) = ($_, $opts{$_});
$key =~ s/^(?=\w)/-/;
$key =~ /^-msg/i and $key = '-message';
$key =~ /^-exit/i and $key = '-exitval';
lc($key) => $val;
} (keys %opts);
## Now determine default -exitval and -verbose values to use
if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
$opts{'-exitval'} = 2;
$opts{'-verbose'} = 0;
}
elsif (! defined $opts{'-exitval'}) {
$opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
}
elsif (! defined $opts{'-verbose'}) {
$opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
$opts{'-exitval'} < 2);
}
## Default the output file
$opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
$opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
unless (defined $opts{'-output'});
## Default the input file
$opts{'-input'} = $0 unless (defined $opts{'-input'});
## Look up input file in path if it doesn't exist.
unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
my $basename = $opts{'-input'};
my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
: (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ':');
my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
for my $dirname (@paths) {
$_ = length($dirname) ? File::Spec->catfile($dirname, $basename) : $basename;
last if (-e $_) && ($opts{'-input'} = $_);
}
}
## Now create a pod reader and constrain it to the desired sections.
my $parser = Pod::Usage->new(USAGE_OPTIONS => \%opts);
if ($opts{'-verbose'} == 0) {
$parser->select('(?:SYNOPSIS|USAGE)\s*');
}
elsif ($opts{'-verbose'} == 1) {
my $opt_re = '(?i)' .
'(?:OPTIONS|ARGUMENTS)' .
'(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
$parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
}
elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
$parser->select('.*');
}
elsif ($opts{'-verbose'} == 99) {
my $sections = $opts{'-sections'};
$parser->select( (ref $sections) ? @$sections : $sections );
$opts{'-verbose'} = 1;
}
## Check for perldoc
my $progpath = $opts{'-perldoc'} ? $opts{'-perldoc'} :
File::Spec->catfile($Config{scriptdirexp} || $Config{scriptdir},
'perldoc');
my $version = sprintf("%vd",$^V);
if ($Config{versiononly} and $Config{startperl} =~ /\Q$version\E$/ ) {
$progpath .= $version;
}
$opts{'-noperldoc'} = 1 unless -e $progpath;
## Now translate the pod document and then exit with the desired status
if ( !$opts{'-noperldoc'}
and $opts{'-verbose'} >= 2
and !ref($opts{'-input'})
and $opts{'-output'} == \*STDOUT )
{
## spit out the entire PODs. Might as well invoke perldoc
print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
# the perldocs back to 5.005 should all have -F
# without -F there are warnings in -T scripts
my $f = $1;
my @perldoc_cmd = ($progpath);
if ($opts{'-perldocopt'}) {
$opts{'-perldocopt'} =~ s/^\s+|\s+$//g;
push @perldoc_cmd, split(/\s+/, $opts{'-perldocopt'});
}
push @perldoc_cmd, ('-F', $f);
unshift @perldoc_cmd, $opts{'-perlcmd'} if $opts{'-perlcmd'};
system(@perldoc_cmd);
# RT16091: fall back to more if perldoc failed
if($?) {
# RT131844: prefer PAGER env
my $pager = $ENV{PAGER} || $Config{pager};
if(defined($pager) && length($pager)) {
my $cmd = $pager . ' ' . ($^O =~ /win/i ? qq("$f") : quotemeta($f));
system($cmd);
} else {
# the most humble fallback; should work (at least) on *nix and Win
system('more', $f);
}
}
} else {
croak "Unspecified input file or insecure argument.\n";
}
}
else {
$parser->parse_from_file($opts{'-input'}, $opts{'-output'});
}
exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
}
##---------------------------------------------------------------------------
##-------------------------------
## Method definitions begin here
##-------------------------------
sub new {
my $this = shift;
my $class = ref($this) || $this;
my %params = @_;
my $self = {%params};
bless $self, $class;
if ($self->can('initialize')) {
$self->initialize();
} else {
# pass through options to Pod::Text
my %opts;
for (qw(alt code indent loose margin quotes sentence stderr utf8 width)) {
my $val = $params{USAGE_OPTIONS}{"-$_"};
$opts{$_} = $val if defined $val;
}
$self = $self->SUPER::new(%opts);
%$self = (%$self, %params);
}
return $self;
}
# This subroutine was copied in whole-cloth from Pod::Select 1.60 in order to
# allow the ejection of Pod::Select from the core without breaking Pod::Usage.
# -- rjbs, 2013-03-18
sub _compile_section_spec {
my ($section_spec) = @_;
my (@regexs, $negated);
## Compile the spec into a list of regexs
local $_ = $section_spec;
s{\\\\}{\001}g; ## handle escaped backward slashes
s{\\/}{\002}g; ## handle escaped forward slashes
## Parse the regexs for the heading titles
@regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
## Set default regex for ommitted levels
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$regexs[$i] = '.*' unless ((defined $regexs[$i])
&& (length $regexs[$i]));
}
## Modify the regexs as needed and validate their syntax
my $bad_regexs = 0;
for (@regexs) {
$_ .= '.+' if ($_ eq '!');
s{\001}{\\\\}g; ## restore escaped backward slashes
s{\002}{\\/}g; ## restore escaped forward slashes
$negated = s/^\!//; ## check for negation
eval "m{$_}"; ## check regex syntax
if ($@) {
++$bad_regexs;
carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
}
else {
## Add the forward and rear anchors (and put the negator back)
$_ = '^' . $_ unless (/^\^/);
$_ = $_ . '$' unless (/\$$/);
$_ = '!' . $_ if ($negated);
}
}
return (! $bad_regexs) ? [ @regexs ] : undef;
}
sub select {
my ($self, @sections) = @_;
if ($ISA[0]->can('select')) {
$self->SUPER::select(@sections);
} else {
# we're using Pod::Simple - need to mimic the behavior of Pod::Select
my $add = ($sections[0] eq '+') ? shift(@sections) : '';
## Reset the set of sections to use
unless (@sections) {
delete $self->{USAGE_SELECT} unless ($add);
return;
}
$self->{USAGE_SELECT} = []
unless ($add && $self->{USAGE_SELECT});
my $sref = $self->{USAGE_SELECT};
## Compile each spec
for my $spec (@sections) {
my $cs = _compile_section_spec($spec);
if ( defined $cs ) {
## Store them in our sections array
push(@$sref, $cs);
} else {
carp qq{Ignoring section spec "$spec"!\n};
}
}
}
}
# Override Pod::Text->seq_i to return just "arg", not "*arg*".
sub seq_i { return $_[1] }
# Override Pod::Text->cmd_i to return just "arg", not "*arg*".
# newer version based on Pod::Simple
sub cmd_i {
my $self = shift;
# RT121489: highlighting should be there with Termcap
return $self->SUPER::cmd_i(@_) if $self->isa('Pod::Text::Termcap');
return $_[1];
}
# This overrides the Pod::Text method to do something very akin to what
# Pod::Select did as well as the work done below by preprocess_paragraph.
# Note that the below is very, very specific to Pod::Text and Pod::Simple.
sub _handle_element_end {
my ($self, $element) = @_;
if ($element eq 'head1') {
$self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
$$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
}
} elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
my $idx = $1 - 1;
$self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
$self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
# we have to get rid of the lower headings
splice(@{$self->{USAGE_HEADINGS}},$idx+1);
}
if ($element =~ /^head\d+$/) {
$$self{USAGE_SKIPPING} = 1;
if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
$$self{USAGE_SKIPPING} = 0;
} else {
my @headings = @{$$self{USAGE_HEADINGS}};
for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
my $match = 1;
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$headings[$i] = '' unless defined $headings[$i];
my $regex = $section_spec->[$i];
my $negated = ($regex =~ s/^\!//);
$match &= ($negated ? ($headings[$i] !~ /${regex}/)
: ($headings[$i] =~ /${regex}/));
last unless ($match);
} # end heading levels
if ($match) {
$$self{USAGE_SKIPPING} = 0;
last;
}
} # end sections
}
# Try to do some lowercasing instead of all-caps in headings, and use
# a colon to end all headings.
if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
local $_ = $$self{PENDING}[-1][1];
s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
s/\s*$/:/ unless (/:\s*$/);
$_ .= "\n";
$$self{PENDING}[-1][1] = $_;
}
}
if ($$self{USAGE_SKIPPING} && $element !~ m/^over-|^[BCFILSZ]$/) {
pop @{ $$self{PENDING} };
} else {
$self->SUPER::_handle_element_end($element);
}
}
# required for Pod::Simple API
sub start_document {
my $self = shift;
$self->SUPER::start_document();
my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
my $out_fh = $self->output_fh();
print $out_fh "$msg\n";
}
# required for old Pod::Parser API
sub begin_pod {
my $self = shift;
$self->SUPER::begin_pod(); ## Have to call superclass
my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
my $out_fh = $self->output_handle();
print $out_fh "$msg\n";
}
sub preprocess_paragraph {
my $self = shift;
local $_ = shift;
my $line = shift;
## See if this is a heading and we aren't printing the entire manpage.
if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
## Change the title of the SYNOPSIS section to USAGE
s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
## Try to do some lowercasing instead of all-caps in headings
s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
## Use a colon to end all headings
s/\s*$/:/ unless (/:\s*$/);
$_ .= "\n";
}
return $self->SUPER::preprocess_paragraph($_);
}
1; # keep require happy
__END__
=for stopwords pod2usage verboseness downcased MSWin32 Marek Rouchal Christiansen ATOOMIC rjbs McDougall
=head1 NAME
Pod::Usage - extracts POD documentation and shows usage information
=head1 SYNOPSIS
use Pod::Usage;
my $message_text = "This text precedes the usage message.";
my $exit_status = 2; ## The exit status to use
my $verbose_level = 0; ## The verbose level to use
my $filehandle = \*STDERR; ## The filehandle to write to
pod2usage($message_text);
pod2usage($exit_status);
pod2usage( { -message => $message_text ,
-exitval => $exit_status ,
-verbose => $verbose_level,
-output => $filehandle } );
pod2usage( -msg => $message_text ,
-exitval => $exit_status ,
-verbose => $verbose_level,
-output => $filehandle );
pod2usage( -verbose => 2,
-noperldoc => 1 );
pod2usage( -verbose => 2,
-perlcmd => $path_to_perl,
-perldoc => $path_to_perldoc,
-perldocopt => $perldoc_options );
=head1 ARGUMENTS
B<pod2usage> should be given either a single argument, or a list of
arguments corresponding to an associative array (a "hash"). When a single
argument is given, it should correspond to exactly one of the following:
=over 4
=item *
A string containing the text of a message to print I<before> printing
the usage message
=item *
A numeric value corresponding to the desired exit status
=item *
A reference to a hash
=back
If more than one argument is given then the entire argument list is
assumed to be a hash. If a hash is supplied (either as a reference or
as a list) it should contain one or more elements with the following
keys:
=over 4
=item C<-message> I<string>
=item C<-msg> I<string>
The text of a message to print immediately prior to printing the
program's usage message.
=item C<-exitval> I<value>
The desired exit status to pass to the B<exit()> function.
This should be an integer, or else the string C<NOEXIT> to
indicate that control should simply be returned without
terminating the invoking process.
=item C<-verbose> I<value>
The desired level of "verboseness" to use when printing the usage message.
If the value is 0, then only the "SYNOPSIS" and/or "USAGE" sections of the
pod documentation are printed. If the value is 1, then the "SYNOPSIS" and/or
"USAGE" sections, along with any section entitled "OPTIONS", "ARGUMENTS", or
"OPTIONS AND ARGUMENTS" is printed. If the corresponding value is 2 or more
then the entire manpage is printed, using L<perldoc> if available; otherwise
L<Pod::Text> is used for the formatting. For better readability, the
all-capital headings are downcased, e.g. C<SYNOPSIS> =E<gt> C<Synopsis>.
The special verbosity level 99 requires to also specify the -sections
parameter; then these sections are extracted and printed.
=item C<-sections> I<spec>
There are two ways to specify the selection. Either a string (scalar)
representing a selection regexp for sections to be printed when -verbose
is set to 99, e.g.
"NAME|SYNOPSIS|DESCRIPTION|VERSION"
With the above regexp all content following (and including) any of the
given C<=head1> headings will be shown. It is possible to restrict the
output to particular subsections only, e.g.:
"DESCRIPTION/Algorithm"
This will output only the C<=head2 Algorithm> heading and content within
the C<=head1 DESCRIPTION> section. The regexp binding is stronger than the
section separator, such that e.g.:
"DESCRIPTION|OPTIONS|ENVIRONMENT/Caveats"
will print any C<=head2 Caveats> section (only) within any of the three
C<=head1> sections.
Alternatively, an array reference of section specifications can be used:
pod2usage(-verbose => 99, -sections => [
qw(DESCRIPTION DESCRIPTION/Introduction) ] );
This will print only the content of C<=head1 DESCRIPTION> and the
C<=head2 Introduction> sections, but no other C<=head2>, and no other
C<=head1> either.
=item C<-output> I<handle>
A reference to a filehandle, or the pathname of a file to which the
usage message should be written. The default is C<\*STDERR> unless the
exit value is less than 2 (in which case the default is C<\*STDOUT>).
=item C<-input> I<handle>
A reference to a filehandle, or the pathname of a file from which the
invoking script's pod documentation should be read. It defaults to the
file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
If you are calling B<pod2usage()> from a module and want to display
that module's POD, you can use this:
use Pod::Find qw(pod_where);
pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
=item C<-pathlist> I<string>
A list of directory paths. If the input file does not exist, then it
will be searched for in the given directory list (in the order the
directories appear in the list). It defaults to the list of directories
implied by C<$ENV{PATH}>. The list may be specified either by a reference
to an array, or by a string of directory paths which use the same path
separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
MSWin32 and DOS).
=item C<-noperldoc>
By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
This does not work well e.g. if the script was packed with L<PAR>. This option
suppresses the external call to L<perldoc> and uses the simple text formatter
(L<Pod::Text>) to output the POD.
=item C<-perlcmd>
By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
specified. In case of special or unusual Perl installations,
this option may be used to supply the path to a L<perl> executable
which should run L<perldoc>.
=item C<-perldoc> I<path-to-perldoc>
By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
specified. In case L<perldoc> is not installed where the L<perl> interpreter
thinks it is (see L<Config>), the -perldoc option may be used to supply
the correct path to L<perldoc>.
=item C<-perldocopt> I<string>
By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is specified.
This option may be used to supply options to L<perldoc>. The
string may contain several, space-separated options.
=back
=head2 Formatting base class
The default text formatter is L<Pod::Text>. The base class for Pod::Usage can
be defined by pre-setting C<$Pod::Usage::Formatter> I<before>
loading Pod::Usage, e.g.:
BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; }
use Pod::Usage qw(pod2usage);
Pod::Usage uses L<Pod::Simple>'s _handle_element_end() method to implement
the section selection, and in case of verbosity < 2 it down-cases the
all-caps headings to first capital letter and rest lowercase, and adds
a colon/newline at the end of the headings, for better readability. Same for
verbosity = 99.
=head2 Pass-through options
The following options are passed through to the underlying text formatter.
See the manual pages of these modules for more information.
alt code indent loose margin quotes sentence stderr utf8 width
=head1 DESCRIPTION
B<pod2usage> will print a usage message for the invoking script (using
its embedded pod documentation) and then exit the script with the
desired exit status. The usage message printed may have any one of three
levels of "verboseness": If the verbose level is 0, then only a synopsis
is printed. If the verbose level is 1, then the synopsis is printed
along with a description (if present) of the command line options and
arguments. If the verbose level is 2, then the entire manual page is
printed.
Unless they are explicitly specified, the default values for the exit
status, verbose level, and output stream to use are determined as
follows:
=over 4
=item *
If neither the exit status nor the verbose level is specified, then the
default is to use an exit status of 2 with a verbose level of 0.
=item *
If an exit status I<is> specified but the verbose level is I<not>, then the
verbose level will default to 1 if the exit status is less than 2 and
will default to 0 otherwise.
=item *
If an exit status is I<not> specified but verbose level I<is> given, then
the exit status will default to 2 if the verbose level is 0 and will
default to 1 otherwise.
=item *
If the exit status used is less than 2, then output is printed on
C<STDOUT>. Otherwise output is printed on C<STDERR>.
=back
Although the above may seem a bit confusing at first, it generally does
"the right thing" in most situations. This determination of the default
values to use is based upon the following typical Unix conventions:
=over 4
=item *
An exit status of 0 implies "success". For example, B<diff(1)> exits
with a status of 0 if the two files have the same contents.
=item *
An exit status of 1 implies possibly abnormal, but non-defective, program
termination. For example, B<grep(1)> exits with a status of 1 if
it did I<not> find a matching line for the given regular expression.
=item *
An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
exits with a status of 2 if you specify an illegal (unknown) option on
the command line.
=item *
Usage messages issued as a result of bad command-line syntax should go
to C<STDERR>. However, usage messages issued due to an explicit request
to print usage (like specifying B<-help> on the command line) should go
to C<STDOUT>, just in case the user wants to pipe the output to a pager
(such as B<more(1)>).
=item *
If program usage has been explicitly requested by the user, it is often
desirable to exit with a status of 1 (as opposed to 0) after issuing
the user-requested usage message. It is also desirable to give a
more verbose description of program usage in this case.
=back
B<pod2usage> does not force the above conventions upon you, but it will
use them by default if you don't expressly tell it to do otherwise. The
ability of B<pod2usage()> to accept a single number or a string makes it
convenient to use as an innocent looking error message handling function:
use strict;
use Pod::Usage;
use Getopt::Long;
## Parse options
my %opt;
GetOptions(\%opt, "help|?", "man", "flag1") || pod2usage(2);
pod2usage(1) if ($opt{help});
pod2usage(-exitval => 0, -verbose => 2) if ($opt{man});
## Check for too many filenames
pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
Some user's however may feel that the above "economy of expression" is
not particularly readable nor consistent and may instead choose to do
something more like the following:
use strict;
use Pod::Usage qw(pod2usage);
use Getopt::Long qw(GetOptions);
## Parse options
my %opt;
GetOptions(\%opt, "help|?", "man", "flag1") ||
pod2usage(-verbose => 0);
pod2usage(-verbose => 1) if ($opt{help});
pod2usage(-verbose => 2) if ($opt{man});
## Check for too many filenames
pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
if (@ARGV > 1);
As with all things in Perl, I<there's more than one way to do it>, and
B<pod2usage()> adheres to this philosophy. If you are interested in
seeing a number of different ways to invoke B<pod2usage> (although by no
means exhaustive), please refer to L<"EXAMPLES">.
=head2 Scripts
The Pod::Usage distribution comes with a script pod2usage which offers
a command line interface to the functionality of Pod::Usage. See
L<pod2usage>.
=head1 EXAMPLES
Each of the following invocations of C<pod2usage()> will print just the
"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
pod2usage();
pod2usage(2);
pod2usage(-verbose => 0);
pod2usage(-exitval => 2);
pod2usage({-exitval => 2, -output => \*STDERR});
pod2usage({-verbose => 0, -output => \*STDERR});
pod2usage(-exitval => 2, -verbose => 0);
pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
Each of the following invocations of C<pod2usage()> will print a message
of "Syntax error." (followed by a newline) to C<STDERR>, immediately
followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
will exit with a status of 2:
pod2usage("Syntax error.");
pod2usage(-message => "Syntax error.", -verbose => 0);
pod2usage(-msg => "Syntax error.", -exitval => 2);
pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
pod2usage(-message => "Syntax error.",
-exitval => 2,
-verbose => 0,
-output => \*STDERR);
Each of the following invocations of C<pod2usage()> will print the
"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
C<STDOUT> and will exit with a status of 1:
pod2usage(1);
pod2usage(-verbose => 1);
pod2usage(-exitval => 1);
pod2usage({-exitval => 1, -output => \*STDOUT});
pod2usage({-verbose => 1, -output => \*STDOUT});
pod2usage(-exitval => 1, -verbose => 1);
pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
Each of the following invocations of C<pod2usage()> will print the
entire manual page to C<STDOUT> and will exit with a status of 1:
pod2usage(-verbose => 2);
pod2usage({-verbose => 2, -output => \*STDOUT});
pod2usage(-exitval => 1, -verbose => 2);
pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
=head2 Recommended Use
Most scripts should print some type of usage message to C<STDERR> when a
command line syntax error is detected. They should also provide an
option (usually C<-H> or C<-help>) to print a (possibly more verbose)
usage message to C<STDOUT>. Some scripts may even wish to go so far as to
provide a means of printing their complete documentation to C<STDOUT>
(perhaps by allowing a C<-man> option). The following complete example
uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
things:
use strict;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
my $man = 0;
my $help = 0;
## Parse options and print usage if there is a syntax error,
## or if usage was explicitly requested.
GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-verbose => 2) if $man;
## If no arguments were given, then allow STDIN to be used only
## if it's not connected to a terminal (otherwise print usage)
pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
__END__
=head1 NAME
sample - Using GetOpt::Long and Pod::Usage
=head1 SYNOPSIS
sample [options] [file ...]
Options:
-help brief help message
-man full documentation
=head1 OPTIONS
=over 4
=item B<-help>
Print a brief help message and exits.
=item B<-man>
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B<This program> will read the given input file(s) and do something
useful with the contents thereof.
=cut
=head1 CAVEATS
By default, B<pod2usage()> will use C<$0> as the path to the pod input
file. Unfortunately, not all systems on which Perl runs will set C<$0>
properly (although if C<$0> is not found, B<pod2usage()> will search
C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
If this is the case for your system, you may need to explicitly specify
the path to the pod docs for the invoking script using something
similar to the following:
pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
In the pathological case that a script is called via a relative path
I<and> the script itself changes the current working directory
(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
fail even on robust platforms. Don't do that. Or use L<FindBin> to locate
the script:
use FindBin;
pod2usage(-input => $FindBin::Bin . "/" . $FindBin::Script);
=head1 SUPPORT
This module is managed in a GitHub repository,
L<https://github.com/Dual-Life/Pod-Usage> Feel free to fork and contribute, or
to clone and send patches!
Please use L<https://github.com/Dual-Life/Pod-Usage/issues/new> to file a bug
report. The previous ticketing system,
L<https://rt.cpan.org/Dist/Display.html?Queue=Pod-Usage>, is deprecated for
this package.
More general questions or discussion about POD should be sent to the
C<pod-people@perl.org> mail list. Send an empty email to
C<pod-people-subscribe@perl.org> to subscribe.
=head1 AUTHOR
Marek Rouchal E<lt>marekr@cpan.orgE<gt>
Nicolas R E<lt>nicolas@atoomic.orgE<gt>
Brad Appleton E<lt>bradapp@enteract.comE<gt>
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
=head1 LICENSE
Pod::Usage (the distribution) is licensed under the same terms as Perl.
=head1 ACKNOWLEDGMENTS
Nicolas R (ATOOMIC) for setting up the Github repo and modernizing this
package.
rjbs for refactoring Pod::Usage to not use Pod::Parser any more.
Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience with
re-writing this manpage.
=head1 SEE ALSO
B<Pod::Usage> is now a standalone distribution, depending on
L<Pod::Text> which in turn depends on L<Pod::Simple>.
L<Pod::Perldoc>, L<Getopt::Long>, L<Pod::Find>, L<FindBin>,
L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Simple>
=cut