home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / Text / Tabs.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-07  |  1.3 KB  |  88 lines

  1. package Text::Tabs;
  2.  
  3. require Exporter;
  4.  
  5. @ISA = (Exporter);
  6. @EXPORT = qw(expand unexpand $tabstop);
  7.  
  8. use vars qw($VERSION $tabstop $debug);
  9. $VERSION = 2005.0824;
  10.  
  11. use strict;
  12.  
  13. BEGIN    {
  14.     $tabstop = 8;
  15.     $debug = 0;
  16. }
  17.  
  18. sub expand {
  19.     my @l;
  20.     my $pad;
  21.     for ( @_ ) {
  22.         my $s = '';
  23.         for (split(/^/m, $_, -1)) {
  24.             my $offs = 0;
  25.             s{\t}{
  26.                 $pad = $tabstop - (pos() + $offs) % $tabstop;
  27.                 $offs += $pad - 1;
  28.                 " " x $pad;
  29.             }eg;
  30.             $s .= $_;
  31.         }
  32.         push(@l, $s);
  33.     }
  34.     return @l if wantarray;
  35.     return $l[0];
  36. }
  37.  
  38. sub unexpand
  39. {
  40.     my (@l) = @_;
  41.     my @e;
  42.     my $x;
  43.     my $line;
  44.     my @lines;
  45.     my $lastbit;
  46.     for $x (@l) {
  47.         @lines = split("\n", $x, -1);
  48.         for $line (@lines) {
  49.             $line = expand($line);
  50.             @e = split(/(.{$tabstop})/,$line,-1);
  51.             $lastbit = pop(@e);
  52.             $lastbit = '' unless defined $lastbit;
  53.             $lastbit = "\t"
  54.                 if $lastbit eq " "x$tabstop;
  55.             for $_ (@e) {
  56.                 if ($debug) {
  57.                     my $x = $_;
  58.                     $x =~ s/\t/^I\t/gs;
  59.                     print "sub on '$x'\n";
  60.                 }
  61.                 s/  +$/\t/;
  62.             }
  63.             $line = join('',@e, $lastbit);
  64.         }
  65.         $x = join("\n", @lines);
  66.     }
  67.     return @l if wantarray;
  68.     return $l[0];
  69. }
  70.  
  71. 1;
  72. __END__
  73.  
  74. sub expand
  75. {
  76.     my (@l) = @_;
  77.     for $_ (@l) {
  78.         1 while s/(^|\n)([^\t\n]*)(\t+)/
  79.             $1. $2 . (" " x 
  80.                 ($tabstop * length($3)
  81.                 - (length($2) % $tabstop)))
  82.             /sex;
  83.     }
  84.     return @l if wantarray;
  85.     return $l[0];
  86. }
  87.  
  88.