summaryrefslogtreecommitdiff
path: root/Master/perltl/lib/Text
diff options
context:
space:
mode:
Diffstat (limited to 'Master/perltl/lib/Text')
-rw-r--r--Master/perltl/lib/Text/ParseWords.pm263
-rw-r--r--Master/perltl/lib/Text/Tabs.pm97
-rw-r--r--Master/perltl/lib/Text/Wrap.pm211
3 files changed, 571 insertions, 0 deletions
diff --git a/Master/perltl/lib/Text/ParseWords.pm b/Master/perltl/lib/Text/ParseWords.pm
new file mode 100644
index 00000000000..6949c459378
--- /dev/null
+++ b/Master/perltl/lib/Text/ParseWords.pm
@@ -0,0 +1,263 @@
+package Text::ParseWords;
+
+use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE);
+$VERSION = "3.21";
+
+require 5.000;
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
+@EXPORT_OK = qw(old_shellwords);
+
+
+sub shellwords {
+ local(@lines) = @_;
+ $lines[$#lines] =~ s/\s+$//;
+ return(quotewords('\s+', 0, @lines));
+}
+
+
+
+sub quotewords {
+ my($delim, $keep, @lines) = @_;
+ my($line, @words, @allwords);
+
+
+ foreach $line (@lines) {
+ @words = parse_line($delim, $keep, $line);
+ return() unless (@words || !length($line));
+ push(@allwords, @words);
+ }
+ return(@allwords);
+}
+
+
+
+sub nested_quotewords {
+ my($delim, $keep, @lines) = @_;
+ my($i, @allwords);
+
+ for ($i = 0; $i < @lines; $i++) {
+ @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
+ return() unless (@{$allwords[$i]} || !length($lines[$i]));
+ }
+ return(@allwords);
+}
+
+
+
+sub parse_line {
+ # We will be testing undef strings
+ no warnings;
+ use re 'taint'; # if it's tainted, leave it as such
+
+ my($delimiter, $keep, $line) = @_;
+ my($quote, $quoted, $unquoted, $delim, $word, @pieces);
+
+ while (length($line)) {
+
+ ($quote, $quoted, undef, $unquoted, $delim, undef) =
+ $line =~ m/^(["']) # a $quote
+ ((?:\\.|(?!\1)[^\\])*) # and $quoted text
+ \1 # followed by the same quote
+ ([\000-\377]*) # and the rest
+ | # --OR--
+ ^((?:\\.|[^\\"'])*?) # an $unquoted text
+ (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))
+ # plus EOL, delimiter, or quote
+ ([\000-\377]*) # the rest
+ /x; # extended layout
+ return() unless( $quote || length($unquoted) || length($delim));
+
+ $line = $+;
+
+ if ($keep) {
+ $quoted = "$quote$quoted$quote";
+ }
+ else {
+ $unquoted =~ s/\\(.)/$1/g;
+ if (defined $quote) {
+ $quoted =~ s/\\(.)/$1/g if ($quote eq '"');
+ $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
+ }
+ }
+ $word .= defined $quote ? $quoted : $unquoted;
+
+ if (length($delim)) {
+ push(@pieces, $word);
+ push(@pieces, $delim) if ($keep eq 'delimiters');
+ undef $word;
+ }
+ if (!length($line)) {
+ push(@pieces, $word);
+ }
+ }
+ return(@pieces);
+}
+
+
+
+sub old_shellwords {
+
+ # Usage:
+ # use ParseWords;
+ # @words = old_shellwords($line);
+ # or
+ # @words = old_shellwords(@lines);
+
+ local($_) = join('', @_);
+ my(@words,$snippet,$field);
+
+ s/^\s+//;
+ while ($_ ne '') {
+ $field = '';
+ for (;;) {
+ if (s/^"(([^"\\]|\\.)*)"//) {
+ ($snippet = $1) =~ s#\\(.)#$1#g;
+ }
+ elsif (/^"/) {
+ return();
+ }
+ elsif (s/^'(([^'\\]|\\.)*)'//) {
+ ($snippet = $1) =~ s#\\(.)#$1#g;
+ }
+ elsif (/^'/) {
+ return();
+ }
+ elsif (s/^\\(.)//) {
+ $snippet = $1;
+ }
+ elsif (s/^([^\s\\'"]+)//) {
+ $snippet = $1;
+ }
+ else {
+ s/^\s+//;
+ last;
+ }
+ $field .= $snippet;
+ }
+ push(@words, $field);
+ }
+ @words;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens or array of arrays
+
+=head1 SYNOPSIS
+
+ use Text::ParseWords;
+ @lists = &nested_quotewords($delim, $keep, @lines);
+ @words = &quotewords($delim, $keep, @lines);
+ @words = &shellwords(@lines);
+ @words = &parse_line($delim, $keep, $line);
+ @words = &old_shellwords(@lines); # DEPRECATED!
+
+=head1 DESCRIPTION
+
+The &nested_quotewords() and &quotewords() functions accept a delimiter
+(which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes. &quotewords()
+returns all of the tokens in a single long list, while &nested_quotewords()
+returns a list of token lists corresponding to the elements of @lines.
+&parse_line() does tokenizing on a single string. The &*quotewords()
+functions simply call &parse_lines(), so if you're only splitting
+one line you can call &parse_lines() directly and save a function
+call.
+
+The $keep argument is a boolean flag. If true, then the tokens are
+split on the specified delimiter, but all other characters (quotes,
+backslashes, etc.) are kept in the tokens. If $keep is false then the
+&*quotewords() functions remove all quotes and backslashes that are
+not themselves backslash-escaped or inside of single quotes (i.e.,
+&quotewords() tries to interpret these characters just like the Bourne
+shell). NB: these semantics are significantly different from the
+original version of this module shipped with Perl 5.000 through 5.004.
+As an additional feature, $keep may be the keyword "delimiters" which
+causes the functions to preserve the delimiters in each string as
+tokens in the token lists, in addition to preserving quote and
+backslash characters.
+
+&shellwords() is written as a special case of &quotewords(), and it
+does token parsing with whitespace as a delimiter-- similar to most
+Unix shells.
+
+=head1 EXAMPLES
+
+The sample program:
+
+ use Text::ParseWords;
+ @words = &quotewords('\s+', 0, q{this is "a test" of\ quotewords \"for you});
+ $i = 0;
+ foreach (@words) {
+ print "$i: <$_>\n";
+ $i++;
+ }
+
+produces:
+
+ 0: <this>
+ 1: <is>
+ 2: <a test>
+ 3: <of quotewords>
+ 4: <"for>
+ 5: <you>
+
+demonstrating:
+
+=over 4
+
+=item 0
+
+a simple word
+
+=item 1
+
+multiple spaces are skipped because of our $delim
+
+=item 2
+
+use of quotes to include a space in a word
+
+=item 3
+
+use of a backslash to include a space in a word
+
+=item 4
+
+use of a backslash to remove the special meaning of a double-quote
+
+=item 5
+
+another simple word (note the lack of effect of the
+backslashed double-quote)
+
+=back
+
+Replacing C<&quotewords('\s+', 0, q{this is...})>
+with C<&shellwords(q{this is...})>
+is a simpler way to accomplish the same thing.
+
+=head1 AUTHORS
+
+Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original
+author unknown). Much of the code for &parse_line() (including the
+primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>.
+
+Examples section another documentation provided by John Heidemann
+<johnh@ISI.EDU>
+
+Bug reports, patches, and nagging provided by lots of folks-- thanks
+everybody! Special thanks to Michael Schwern <schwern@envirolink.org>
+for assuring me that a &nested_quotewords() would be useful, and to
+Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about
+error-checking (sort of-- you had to be there).
+
+=cut
diff --git a/Master/perltl/lib/Text/Tabs.pm b/Master/perltl/lib/Text/Tabs.pm
new file mode 100644
index 00000000000..b26f8f40548
--- /dev/null
+++ b/Master/perltl/lib/Text/Tabs.pm
@@ -0,0 +1,97 @@
+
+package Text::Tabs;
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(expand unexpand $tabstop);
+
+use vars qw($VERSION $tabstop $debug);
+$VERSION = 98.112801;
+
+use strict;
+
+BEGIN {
+ $tabstop = 8;
+ $debug = 0;
+}
+
+sub expand
+{
+ my (@l) = @_;
+ for $_ (@l) {
+ 1 while s/(^|\n)([^\t\n]*)(\t+)/
+ $1. $2 . (" " x
+ ($tabstop * length($3)
+ - (length($2) % $tabstop)))
+ /sex;
+ }
+ return @l if wantarray;
+ return $l[0];
+}
+
+sub unexpand
+{
+ my (@l) = @_;
+ my @e;
+ my $x;
+ my $line;
+ my @lines;
+ my $lastbit;
+ for $x (@l) {
+ @lines = split("\n", $x, -1);
+ for $line (@lines) {
+ $line = expand($line);
+ @e = split(/(.{$tabstop})/,$line,-1);
+ $lastbit = pop(@e);
+ $lastbit = '' unless defined $lastbit;
+ $lastbit = "\t"
+ if $lastbit eq " "x$tabstop;
+ for $_ (@e) {
+ if ($debug) {
+ my $x = $_;
+ $x =~ s/\t/^I\t/gs;
+ print "sub on '$x'\n";
+ }
+ s/ +$/\t/;
+ }
+ $line = join('',@e, $lastbit);
+ }
+ $x = join("\n", @lines);
+ }
+ return @l if wantarray;
+ return $l[0];
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1)
+
+=head1 SYNOPSIS
+
+ use Text::Tabs;
+
+ $tabstop = 4;
+ @lines_without_tabs = expand(@lines_with_tabs);
+ @lines_with_tabs = unexpand(@lines_without_tabs);
+
+=head1 DESCRIPTION
+
+Text::Tabs does about what the unix utilities expand(1) and unexpand(1)
+do. Given a line with tabs in it, expand will replace the tabs with
+the appropriate number of spaces. Given a line with or without tabs in
+it, unexpand will add tabs when it can save bytes by doing so. Invisible
+compression with plain ascii!
+
+=head1 BUGS
+
+expand doesn't handle newlines very quickly -- do not feed it an
+entire document in one string. Instead feed it an array of lines.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
diff --git a/Master/perltl/lib/Text/Wrap.pm b/Master/perltl/lib/Text/Wrap.pm
new file mode 100644
index 00000000000..8dd1f6c2512
--- /dev/null
+++ b/Master/perltl/lib/Text/Wrap.pm
@@ -0,0 +1,211 @@
+package Text::Wrap;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(wrap fill);
+@EXPORT_OK = qw($columns $break $huge);
+
+$VERSION = 2001.0929;
+
+use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
+ $separator);
+use strict;
+
+BEGIN {
+ $columns = 76; # <= screen width
+ $debug = 0;
+ $break = '\s';
+ $huge = 'wrap'; # alternatively: 'die' or 'overflow'
+ $unexpand = 1;
+ $tabstop = 8;
+ $separator = "\n";
+}
+
+use Text::Tabs qw(expand unexpand);
+
+sub wrap
+{
+ my ($ip, $xp, @t) = @_;
+
+ local($Text::Tabs::tabstop) = $tabstop;
+ my $r = "";
+ my $tail = pop(@t);
+ my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
+ my $lead = $ip;
+ my $ll = $columns - length(expand($ip)) - 1;
+ my $nll = $columns - length(expand($xp)) - 1;
+ my $nl = "";
+ my $remainder = "";
+
+ use re 'taint';
+
+ pos($t) = 0;
+ while ($t !~ /\G\s*\Z/gc) {
+ if ($t =~ /\G([^\n]{0,$ll})($break|\z)/xmgc) {
+ $r .= $unexpand
+ ? unexpand($nl . $lead . $1)
+ : $nl . $lead . $1;
+ $remainder = $2;
+ } elsif ($huge eq 'wrap' && $t =~ /\G([^\n]{$ll})/gc) {
+ $r .= $unexpand
+ ? unexpand($nl . $lead . $1)
+ : $nl . $lead . $1;
+ $remainder = $separator;
+ } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\z)/xmgc) {
+ $r .= $unexpand
+ ? unexpand($nl . $lead . $1)
+ : $nl . $lead . $1;
+ $remainder = $2;
+ } elsif ($huge eq 'die') {
+ die "couldn't wrap '$t'";
+ } else {
+ die "This shouldn't happen";
+ }
+
+ $lead = $xp;
+ $ll = $nll;
+ $nl = $separator;
+ }
+ $r .= $remainder;
+
+ print "-----------$r---------\n" if $debug;
+
+ print "Finish up with '$lead'\n" if $debug;
+
+ $r .= $lead . substr($t, pos($t), length($t)-pos($t))
+ if pos($t) ne length($t);
+
+ print "-----------$r---------\n" if $debug;;
+
+ return $r;
+}
+
+sub fill
+{
+ my ($ip, $xp, @raw) = @_;
+ my @para;
+ my $pp;
+
+ for $pp (split(/\n\s+/, join("\n",@raw))) {
+ $pp =~ s/\s+/ /g;
+ my $x = wrap($ip, $xp, $pp);
+ push(@para, $x);
+ }
+
+ # if paragraph_indent is the same as line_indent,
+ # separate paragraphs with blank lines
+
+ my $ps = ($ip eq $xp) ? "\n\n" : "\n";
+ return join ($ps, @para);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Text::Wrap - line wrapping to form simple paragraphs
+
+=head1 SYNOPSIS
+
+B<Example 1>
+
+ use Text::Wrap
+
+ $initial_tab = "\t"; # Tab before first line
+ $subsequent_tab = ""; # All other lines flush left
+
+ print wrap($initial_tab, $subsequent_tab, @text);
+ print fill($initial_tab, $subsequent_tab, @text);
+
+ @lines = wrap($initial_tab, $subsequent_tab, @text);
+
+ @paragraphs = fill($initial_tab, $subsequent_tab, @text);
+
+B<Example 2>
+
+ use Text::Wrap qw(wrap $columns $huge);
+
+ $columns = 132; # Wrap at 132 characters
+ $huge = 'die';
+ $huge = 'wrap';
+ $huge = 'overflow';
+
+B<Example 3>
+
+ use Text::Wrap
+
+ $Text::Wrap::columns = 72;
+ print wrap('', '', @text);
+
+=head1 DESCRIPTION
+
+C<Text::Wrap::wrap()> is a very simple paragraph formatter. It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line (C<$initial_tab>) and
+all subsquent lines (C<$subsequent_tab>) independently. Please note:
+C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
+be used: it is unlikley you would want to pass in a number.
+
+Text::Wrap::fill() is a simple multi-paragraph formatter. It formats
+each paragraph separately and then joins them together when it's done. It
+will destory any whitespace in the original text. It breaks text into
+paragraphs by looking for whitespace after a newline. In other respects
+it acts like wrap().
+
+=head1 OVERRIDES
+
+C<Text::Wrap::wrap()> has a number of variables that control its behavior.
+Because other modules might be using C<Text::Wrap::wrap()> it is suggested
+that you leave these variables alone! If you can't do that, then
+use C<local($Text::Wrap::VARIABLE) = YOURVALUE> when you change the
+values so that the original value is restored. This C<local()> trick
+will not work if you import the variable into your own namespace.
+
+Lines are wrapped at C<$Text::Wrap::columns> columns. C<$Text::Wrap::columns>
+should be set to the full width of your output device. In fact,
+every resulting line will have length of no more than C<$columns - 1>.
+
+It is possible to control which characters terminate words by
+modifying C<$Text::Wrap::break>. Set this to a string such as
+C<'[\s:]'> (to break before spaces or colons) or a pre-compiled regexp
+such as C<qr/[\s']/> (to break before spaces or apostrophes). The
+default is simply C<'\s'>; that is, words are terminated by spaces.
+(This means, among other things, that trailing punctuation such as
+full stops or commas stay with the word they are "attached" to.)
+
+Beginner note: In example 2, above C<$columns> is imported into
+the local namespace, and set locally. In example 3,
+C<$Text::Wrap::columns> is set in its own namespace without importing it.
+
+C<Text::Wrap::wrap()> starts its work by expanding all the tabs in its
+input into spaces. The last thing it does it to turn spaces back
+into tabs. If you do not want tabs in your results, set
+C<$Text::Wrap::unexapand> to a false value. Likewise if you do not
+want to use 8-character tabstops, set C<$Text::Wrap::tabstop> to
+the number of characters you do want for your tabstops.
+
+If you want to separate your lines with something other than C<\n>
+then set C<$Text::Wrap::seporator> to your preference.
+
+When words that are longer than C<$columns> are encountered, they
+are broken up. C<wrap()> adds a C<"\n"> at column C<$columns>.
+This behavior can be overridden by setting C<$huge> to
+'die' or to 'overflow'. When set to 'die', large words will cause
+C<die()> to be called. When set to 'overflow', large words will be
+left intact.
+
+Historical notes: 'die' used to be the default value of
+C<$huge>. Now, 'wrap' is the default value.
+
+=head1 EXAMPLE
+
+ print wrap("\t","","This is a bit of text that forms
+ a normal book-style paragraph");
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
+many many others.
+