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 / Wrap.pm < prev   
Encoding:
Perl POD Document  |  2006-07-07  |  2.2 KB  |  112 lines

  1. package Text::Wrap;
  2.  
  3. require Exporter;
  4.  
  5. @ISA = qw(Exporter);
  6. @EXPORT = qw(wrap fill);
  7. @EXPORT_OK = qw($columns $break $huge);
  8.  
  9. $VERSION = 2005.0824_01;
  10.  
  11. use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
  12.     $separator $separator2);
  13. use strict;
  14.  
  15. BEGIN    {
  16.     $columns = 76;  # <= screen width
  17.     $debug = 0;
  18.     $break = '\s';
  19.     $huge = 'wrap'; # alternatively: 'die' or 'overflow'
  20.     $unexpand = 1;
  21.     $tabstop = 8;
  22.     $separator = "\n";
  23.     $separator2 = undef;
  24. }
  25.  
  26. use Text::Tabs qw(expand unexpand);
  27.  
  28. sub wrap
  29. {
  30.     my ($ip, $xp, @t) = @_;
  31.  
  32.     local($Text::Tabs::tabstop) = $tabstop;
  33.     my $r = "";
  34.     my $tail = pop(@t);
  35.     my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
  36.     my $lead = $ip;
  37.     my $ll = $columns - length(expand($ip)) - 1;
  38.     $ll = 0 if $ll < 0;
  39.     my $nll = $columns - length(expand($xp)) - 1;
  40.     my $nl = "";
  41.     my $remainder = "";
  42.  
  43.     use re 'taint';
  44.  
  45.     pos($t) = 0;
  46.     while ($t !~ /\G\s*\Z/gc) {
  47.         if ($t =~ /\G([^\n]{0,$ll})($break|\n*\z)/xmgc) {
  48.             $r .= $unexpand 
  49.                 ? unexpand($nl . $lead . $1)
  50.                 : $nl . $lead . $1;
  51.             $remainder = $2;
  52.         } elsif ($huge eq 'wrap' && $t =~ /\G([^\n]{$ll})/gc) {
  53.             $r .= $unexpand 
  54.                 ? unexpand($nl . $lead . $1)
  55.                 : $nl . $lead . $1;
  56.             $remainder = defined($separator2) ? $separator2 : $separator;
  57.         } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\z)/xmgc) {
  58.             $r .= $unexpand 
  59.                 ? unexpand($nl . $lead . $1)
  60.                 : $nl . $lead . $1;
  61.             $remainder = $2;
  62.         } elsif ($huge eq 'die') {
  63.             die "couldn't wrap '$t'";
  64.         } else {
  65.             die "This shouldn't happen";
  66.         }
  67.             
  68.         $lead = $xp;
  69.         $ll = $nll;
  70.         $nl = defined($separator2)
  71.             ? ($remainder eq "\n"
  72.                 ? "\n"
  73.                 : $separator2)
  74.             : $separator;
  75.     }
  76.     $r .= $remainder;
  77.  
  78.     print "-----------$r---------\n" if $debug;
  79.  
  80.     print "Finish up with '$lead'\n" if $debug;
  81.  
  82.     $r .= $lead . substr($t, pos($t), length($t)-pos($t))
  83.         if pos($t) ne length($t);
  84.  
  85.     print "-----------$r---------\n" if $debug;;
  86.  
  87.     return $r;
  88. }
  89.  
  90. sub fill 
  91. {
  92.     my ($ip, $xp, @raw) = @_;
  93.     my @para;
  94.     my $pp;
  95.  
  96.     for $pp (split(/\n\s+/, join("\n",@raw))) {
  97.         $pp =~ s/\s+/ /g;
  98.         my $x = wrap($ip, $xp, $pp);
  99.         push(@para, $x);
  100.     }
  101.  
  102.     # if paragraph_indent is the same as line_indent, 
  103.     # separate paragraphs with blank lines
  104.  
  105.     my $ps = ($ip eq $xp) ? "\n\n" : "\n";
  106.     return join ($ps, @para);
  107. }
  108.  
  109. 1;
  110. __END__
  111.  
  112.