diff options
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl/5.10.1/Text')
3 files changed, 377 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl/5.10.1/Text/ParseWords.pm b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/ParseWords.pm new file mode 100644 index 0000000..1b7312a --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/ParseWords.pm @@ -0,0 +1,166 @@ +package Text::ParseWords; + +use strict; +require 5.006; +our $VERSION = "3.27"; + +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(shellwords quotewords nested_quotewords parse_line); +our @EXPORT_OK = qw(old_shellwords); +our $PERL_SINGLE_QUOTE; + +sub shellwords { + my (@lines) = @_; + my @allwords; + + foreach my $line (@lines) { + $line =~ s/^\s+//; + my @words = parse_line('\s+', 0, $line); + pop @words if (@words and !defined $words[-1]); + return() unless (@words || !length($line)); + push(@allwords, @words); + } + return(@allwords); +} + +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 { + my($delimiter, $keep, $line) = @_; + my($word, @pieces); + + no warnings 'uninitialized'; # we will be testing undef strings + + while (length($line)) { + # This pattern is optimised to be stack conservative on older perls. + # Do not refactor without being careful and testing it on very long strings. + # See Perl bug #42980 for an example of a stack busting input. + $line =~ s/^ + (?: + # double quoted string + (") # $quote + ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted + | # --OR-- + # singe quoted string + (') # $quote + ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted + | # --OR-- + # unquoted string + ( # $unquoted + (?:\\.|[^\\"'])*? + ) + # followed by + ( # $delim + \Z(?!\n) # EOL + | # --OR-- + (?-x:$delimiter) # delimiter + | # --OR-- + (?!^)(?=["']) # a quote + ) + )//xs or return; # extended layout + my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6); + + return() unless( defined($quote) || length($unquoted) || length($delim)); + + if ($keep) { + $quoted = "$quote$quoted$quote"; + } + else { + $unquoted =~ s/\\(.)/$1/sg; + if (defined $quote) { + $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); + $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); + } + } + $word .= substr($line, 0, 0); # leave results tainted + $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); + # or + # @words = old_shellwords(); # defaults to $_ (and clobbers it) + + no warnings 'uninitialized'; # we will be testing undef strings + local *_ = \join('', @_) if @_; + my (@words, $snippet); + + s/\A\s+//; + while ($_ ne '') { + my $field = substr($_, 0, 0); # leave results tainted + for (;;) { + if (s/\A"(([^"\\]|\\.)*)"//s) { + ($snippet = $1) =~ s#\\(.)#$1#sg; + } + elsif (/\A"/) { + require Carp; + Carp::carp("Unmatched double quote: $_"); + return(); + } + elsif (s/\A'(([^'\\]|\\.)*)'//s) { + ($snippet = $1) =~ s#\\(.)#$1#sg; + } + elsif (/\A'/) { + require Carp; + Carp::carp("Unmatched single quote: $_"); + return(); + } + elsif (s/\A\\(.?)//s) { + $snippet = $1; + } + elsif (s/\A([^\s\\'"]+)//) { + $snippet = $1; + } + else { + s/\A\s+//; + last; + } + $field .= $snippet; + } + push(@words, $field); + } + return @words; +} + +1; + +__END__ + diff --git a/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Tabs.pm b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Tabs.pm new file mode 100644 index 0000000..b20d98b --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Tabs.pm @@ -0,0 +1,89 @@ +package Text::Tabs; + +require Exporter; + +@ISA = (Exporter); +@EXPORT = qw(expand unexpand $tabstop); + +use vars qw($VERSION $tabstop $debug); +$VERSION = 2009.0305; + +use strict; + +BEGIN { + $tabstop = 8; + $debug = 0; +} + +sub expand { + my @l; + my $pad; + for ( @_ ) { + my $s = ''; + for (split(/^/m, $_, -1)) { + my $offs = 0; + s{\t}{ + $pad = $tabstop - (pos() + $offs) % $tabstop; + $offs += $pad - 1; + " " x $pad; + }eg; + $s .= $_; + } + push(@l, $s); + } + return @l if wantarray; + return $l[0]; +} + +sub unexpand +{ + my (@l) = @_; + my @e; + my $x; + my $line; + my @lines; + my $lastbit; + my $ts_as_space = " "x$tabstop; + 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 $ts_as_space; + 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__ + +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]; +} + diff --git a/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Wrap.pm b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Wrap.pm new file mode 100644 index 0000000..72551c4 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl/5.10.1/Text/Wrap.pm @@ -0,0 +1,122 @@ +package Text::Wrap; + +use warnings::register; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(wrap fill); +@EXPORT_OK = qw($columns $break $huge); + +$VERSION = 2009.0305; + +use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop + $separator $separator2); +use strict; + +BEGIN { + $columns = 76; # <= screen width + $debug = 0; + $break = '\s'; + $huge = 'wrap'; # alternatively: 'die' or 'overflow' + $unexpand = 1; + $tabstop = 8; + $separator = "\n"; + $separator2 = undef; +} + +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 $nll = $columns - length(expand($xp)) - 1; + if ($nll <= 0 && $xp ne '') { + my $nc = length(expand($xp)) + 2; + warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab"; + $columns = $nc; + $nll = 1; + } + my $ll = $columns - length(expand($ip)) - 1; + $ll = 0 if $ll < 0; + my $nl = ""; + my $remainder = ""; + + use re 'taint'; + + pos($t) = 0; + while ($t !~ /\G(?:$break)*\Z/gc) { + if ($t =~ /\G([^\n]{0,$ll})($break|\n+|\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 = defined($separator2) ? $separator2 : $separator; + } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\n+|\z)/xmgc) { + $r .= $unexpand + ? unexpand($nl . $lead . $1) + : $nl . $lead . $1; + $remainder = $2; + } elsif ($huge eq 'die') { + die "couldn't wrap '$t'"; + } elsif ($columns < 2) { + warnings::warnif "Increasing \$Text::Wrap::columns from $columns to 2"; + $columns = 2; + return ($ip, $xp, @t); + } else { + die "This shouldn't happen"; + } + + $lead = $xp; + $ll = $nll; + $nl = defined($separator2) + ? ($remainder eq "\n" + ? "\n" + : $separator2) + : $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__ + |