diff options
Diffstat (limited to 'Master/perltl/lib/Text')
-rw-r--r-- | Master/perltl/lib/Text/ParseWords.pm | 263 | ||||
-rw-r--r-- | Master/perltl/lib/Text/Tabs.pm | 97 | ||||
-rw-r--r-- | Master/perltl/lib/Text/Wrap.pm | 211 |
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 = "ewords($delim, $keep, @lines); + @words = &shellwords(@lines); + @words = &parse_line($delim, $keep, $line); + @words = &old_shellwords(@lines); # DEPRECATED! + +=head1 DESCRIPTION + +The &nested_quotewords() and "ewords() 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. "ewords() +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., +"ewords() 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 "ewords(), and it +does token parsing with whitespace as a delimiter-- similar to most +Unix shells. + +=head1 EXAMPLES + +The sample program: + + use Text::ParseWords; + @words = "ewords('\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<"ewords('\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. + |