home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _a21e093b44458bab6e563fa98932e043 < prev    next >
Encoding:
Text File  |  2004-06-01  |  42.1 KB  |  1,351 lines
  1. package Text::Autoformat;
  2.  
  3. use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use Carp;
  4. use 5.005;
  5. $VERSION = '1.12';
  6.  
  7. require Exporter;
  8.  
  9. use Text::Reform qw( form tag break_at break_with break_wrap break_TeX );
  10.  
  11. @ISA = qw(Exporter);
  12. @EXPORT = qw( autoformat );
  13. @EXPORT_OK =
  14.     qw( form tag break_at break_with break_wrap break_TeX ignore_headers );
  15.  
  16.  
  17. my %ignore = map {$_=>1} qw {
  18.     a an at as and are
  19.     but by 
  20.     ere
  21.     for from
  22.     in into is
  23.     of on onto or over
  24.     per
  25.     the to that than
  26.     until unto upon
  27.     via
  28.     with while whilst within without
  29. };
  30.  
  31. my @entities = qw {
  32.     Á   á      Â    â        Æ    æ
  33.     À   à      Α    α        Ã   ã
  34.     Ä     ä        Β     β         Ç   ç
  35.     Χ      χ         Δ    δ        É   é
  36.     Ê    ê       È   è       Ε  ε
  37.     Η      η         Ð      ð          Ë     ë
  38.     Γ    γ       Í   í       Î    î
  39.     Ì   ì      Ι     ι         Ï     ï
  40.     Κ    κ       Λ   λ       Μ       μ
  41.     Ñ   ñ      Ν       ν           Ó   ó
  42.     Ô    ô       Œ    œ        Ò   ò
  43.     Ω    ω       Ο  ο      Õ   õ
  44.     Ö     ö        Φ      φ          Π       π
  45.     ″    ′       Ψ      ψ          Ρ      ρ
  46.     Š   š      Σ    σ        Τ      τ
  47.     Θ    θ       Þ    þ        Ú   ú
  48.     Û    û       Ù   ù       Υ  υ
  49.     Ü     ü        Ξ       ξ           Ý   ý
  50.     Ÿ     ÿ        Ζ     ζ         
  51. };
  52.  
  53. my %lower_entities = @entities;
  54. my %upper_entities = reverse @entities;
  55.  
  56. my %casing = (
  57.     lower => [ \%lower_entities,  \%lower_entities,
  58.            sub { $_ = lc },   sub { $_ = lc } ],
  59.     upper => [ \%upper_entities,  \%upper_entities,
  60.            sub { $_ = uc },   sub { $_ = uc } ],
  61.     title => [ \%upper_entities,  \%lower_entities,
  62.            sub { $_ = ucfirst lc }, sub { $_ = lc } ],
  63. );
  64.  
  65. my $default_margin = 72;
  66. my $default_widow  = 10;
  67.  
  68. $Text::Autoformat::widow_slack = 0.1;
  69.  
  70.  
  71. sub defn($)
  72. {
  73.     return $_[0] if defined $_[0];
  74.     return "";
  75. }
  76.  
  77. my $ignore_headers = qr/\A(From\b.*$)?([^:]+:.*$([ \t].*$)*)+\s*\Z/m;
  78. my $ignore_indent  = qr/^[^\S\n].*(\n[^\S\n].*)*$/;
  79.  
  80. sub ignore_headers { $_[0]==1 && /$ignore_headers/ }
  81.  
  82. # BITS OF A TEXT LINE
  83.  
  84. my $quotechar = qq{[!#%=|:]};
  85. my $quotechunk = qq{(?:$quotechar(?![a-z])|[a-z]*>+)};
  86. my $quoter = qq{(?:(?i)(?:$quotechunk(?:[ \\t]*$quotechunk)*))};
  87.  
  88. my $separator = q/(?:[-_]{2,}|[=#*]{3,}|[+~]{4,})/;
  89.  
  90. use overload;
  91. sub autoformat    # ($text, %args)
  92. {
  93.     my ($text,%args,$toSTDOUT);
  94.  
  95.     foreach ( @_ )
  96.     {
  97.         if (ref eq 'HASH')
  98.             { %args = (%args, %$_) }
  99.         elsif (!defined($text) && !ref || overload::Method($_,'""'))
  100.             { $text = "$_" }
  101.         else {
  102.             croak q{Usage: autoformat([text],[{options}])}
  103.         }
  104.     }
  105.  
  106.     unless (defined $text) {
  107.         $text = join("",<STDIN>);
  108.         $toSTDOUT = !defined wantarray();
  109.     }
  110.  
  111.     return unless length $text;
  112.  
  113.     $args{right}   = $default_margin unless exists $args{right};
  114.     $args{justify} = "" unless exists $args{justify};
  115.     $args{widow}   = 0 if $args{justify}||"" =~ /full/;
  116.     $args{widow}   = $default_widow unless exists $args{widow};
  117.     $args{case}    = '' unless exists $args{case};
  118.     $args{squeeze} = 1 unless exists $args{squeeze};
  119.     $args{gap}     = 0 unless exists $args{gap};
  120.     $args{break}  = break_at('-') unless exists $args{break};
  121.     $args{impfill} = ! exists $args{fill};
  122.     $args{expfill} = $args{fill};
  123.     $args{renumber} = 1 unless exists $args{renumber};
  124.     $args{autocentre} = 1 unless exists $args{autocentre};
  125.     $args{_centred} = 1 if $args{justify} =~ /cent(er(ed)?|red?)/;
  126.  
  127.     # SPECIAL IGNORANCE...
  128.     if ($args{ignore}) {
  129.         $args{all} = 1;
  130.         my $ig_type = ref $args{ignore};
  131.         if ($ig_type eq 'Regexp') {
  132.             my $regex = $args{ignore};
  133.             $args{ignore} = sub { /$regex/ };
  134.         }
  135.         elsif ($args{ignore} =~ /^indent/i) {
  136.             $args{ignore} = sub { ignore_headers(@_) || /$ignore_indent/ };
  137.         }
  138.         croak "Expected suboutine reference as value for -ignore option"
  139.             if ref $args{ignore} ne 'CODE';
  140.     }
  141.     else {
  142.         $args{ignore} = \&ignore_headers;
  143.     }
  144.     
  145.     # DETABIFY
  146.     my @rawlines = split /\n/, $text;
  147.     use Text::Tabs;
  148.     @rawlines = expand(@rawlines);
  149.  
  150.     # PARSE EACH LINE
  151.  
  152.     my $pre = 0;
  153.     my @lines;
  154.     foreach (@rawlines)
  155.     {
  156.             push @lines, { raw       => $_ };
  157.             s/\A([ \t]*)($quoter?)([ \t]*)//
  158.                 or die "Internal Error ($@) on '$_'";
  159.             $lines[-1]{presig} =  $lines[-1]{prespace}   = defn $1;
  160.             $lines[-1]{presig} .= $lines[-1]{quoter}     = defn $2;
  161.             $lines[-1]{presig} .= $lines[-1]{quotespace} = defn $3;
  162.  
  163.             $lines[-1]{hang}       = Hang->new($_);
  164.  
  165.             s/([ \t]*)(.*?)(\s*)$//
  166.                 or die "Internal Error ($@) on '$_'";
  167.             $lines[-1]{hangspace} = defn $1;
  168.             $lines[-1]{text} = defn $2;
  169.             $lines[-1]{empty} = $lines[-1]{hang}->empty() && $2 !~ /\S/;
  170.             $lines[-1]{separator} = $lines[-1]{text} =~ /^$separator$/;
  171.     }
  172.  
  173.     # SUBDIVIDE DOCUMENT INTO COHERENT SUBSECTIONS
  174.  
  175.     my @chunks;
  176.     push @chunks, [shift @lines];
  177.     foreach my $line (@lines)
  178.     {
  179.         if ($line->{separator} ||
  180.             $line->{quoter} ne $chunks[-1][-1]->{quoter} ||
  181.             $line->{empty} ||
  182.             @chunks && $chunks[-1][-1]->{empty})
  183.         {
  184.             push @chunks, [$line];
  185.         }
  186.         else
  187.         {
  188.             push @{$chunks[-1]}, $line;
  189.         }
  190.     }
  191.  
  192.  
  193.  
  194.  # DETECT CENTRED PARAS
  195.  
  196.     CHUNK: foreach my $chunk ( @chunks )
  197.     {
  198.         next CHUNK if !$args{autocentre} || @$chunk < 2;
  199.         my @length;
  200.         my $ave = 0;
  201.         foreach my $line (@$chunk)
  202.         {
  203.             my $prespace = $line->{quoter}  ? $line->{quotespace}
  204.                             : $line->{prespace};
  205.             my $pagewidth = 
  206.                 2*length($prespace) + length($line->{text});
  207.             push @length, [length $prespace,$pagewidth];
  208.             $ave += $pagewidth;
  209.         }
  210.         $ave /= @length;
  211.         my $diffpre = 0;
  212.         foreach my $l (0..$#length)
  213.         {
  214.             next CHUNK unless abs($length[$l][1]-$ave) <= 2;
  215.             $diffpre ||= $length[$l-1][0] != $length[$l][0]
  216.                 if $l > 0;
  217.         }
  218.         next CHUNK unless $diffpre;
  219.         foreach my $line (@$chunk)
  220.         {
  221.             $line->{centred} = 1;
  222.             ($line->{quoter} ? $line->{quotespace}
  223.                      : $line->{prespace}) = "";
  224.         }
  225.     }
  226.  
  227.     # REDIVIDE INTO PARAGRAPHS
  228.  
  229.     my @paras;
  230.     foreach my $chunk ( @chunks )
  231.     {
  232.         my $first = 1;
  233.         my $firstfrom;
  234.         foreach my $line ( @{$chunk} )
  235.         {
  236.             if ($first ||
  237.                 $line->{quoter} ne $paras[-1]->{quoter} ||
  238.                 $paras[-1]->{separator} ||
  239.                 !$line->{hang}->empty
  240.                )
  241.             {
  242.                 push @paras, $line;
  243.                 $first = 0;
  244.                 $firstfrom = length($line->{raw}) - length($line->{text});
  245.             }
  246.             else
  247.             {
  248.     my $extraspace = length($line->{raw}) - length($line->{text}) - $firstfrom;
  249.                 $paras[-1]->{text} .= "\n" . q{ }x$extraspace . $line->{text};
  250.                 $paras[-1]->{raw} .= "\n" . $line->{raw};
  251.             }
  252.         }
  253.     }
  254.  
  255.     # SELECT PARAS TO HANDLE
  256.  
  257.     my $remainder = "";
  258.     if ($args{all}) { # STOP AT MAIL TERMINATOR
  259.         for my $index (0..$#paras) {
  260.             local $_ = $paras[$index]{raw};
  261.             $paras[$index]{ignore} = $args{ignore}($index+1);
  262.             next unless /^--$/;
  263.             $remainder = join "\n", map { $_->{raw} } splice @paras, $index;
  264.                 $remainder .= "\n" unless $remainder =~ /\n\z/;
  265.             last;
  266.         }
  267.     }
  268.     else { # JUST THE FIRST PARA
  269.         $remainder = join "\n", map { $_->{raw} } @paras[1..$#paras];
  270.             $remainder .= "\n" unless $remainder =~ /\n\z/;
  271.         @paras = ( $paras[0] );
  272.     }
  273.  
  274.     # RE-CASE TEXT
  275.     if ($args{case}) {
  276.         foreach my $para ( @paras ) {
  277.             next if $para->{ignore};
  278.             if ($args{case} =~ /upper/i) {
  279.                 $para->{text} = recase($para->{text}, 'upper');
  280.             }
  281.             if ($args{case} =~ /lower/i) {
  282.                 $para->{text} = recase($para->{text}, 'lower');
  283.             }
  284.             if ($args{case} =~ /title/i) {
  285.                 entitle($para->{text},0);
  286.             }
  287.             if ($args{case} =~ /highlight/i) {
  288.                 entitle($para->{text},1);
  289.             }
  290.             if ($args{case} =~ /sentence(\s*)/i) {
  291.                 my $trailer = $1;
  292.                 $args{squeeze}=0 if $trailer && $trailer ne " ";
  293.                 ensentence();
  294.                 $para->{text} =~ s/(\S+(\s+|$))/ensentence($1, $trailer)/ge;
  295.             }
  296.             $para->{text} =~ s/\b([A-Z])[.]/\U$1./gi; # ABBREVS
  297.         }
  298.     }
  299.  
  300.     # ALIGN QUOTERS
  301.     # DETERMINE HANGING MARKER TYPE (BULLET, ALPHA, ROMAN, ETC.)
  302.  
  303.     my %sigs;
  304.     my $lastquoted = 0;
  305.     my $lastprespace = 0;
  306.     for my $i ( 0..$#paras )
  307.     {
  308.         my $para = $paras[$i];
  309.         next if $para->{ignore};
  310.  
  311.      if ($para->{quoter})
  312.         {
  313.             if ($lastquoted) { $para->{prespace} = $lastprespace }
  314.             else         { $lastquoted = 1; $lastprespace = $para->{prespace} }
  315.         }
  316.         else
  317.         {
  318.             $lastquoted = 0;
  319.         }
  320.     }
  321.  
  322. # RENUMBER PARAGRAPHS
  323.  
  324.     for my $para ( @paras ) {
  325.         next if $para->{ignore};
  326.         my $sig = $para->{presig} . $para->{hang}->signature();
  327.         push @{$sigs{$sig}{hangref}}, $para;
  328.         $sigs{$sig}{hangfields} = $para->{hang}->fields()-1
  329.             unless defined $sigs{$sig}{hangfields};
  330.     }
  331.  
  332.     while (my ($sig,$val) = each %sigs) {
  333.         next unless $sig =~ /rom/;
  334.         field: for my $field ( 0..$val->{hangfields} )
  335.         {
  336.             my $romlen = 0;
  337.             foreach my $para ( @{$val->{hangref}} )
  338.             {
  339.                 my $hang = $para->{hang};
  340.                 my $fieldtype = $hang->field($field);
  341.                 next field 
  342.                     unless $fieldtype && $fieldtype =~ /rom|let/;
  343.                 if ($fieldtype eq 'let') {
  344.                     foreach my $para ( @{$val->{hangref}} ) {
  345.                         $hang->field($field=>'let')
  346.                     }
  347.                 }
  348.                 else {
  349.                     $romlen += length $hang->val($field);
  350.                 }
  351.             }
  352.             # NO ROMAN LETTER > 1 CHAR -> ALPHABETICS
  353.             if ($romlen <= @{$val->{hangref}}) {
  354.                 foreach my $para ( @{$val->{hangref}} ) {
  355.                     $para->{hang}->field($field=>'let')
  356.                 }
  357.             }
  358.         }
  359.     }
  360.  
  361.     my %prev;
  362.  
  363.     for my $para ( @paras ) {
  364.         next if $para->{ignore};
  365.         my $sig = $para->{presig} . $para->{hang}->signature();
  366.         if ($args{renumber}) {
  367.             unless ($para->{quoter}) {
  368.                 $para->{hang}->incr($prev{""}, $prev{$sig});
  369.                 $prev{""} = $prev{$sig} = $para->{hang}
  370.                     unless $para->{hang}->empty;
  371.             }
  372.         }
  373.             
  374.         # COLLECT MAXIMAL HANG LENGTHS BY SIGNATURE
  375.  
  376.         my $siglen = $para->{hang}->length();
  377.         $sigs{$sig}{hanglen} = $siglen
  378.             if ! $sigs{$sig}{hanglen} ||
  379.                $sigs{$sig}{hanglen} < $siglen;
  380.     }
  381.  
  382.     # PROPAGATE MAXIMAL HANG LENGTH
  383.  
  384.     while (my ($sig,$val) = each %sigs)
  385.     {
  386.         foreach (@{$val->{hangref}}) {
  387.             $_->{hanglen} = $val->{hanglen};
  388.         }
  389.     }
  390.  
  391.     # BUILD FORMAT FOR EACH PARA THEN FILL IT 
  392.  
  393.     $text = "";
  394.     my $gap = $paras[0]->{empty} ? 0 : $args{gap};
  395.     for my $para ( @paras )
  396.     {
  397.         if ($para->{empty}) {
  398.         $gap += 1 + ($para->{text} =~ tr/\n/\n/);
  399.         }
  400.         if ($para->{ignore}) {
  401.             $text .= (!$para->{empty} ? "\n"x($args{gap}-$gap) : "") ;
  402.         $text .= $para->{raw};
  403.         $text .= "\n" unless $para->{raw} =~ /\n\z/;
  404.         }
  405.         else {
  406.             my $leftmargin = $args{left} ? " "x($args{left}-1)
  407.                      : $para->{prespace};
  408.             my $hlen = $para->{hanglen} || $para->{hang}->length;
  409.             my $hfield = ($hlen==1 ? '~' : '>'x$hlen);
  410.             my @hang;
  411.             push @hang, $para->{hang}->stringify if $hlen;
  412.             my $format = $leftmargin
  413.                . quotemeta($para->{quoter})
  414.                . $para->{quotespace}
  415.                . $hfield
  416.                . $para->{hangspace};
  417.             my $rightslack = int (($args{right}-length $leftmargin)*$Text::Autoformat::widow_slack);
  418.             my ($widow_okay, $rightindent, $firsttext, $newtext) = (0,0);
  419.             do {
  420.                 my $tlen = $args{right}-$rightindent-length($leftmargin
  421.                              . $para->{quoter}
  422.                              . $para->{quotespace}
  423.                              . $hfield
  424.                              . $para->{hangspace});
  425.                 next if blockquote($text,$para, $format, $tlen, \@hang, \%args);
  426.                 my $tfield = ( $tlen==1                          ? '~'
  427.                      : $para->{centred}||$args{_centred} ? '|'x$tlen
  428.                      : $args{justify} eq 'right'         ? ']'x$tlen
  429.                      : $args{justify} eq 'full'          ? '['x($tlen-2) . ']]'
  430.                      : $para->{centred}||$args{_centred} ? '|'x$tlen
  431.                      :                                     '['x$tlen
  432.                          );
  433.             my $tryformat = "$format$tfield";
  434.             $newtext = (!$para->{empty} ? "\n"x($args{gap}-$gap) : "") 
  435.                      . form( { squeeze=>$args{squeeze}, trim=>1,
  436.                        break=>$args{break},
  437.                        fill => !(!($args{expfill}
  438.                         || $args{impfill} &&
  439.                            !$para->{centred}))
  440.                        },
  441.                     $tryformat, @hang,
  442.                     $para->{text});
  443.             $firsttext ||= $newtext;
  444.             $newtext =~ /\s*([^\n]*)$/;
  445.             $widow_okay = $para->{empty} || length($1) >= $args{widow};
  446.             } until $widow_okay || ++$rightindent > $rightslack;
  447.     
  448.             $text .= $widow_okay ? $newtext : $firsttext;
  449.         }
  450.         $gap = 0 unless $para->{empty};
  451.     }
  452.  
  453.  
  454.     # RETURN FORMATTED TEXT
  455.  
  456.     if ($toSTDOUT) { print STDOUT $text . $remainder; return }
  457.     return $text . $remainder;
  458. }
  459.  
  460. use utf8;
  461.  
  462. my $alpha = qr/[^\W\d_]/;
  463. my $notalpha = qr/[\W\d_]/;
  464. my $word = qr/\pL(?:\pL'?)*/;
  465. my $upper = qr/[^\Wa-z\d_]/;
  466. my $lower = qr/[^\WA-Z\d_]/;
  467. my $mixed = qr/$alpha*?(?:$lower$upper|$upper$lower)$alpha*/;
  468.  
  469. sub recase {
  470.     my ($origtext, $case) = @_;
  471.     my ($entities, $other_entities, $first, $rest) = @{$casing{$case}};
  472.  
  473.     my $text = "";
  474.     my @pieces = split /(&[a-z]+;)/i, $origtext;
  475.     use Data::Dumper 'Dumper';
  476.     push @pieces, "" if @pieces % 2;
  477.     return $text unless @pieces;
  478.     local $_ = shift @pieces;
  479.     if (length $_) {
  480.         $entities = $other_entities;
  481.         &$first;
  482.         $text .= $_;
  483.     }
  484.     return $text unless @pieces;
  485.     $_ = shift @pieces;
  486.     $text .= $entities->{$_} || $_;
  487.     while (@pieces) {
  488.         $_ = shift @pieces; &$rest; $text .= $_;
  489.         $_ = shift @pieces; $text .= $other_entities->{$_} || $_;
  490.     }
  491.     return $text;
  492. }
  493.  
  494. my $alword = qr{(?:\pL|&[a-z]+;)(?:[\pL']|&[a-z]+;)*}i;
  495.  
  496. sub entitle {
  497.     my $ignore = pop;
  498.     local *_ = \shift;
  499.  
  500.     # put into lowercase if on stop list, else titlecase
  501.     s{($alword)}
  502.      { $ignore && $ignore{lc $1} ? recase($1,'lower') : recase($1,'title') }gex;
  503.  
  504.     s/^($alword) /recase($1,'title')/ex;  # last word always to cap
  505.     s/ ($alword)$/recase($1,'title')/ex;  # first word always to cap
  506.  
  507.     # treat parethesized portion as a complete title
  508.     s/\( ($alword) /'('.recase($1,'title')/ex;
  509.     s/($alword) \) /recase($1,'title').')'/ex;
  510.  
  511.     # capitalize first word following colon or semi-colon
  512.     s/ ( [:;] \s+ ) ($alword) /$1 . recase($2,'title')/ex;
  513. }
  514.  
  515. my $abbrev = join '|', qw{
  516.     etc[.]    pp[.]    ph[.]?d[.]    U[.]S[.]
  517. };
  518.  
  519. my $gen_abbrev = join '|', $abbrev, qw{
  520.      (^[^a-z]*([a-z][.])+)
  521. };
  522.  
  523. my $term = q{(?:[.]|[!?]+)};
  524.  
  525. my $eos = 1;
  526. my $brsent = 0;
  527.  
  528. sub ensentence {
  529.     do { $eos = 1; return } unless @_;
  530.     my ($str, $trailer) = @_;
  531.     if ($str =~ /^([^a-z]*)I[^a-z]*?($term?)[^a-z]*$/i) {
  532.         $eos = $2;
  533.         $brsent = $1 =~ /^[[(]/;
  534.         return uc $str
  535.     }
  536.     unless ($str =~ /[a-z].*[A-Z]|[A-Z].*[a-z]/) {
  537.         $str = lc $str;
  538.     }
  539.     if ($eos) {
  540.         $str =~ s/([a-z])/uc $1/ie;
  541.         $brsent = $str =~ /^[[(]/;
  542.     }
  543.     $eos = $str !~ /($gen_abbrev)[^a-z]*\s/i
  544.         && $str =~ /[a-z][^a-z]*$term([^a-z]*)\s/
  545.         && !($1=~/[])]/ && !$brsent);
  546.     $str =~ s/\s+$/$trailer/ if $eos && $trailer;
  547.     return $str;
  548. }
  549.  
  550. # blockquote($text,$para, $format, $tlen, \@hang, \%args);
  551. sub blockquote {
  552.     my ($dummy, $para, $format, $tlen, $hang, $args) = @_;
  553. =begin other
  554.     print STDERR "[", join("|", $para->{raw} =~
  555. / \A(\s*)        # $1 - leading whitespace (quotation)
  556.        (["']|``)        # $2 - opening quotemark
  557.        (.*)            # $3 - quotation
  558.        (''|\2)        # $4 closing quotemark
  559.        \s*?\n        # trailing whitespace
  560.        (\1[ ]+)        # $5 - leading whitespace (attribution)
  561.        (--|-)        # $6 - attribution introducer
  562.        ([^\n]*?$)        # $7 - attribution line 1
  563.        ((\5[^\n]*?$)*)        # $8 - attributions lines 2-N
  564.        \s*\Z
  565.      /xsm
  566. ), "]\n";
  567. =cut
  568.     $para->{text} =~
  569.         / \A(\s*)        # $1 - leading whitespace (quotation)
  570.        (["']|``)        # $2 - opening quotemark
  571.        (.*)            # $3 - quotation
  572.        (''|\2)        # $4 closing quotemark
  573.        \s*?\n        # trailing whitespace
  574.        (\1[ ]+)        # $5 - leading whitespace (attribution)
  575.        (--|-)        # $6 - attribution introducer
  576.        (.*?$)        # $7 - attribution line 1
  577.        ((\5.*?$)*)        # $8 - attributions lines 2-N
  578.        \s*\Z
  579.      /xsm
  580.      or return;
  581.  
  582.     #print "[$1][$2][$3][$4][$5][$6][$7]\n";
  583.     my $indent = length $1;
  584.     my $text = $2.$3.$4;
  585.     my $qindent = length $2;
  586.     my $aindent = length $5;
  587.     my $attribintro = $6;
  588.     my $attrib = $7.$8;
  589.     $text =~ s/\n/ /g;
  590.  
  591.     $_[0] .= 
  592.  
  593.                 form {squeeze=>$args->{squeeze}, trim=>1,
  594.           fill => $args->{expfill}
  595.                    },
  596.        $format . q{ }x$indent . q{<}x$tlen,
  597.              @$hang, $text,
  598.        $format . q{ }x($qindent) . q{[}x($tlen-$qindent), 
  599.              @$hang, $text,
  600.        {squeeze=>0},
  601.        $format . q{ } x $aindent . q{>> } . q{[}x($tlen-$aindent-3),
  602.              @$hang, $attribintro, $attrib;
  603.     return 1;
  604. }
  605.  
  606. package Hang;
  607.  
  608. # ROMAN NUMERALS
  609.  
  610. sub inv($@) { my ($k, %inv)=shift; for(0..$#_) {$inv{$_[$_]}=$_*$k} %inv } 
  611. my @unit= ( "" , qw ( I II III IV V VI VII VIII IX ));
  612. my @ten = ( "" , qw ( X XX XXX XL L LX LXX LXXX XC ));
  613. my @hund= ( "" , qw ( C CC CCC CD D DC DCC DCCC CM ));
  614. my @thou= ( "" , qw ( M MM MMM ));
  615. my %rval= (inv(1,@unit),inv(10,@ten),inv(100,@hund),inv(1000,@thou));
  616. my $rbpat= join ")(",join("|",reverse @thou), join("|",reverse @hund), join("|",reverse @ten), join("|",reverse @unit);
  617. my $rpat= join ")(?:",join("|",reverse @thou), join("|",reverse @hund), join("|",reverse @ten), join("|",reverse @unit);
  618.  
  619. sub fromRoman($)
  620. {
  621.     return 0 unless $_[0] =~ /^.*?($rbpat).*$/i;
  622.     return $rval{uc $1} + $rval{uc $2} + $rval{uc $3} + $rval{uc $4};
  623. }
  624.  
  625. sub toRoman($$)
  626. {
  627.     my ($num,$example) = @_;
  628.     return '' unless $num =~ /^([0-3]??)(\d??)(\d??)(\d)$/;
  629.     my $roman = $thou[$1||0] . $hund[$2||0] . $ten[$3||0] . $unit[$4||0];
  630.     return $example=~/[A-Z]/ ? uc $roman : lc $roman;
  631. }
  632.  
  633. # BITS OF A NUMERIC VALUE
  634.  
  635. my $num = q/(?:\d{1,3}\b)/;
  636. my $rom = qq/(?:(?=[MDCLXVI])(?:$rpat))/;
  637. my $let = q/[A-Za-z]/;
  638. my $pbr = q/[[(<]/;
  639. my $sbr = q/])>/;
  640. my $ows = q/[ \t]*/;
  641. my %close = ( '[' => ']', '(' => ')', '<' => '>', "" => '' );
  642.  
  643. my $hangPS      = qq{(?i:ps:|(?:p\\.?)+s\\b\\.?(?:[ \\t]*:)?)};
  644. my $hangNB      = qq{(?i:n\\.?b\\.?(?:[ \\t]*:)?)};
  645. my $hangword    = qq{(?:(?:Note)[ \\t]*:)};
  646. my $hangbullet  = qq{[*.+-]};
  647. my $hang        = qq{(?:(?i)(?:$hangNB|$hangword|$hangbullet)(?=[ \t]))};
  648.  
  649. # IMPLEMENTATION
  650.  
  651. sub new { 
  652.     my ($class, $orig) = @_;
  653.     my $origlen = length $orig;
  654.     my @vals;
  655.     if ($_[1] =~ s#\A($hangPS)##) {
  656.         @vals = { type => 'ps', val => $1 }
  657.     }
  658.     elsif ($_[1] =~ s#\A($hang)##) {
  659.         @vals = { type => 'bul', val => $1 }
  660.     }
  661.     else {
  662.         local $^W;
  663.         my $cut;
  664.         while (length $_[1]) {
  665.             last if $_[1] =~ m#\A($ows)($abbrev)#
  666.                  && (length $1 || !@vals);    # ws-separated or first
  667.  
  668.             $cut = $origlen - length $_[1];
  669.             my $pre = $_[1] =~ s#\A($ows$pbr$ows)## ? $1 : "";
  670.             my $val =  $_[1] =~ s#\A($num)##  && { type=>'num', val=>$1 }
  671.                    || $_[1] =~ s#\A($rom)##i && { type=>'rom', val=>$1, nval=>fromRoman($1) }
  672.                    || $_[1] =~ s#\A($let(?!$let))##i && { type=>'let', val=>$1 }
  673.                    || { val => "", type => "" };
  674.             $_[1] = $pre.$_[1] and last unless $val->{val};
  675.             $val->{post} = $pre && $_[1] =~ s#\A($ows()[.:/]?[$close{$pre}][.:/]?)## && $1
  676.                              || $_[1] =~ s#\A($ows()[$sbr.:/])## && $1
  677.                              || "";
  678.             $val->{pre}  = $pre;
  679.             $val->{cut}  = $cut;
  680.             push @vals, $val;
  681.         }
  682.         while (@vals && !$vals[-1]{post}) {
  683.             $_[1] = substr($orig,pop(@vals)->{cut});
  684.         }
  685.     }
  686.     # check for orphaned years...
  687.     if (@vals==1 && $vals[0]->{type} eq 'num'
  688.              && $vals[0]->{val} >= 1000
  689.              && $vals[0]->{post} eq '.')  {
  690.         $_[1] = substr($orig,pop(@vals)->{cut});
  691.  
  692.         }
  693.     return NullHang->new if !@vals;
  694.     bless \@vals, $class;
  695. } 
  696.  
  697. sub incr {
  698.     local $^W;
  699.     my ($self, $prev, $prevsig) = @_;
  700.     my $level;
  701.     # check compatibility
  702.  
  703.     return unless $prev && !$prev->empty;
  704.  
  705.     for $level (0..(@$self<@$prev ? $#$self : $#$prev)) {
  706.         if ($self->[$level]{type} ne $prev->[$level]{type}) {
  707.             return if @$self<=@$prev;    # no incr if going up
  708.             $prev = $prevsig;
  709.             last;
  710.         }
  711.     }
  712.     return unless $prev && !$prev->empty;
  713.     if ($self->[0]{type} eq 'ps') {
  714.         my $count = 1 + $prev->[0]{val} =~ s/(p[.]?)/$1/gi;
  715.         $prev->[0]{val} =~ /^(p[.]?).*(s[.]?[:]?)/;
  716.         $self->[0]{val} = $1  x $count . $2;
  717.     }
  718.     elsif ($self->[0]{type} eq 'bul') {
  719.         # do nothing
  720.     }
  721.     elsif (@$self>@$prev) {    # going down level(s)
  722.         for $level (0..$#$prev) {
  723.                 @{$self->[$level]}{'val','nval'} = @{$prev->[$level]}{'val','nval'};
  724.         }
  725.         for $level (@$prev..$#$self) {
  726.                 _reset($self->[$level]);
  727.         }
  728.     }
  729.     else    # same level or going up
  730.     {
  731.         for $level (0..$#$self) {
  732.             @{$self->[$level]}{'val','nval'} = @{$prev->[$level]}{'val','nval'};
  733.         }
  734.         _incr($self->[-1])
  735.     }
  736. }
  737.  
  738. sub _incr {
  739.     local $^W;
  740.     if ($_[0]{type} eq 'rom') {
  741.         $_[0]{val} = toRoman(++$_[0]{nval},$_[0]{val});
  742.     }
  743.     else {
  744.         $_[0]{val}++ unless $_[0]{type} eq 'let' && $_[0]{val}=~/Z/i;
  745.     }
  746. }
  747.  
  748. sub _reset {
  749.     local $^W;
  750.     if ($_[0]{type} eq 'rom') {
  751.         $_[0]{val} = toRoman($_[0]{nval}=1,$_[0]{val});
  752.     }
  753.     elsif ($_[0]{type} eq 'let') {
  754.         $_[0]{val} = $_[0]{val} =~ /[A-Z]/ ? 'A' : 'a';
  755.     }
  756.     else {
  757.         $_[0]{val} = 1;
  758.     }
  759. }
  760.  
  761. sub stringify {
  762.     my ($self) = @_;
  763.     my ($str, $level) = ("");
  764.     for $level (@$self) {
  765.         local $^W;
  766.         $str .= join "", @{$level}{'pre','val','post'};
  767.     }
  768.     return $str;
  769. } 
  770.  
  771. sub val {
  772.     my ($self, $i) = @_;
  773.     return $self->[$i]{val};
  774. }
  775.  
  776. sub fields { return scalar @{$_[0]} }
  777.  
  778. sub field {
  779.     my ($self, $i, $newval) = @_;
  780.     $self->[$i]{type} = $newval if @_>2;
  781.     return $self->[$i]{type};
  782. }
  783.  
  784. sub signature {
  785.     local $^W;
  786.     my ($self) = @_;
  787.     my ($str, $level) = ("");
  788.     for $level (@$self) {
  789.         $level->{type} ||= "";
  790.         $str .= join "", $level->{pre},
  791.                          ($level->{type} =~ /rom|let/ ? "romlet" : $level->{type}),
  792.                          $level->{post};
  793.     }
  794.     return $str;
  795. } 
  796.  
  797. sub length {
  798.     length $_[0]->stringify
  799. }
  800.  
  801. sub empty { 0 }
  802.  
  803. package NullHang;
  804.  
  805. sub new       { bless {}, $_[0] }
  806. sub stringify { "" }
  807. sub length    { 0 }
  808. sub incr      {}
  809. sub empty     { 1 }
  810. sub signature     { "" }
  811. sub fields { return 0 }
  812. sub field { return "" }
  813. sub val { return "" }
  814. 1;
  815.  
  816. __END__
  817.  
  818. =head1 NAME
  819.  
  820. Text::Autoformat - Automatic text wrapping and reformatting
  821.  
  822. =head1 VERSION
  823.  
  824. This document describes version 1.12 of Text::Autoformat,
  825. released May 27, 2003.
  826.  
  827. =head1 SYNOPSIS
  828.  
  829.  # Minimal use: read from STDIN, format to STDOUT...
  830.  
  831.     use Text::Autoformat;
  832.     autoformat;
  833.  
  834.  # In-memory formatting...
  835.  
  836.     $formatted = autoformat $rawtext;
  837.  
  838.  # Configuration...
  839.  
  840.     $formatted = autoformat $rawtext, { %options };
  841.  
  842.  # Margins (1..72 by default)...
  843.  
  844.     $formatted = autoformat $rawtext, { left=>8, right=>70 };
  845.  
  846.  # Justification (left by default)...
  847.  
  848.     $formatted = autoformat $rawtext, { justify => 'left' };
  849.     $formatted = autoformat $rawtext, { justify => 'right' };
  850.     $formatted = autoformat $rawtext, { justify => 'full' };
  851.     $formatted = autoformat $rawtext, { justify => 'centre' };
  852.  
  853.  # Filling (does so by default)...
  854.  
  855.     $formatted = autoformat $rawtext, { fill=>0 };
  856.  
  857.  # Squeezing whitespace (does so by default)...
  858.  
  859.     $formatted = autoformat $rawtext, { squeeze=>0 };
  860.  
  861.  # Case conversions...
  862.  
  863.     $formatted = autoformat $rawtext, { case => 'lower' };
  864.     $formatted = autoformat $rawtext, { case => 'upper' };
  865.     $formatted = autoformat $rawtext, { case => 'sentence' };
  866.     $formatted = autoformat $rawtext, { case => 'title' };
  867.     $formatted = autoformat $rawtext, { case => 'highlight' };
  868.  
  869.  # Selective reformatting
  870.  
  871.     $formatted = autoformat $rawtext, { ignore=>qr/^\t/ };
  872.  
  873.  
  874. =head1 BACKGROUND
  875.  
  876. =head2 The problem
  877.  
  878. Perl plaintext formatters just aren't smart enough. Given a typical
  879. piece of plaintext in need of formatting:
  880.  
  881.         In comp.lang.perl.misc you wrote:
  882.         : > <CN = Clooless Noobie> writes:
  883.         : > CN> PERL sux because:
  884.         : > CN>    * It doesn't have a switch statement and you have to put $
  885.         : > CN>signs in front of everything
  886.         : > CN>    * There are too many OR operators: having |, || and 'or'
  887.         : > CN>operators is confusing
  888.         : > CN>    * VB rools, yeah!!!!!!!!!
  889.         : > CN> So anyway, how can I stop reloads on a web page?
  890.         : > CN> Email replies only, thanks - I don't read this newsgroup.
  891.         : >
  892.         : > Begone, sirrah! You are a pathetic, Bill-loving, microcephalic
  893.         : > script-infant.
  894.         : Sheesh, what's with this group - ask a question, get toasted! And how
  895.         : *dare* you accuse me of Ianuphilia!
  896.  
  897. both the venerable Unix L<fmt> tool and Perl's standard Text::Wrap module
  898. produce:
  899.  
  900.         In comp.lang.perl.misc you wrote:  : > <CN = Clooless Noobie>
  901.         writes:  : > CN> PERL sux because:  : > CN>    * It doesn't
  902.         have a switch statement and you have to put $ : > CN>signs in
  903.         front of everything : > CN>    * There are too many OR
  904.         operators: having |, || and 'or' : > CN>operators is confusing
  905.         : > CN>    * VB rools, yeah!!!!!!!!!  : > CN> So anyway, how
  906.         can I stop reloads on a web page?  : > CN> Email replies only,
  907.         thanks - I don't read this newsgroup.  : > : > Begone, sirrah!
  908.         You are a pathetic, Bill-loving, microcephalic : >
  909.         script-infant.  : Sheesh, what's with this group - ask a
  910.         question, get toasted! And how : *dare* you accuse me of
  911.         Ianuphilia!
  912.  
  913. Other formatting modules -- such as Text::Correct and Text::Format --
  914. provide more control over their output, but produce equally poor results
  915. when applied to arbitrary input. They simply don't understand the
  916. structural conventions of the text they're reformatting.
  917.  
  918. =head2 The solution
  919.  
  920. The Text::Autoformat module provides a subroutine named C<autoformat> that
  921. wraps text to specified margins. However, C<autoformat> reformats its
  922. input by analysing the text's structure, so it wraps the above example
  923. like so:
  924.  
  925.         In comp.lang.perl.misc you wrote:
  926.         : > <CN = Clooless Noobie> writes:
  927.         : > CN> PERL sux because:
  928.         : > CN>    * It doesn't have a switch statement and you
  929.         : > CN>      have to put $ signs in front of everything
  930.         : > CN>    * There are too many OR operators: having |, ||
  931.         : > CN>      and 'or' operators is confusing
  932.         : > CN>    * VB rools, yeah!!!!!!!!! So anyway, how can I
  933.         : > CN>      stop reloads on a web page? Email replies
  934.         : > CN>      only, thanks - I don't read this newsgroup.
  935.         : >
  936.         : > Begone, sirrah! You are a pathetic, Bill-loving,
  937.         : > microcephalic script-infant.
  938.         : Sheesh, what's with this group - ask a question, get toasted!
  939.         : And how *dare* you accuse me of Ianuphilia!
  940.  
  941. Note that the various quoting conventions have been observed. In fact,
  942. their structure has been used to determine where some paragraphs begin.
  943. Furthermore C<autoformat> correctly distinguished between the leading
  944. '*' bullets of the nested list (which were outdented) and the leading
  945. emphatic '*' of "*dare*" (which was inlined).
  946.  
  947. =head1 DESCRIPTION
  948.  
  949. =head2 Paragraphs
  950.  
  951. The fundamental task of the C<autoformat> subroutine is to identify and
  952. rearrange independent paragraphs in a text. Paragraphs typically consist
  953. of a series of lines containing at least one non-whitespace character,
  954. followed by one or more lines containing only optional whitespace.
  955. This is a more liberal definition than many other formatters
  956. use: most require an empty line to terminate a paragraph. Paragraphs may
  957. also be denoted by bulleting, numbering, or quoting (see the following
  958. sections).
  959.  
  960. Once a paragraph has been isolated, C<autoformat> fills and re-wraps its
  961. lines according to the margins that are specified in its argument list.
  962. These are placed after the text to be formatted, in a hash reference:
  963.  
  964.         $tidied = autoformat($messy, {left=>20, right=>60});
  965.  
  966. By default, C<autoformat> uses a left margin of 1 (first column) and a
  967. right margin of 72.
  968.  
  969. You can also control whether (and how) C<autoformat> breaks words at the
  970. end of a line, using the C<'break'> option:
  971.  
  972.     # Turn off all hyphenation
  973.     use Text::Autoformat qw(autoformat break_wrap);
  974.         $tidied = autoformat($messy, {break=>break_wrap});
  975.  
  976.     # Default hyphenation
  977.     use Text::Autoformat qw(autoformat break_at);
  978.         $tidied = autoformat($messy, {break=>break_at('-')});
  979.  
  980.     # Use TeX::Hyphen module's hyphenation (module must be installed)
  981.     use Text::Autoformat qw(autoformat break_TeX);
  982.         $tidied = autoformat($messy, {break=>break_TeX});
  983.  
  984.  
  985. Normally, C<autoformat> only reformats the first paragraph it encounters,
  986. and leaves the remainder of the text unaltered. This behaviour is useful
  987. because it allows a one-liner invoking the subroutine to be mapped
  988. onto a convenient keystroke in a text editor, to provide 
  989. one-paragraph-at-a-time reformatting:
  990.  
  991.         % cat .exrc
  992.  
  993.         map f !Gperl -MText::Autoformat -e'autoformat'
  994.  
  995. (Note that to facilitate such one-liners, if C<autoformat> is called
  996. in a void context without any text data, it takes its text from
  997. C<STDIN> and writes its result to C<STDOUT>).
  998.  
  999. To enable C<autoformat> to rearrange the entire input text at once, the
  1000. C<all> argument is used:
  1001.  
  1002.         $tidied_all = autoformat($messy, {left=>20, right=>60, all=>1});
  1003.  
  1004. C<autoformat> can also be directed to selectively reformat paragraphs,
  1005. using the C<ignore> argument:
  1006.  
  1007.         $tidied_some = autoformat($messy, {ignore=>qr/^[ \t]/});
  1008.  
  1009. The value for C<ignore> may be a C<qr>'d regex, a subroutine reference,
  1010. or the special string C<'indented'>.
  1011.  
  1012. If a regex is specified, any paragraph whose original text matches that
  1013. regex will not be reformatted (i.e. it will be printed verbatim).
  1014.  
  1015. If a subroutine is specified, that subroutine will be called once for
  1016. each paragraph (with C<$_> set to the paragraph's text). The subroutine is
  1017. expected to return a true or false value. If it returns true, the
  1018. paragraph will not be reformatted.
  1019.  
  1020. If the value of the C<ignore> option is the string C<'indented'>,
  1021. C<autoformat> will ignore any paragraph in which I<every> line begins with a
  1022. whitespace.
  1023.  
  1024. =head2 Bulleting and (re-)numbering
  1025.  
  1026. Often plaintext will include lists that are either:
  1027.  
  1028.         * bulleted,
  1029.         * simply numbered (i.e. 1., 2., 3., etc.), or
  1030.         * hierarchically numbered (1, 1.1, 1.2, 1.3, 2, 2.1. and so forth).
  1031.  
  1032. In such lists, each bulleted item is implicitly a separate paragraph,
  1033. and is formatted individually, with the appropriate indentation:
  1034.  
  1035.         * bulleted,
  1036.         * simply numbered (i.e. 1., 2., 3.,
  1037.           etc.), or
  1038.         * hierarchically numbered (1, 1.1,
  1039.           1.2, 1.3, 2, 2.1. and so forth).
  1040.  
  1041. More importantly, if the points are numbered, the numbering is
  1042. checked and reordered. For example, a list whose points have been
  1043. rearranged:
  1044.  
  1045.         2. Analyze problem
  1046.         3. Design algorithm
  1047.         1. Code solution
  1048.         5. Test
  1049.         4. Ship
  1050.  
  1051. would be renumbered automatically by C<autoformat>:
  1052.  
  1053.         1. Analyze problem
  1054.         2. Design algorithm
  1055.         3. Code solution
  1056.         4. Ship
  1057.         5. Test
  1058.  
  1059. The same reordering would be performed if the "numbering" was by letters
  1060. (C<a.> C<b.> C<c.> etc.) or Roman numerals (C<i.> C<ii.> C<iii.)> or by
  1061. some combination of these (C<1a.> C<1b.> C<2a.> C<2b.> etc.) Handling
  1062. disordered lists of letters and Roman numerals presents an interesting
  1063. challenge. A list such as:
  1064.  
  1065.         C. Put cat in box.
  1066.         D. Close lid.
  1067.         E. Activate Geiger counter.
  1068.  
  1069. should be reordered as C<A.> C<B.> C<C.,> whereas:
  1070.  
  1071.         C. Put cat in box.
  1072.         D. Close lid.
  1073.         XLI. Activate Geiger counter.
  1074.  
  1075. should be reordered C<I.> C<II.> C<III.> 
  1076.  
  1077. The C<autoformat> subroutine solves this problem by always interpreting 
  1078. alphabetic bullets as being letters, unless the full list consists
  1079. only of valid Roman numerals, at least one of which is two or
  1080. more characters long.
  1081.  
  1082. If automatic renumbering isn't wanted, just specify the C<'renumber'>
  1083. option with a false value.
  1084.  
  1085. Note that numbers above 1000 at the start of a line are no longer
  1086. considered to be paragraph numbering. Numbered paragraphs running that
  1087. high are exceptionally rare, and much rarer than paragraphs that look
  1088. like this:
  1089.  
  1090.         Although it has long been popular (especially in the year
  1091.         2001) to point out that we now live in the Future, many
  1092.         of the promised miracles of Future Life have failed to
  1093.         eventuate. This is a new phenomenon (it didn't happen in
  1094.         1001) because the idea that the future might be different
  1095.         is a new phenomenon.
  1096.  
  1097. which the former numbering rules caused to be formatted like this:
  1098.  
  1099.         Although it has long been popular (especially in the year
  1100.  
  1101.         2001) to point out that we now live in the Future, many of the
  1102.               promised miracles of Future Life have failed to eventuate.
  1103.               This is a new phenomenon (it didn't happen in
  1104.  
  1105.         2002) because the idea that the future might be different is a
  1106.               new phenomenon.
  1107.  
  1108. but which are now formatted:
  1109.  
  1110.         Although it has long been popular (especially in the year 2001)
  1111.         to point out that we now live in the Future, many of the
  1112.         promised miracles of Future Life have failed to eventuate. This
  1113.         is a new phenomenon (it didn't happen in 1001) because the idea
  1114.         that the future might be different is a new phenomenon.
  1115.  
  1116. =head2 Quoting
  1117.  
  1118. Another case in which contiguous lines may be interpreted as belonging
  1119. to different paragraphs, is where they are quoted with distinct quoters.
  1120. For example:
  1121.  
  1122.         : > CN> So anyway, how can I stop reloads on a web page? Email
  1123.         : > CN> replies only, thanks - I don't read this newsgroup.
  1124.         : > Begone, sirrah! You are a pathetic, Bill-loving,
  1125.         : > microcephalic script-infant.
  1126.         : Sheesh, what's with this group - ask a question, get toasted!
  1127.         : And how *dare* you accuse me of Ianuphilia!
  1128.  
  1129. C<autoformat> recognizes the various quoting conventions used in this
  1130. example and treats it as three paragraphs to be independently
  1131. reformatted.
  1132.  
  1133. Block quotations present a different challenge. A typical formatter
  1134. would render the following quotation:
  1135.  
  1136.         "We are all of us in the gutter, but some of us are looking at
  1137.          the stars"
  1138.                                 -- Oscar Wilde
  1139.  
  1140. like so:
  1141.  
  1142.         "We are all of us in the gutter, but some of us are looking at
  1143.         the stars" -- Oscar Wilde
  1144.  
  1145. C<autoformat> recognizes the quotation structure by matching the
  1146. following regular expression against the text component of each
  1147. paragraph:
  1148.  
  1149.         / \A(\s*) # leading whitespace for quotation (["']|``) # opening
  1150.         quotemark (.*) # quotation (''|\2) # closing quotemark \s*?\n #
  1151.         trailing whitespace after quotation (\1[ ]+) # leading
  1152.         whitespace for attribution
  1153.                                 #   (must be indented more than
  1154.                                 #   quotation)
  1155.           (--|-) # attribution introducer ([^\n]*?\n) # first
  1156.           attribution line ((\5[^\n]*?$)*) # other attribution lines
  1157.                                 #   (indented no less than first line)
  1158.           \s*\Z # optional whitespace to end of paragraph /xsm
  1159.  
  1160. When reformatted (see below), the indentation and the attribution
  1161. structure will be preserved:
  1162.  
  1163.         "We are all of us in the gutter, but some of us are looking at
  1164.          the stars"
  1165.                                 -- Oscar Wilde
  1166.  
  1167. =head2 Widow control
  1168.  
  1169. Note that in the last example, C<autoformat> broke the line at column
  1170. 68, four characters earlier than it should have. It did so because, if
  1171. the full margin width had been used, the formatting would have left the
  1172. last two words by themselves on an oddly short last line:
  1173.  
  1174.         "We are all of us in the gutter, but some of us are looking at
  1175.         the stars"
  1176.  
  1177. This phenomenon is known as "widowing" and is heavily frowned upon in
  1178. typesetting circles. It looks ugly in plaintext too, so C<autoformat>
  1179. avoids it by stealing extra words from earlier lines in a paragraph, so
  1180. as to leave enough for a reasonable last line. The heuristic used is
  1181. that final lines must be at least 10 characters long (though this number
  1182. may be adjusted by passing a C<widow =E<gt> I<minlength>> argument to
  1183. C<autoformat>).
  1184.  
  1185. If the last line is too short, the paragraph's right margin is reduced
  1186. by one column, and the paragraph is reformatted. This process iterates
  1187. until either the last line exceeds nine characters or the margins have
  1188. been narrowed by 10% of their original separation. In the latter case,
  1189. the reformatter gives up and uses its original formatting.
  1190.  
  1191.  
  1192. =head2 Justification
  1193.  
  1194. The C<autoformat> subroutine also takes a named argument: C<{justify
  1195. =E<gt> I<type>}>, which specifies how each paragraph is to be justified.
  1196. The options are: C<'left'> (the default), C<'right',> C<'centre'> (or
  1197. C<'center'>), and C<'full'>. These act on the complete paragraph text
  1198. (but I<not> on any quoters before that text). For example, with
  1199. C<'right'> justification:
  1200.  
  1201.          R3>     Now is the Winter of our discontent made
  1202.          R4> glorious Summer by this son of York. And all
  1203.          R5> the clouds that lour'd upon our house In the
  1204.          R6>              deep bosom of the ocean buried.
  1205.  
  1206. Full justification is interesting in a fixed-width medium like plaintext
  1207. because it usually results in uneven spacing between words. Typically,
  1208. formatters provide this by distributing the extra spaces into the first
  1209. available gaps of each line:
  1210.  
  1211.          R7> Now is the Winter of our discontent made
  1212.          R8> glorious Summer by this son of York. And all
  1213.          R9> the clouds that lour'd upon our house In
  1214.         R10> the deep bosom of the ocean buried.
  1215.  
  1216. This produces a rather jarring visual effect, so C<autoformat> reverses
  1217. the strategy and inserts extra spaces at the end of lines:
  1218.  
  1219.         R11> Now is the Winter of our discontent made
  1220.         R12> glorious Summer by this son of York. And all
  1221.         R13> the clouds that lour'd upon our house In
  1222.         R14> the deep bosom of the ocean buried.
  1223.  
  1224. Most readers find this less disconcerting.
  1225.  
  1226. =head2 Implicit centring
  1227.  
  1228. Even if explicit centring is not specified, C<autoformat> will attempt
  1229. to automatically detect centred paragraphs and preserve their
  1230. justification. It does this by examining each line of the paragraph and
  1231. asking: "if this line were part of a centred paragraph, where would the
  1232. centre line have been?"
  1233.  
  1234. The answer can be determined by adding the length of leading whitespace
  1235. before the first word, plus half the length of the full set of words on
  1236. the line. That is, for a single line:
  1237.  
  1238.         $line =~ /^(\s*)(.*?)(\s*)$/ $centre =
  1239.         length($1)+0.5*length($2);
  1240.  
  1241. By making the same estimate for every line, and then comparing the
  1242. estimates, it is possible to deduce whether all the lines are centred
  1243. with respect to the same axis of symmetry (with an allowance of
  1244. E<plusmn>1 to cater for the inevitable rounding when the centre
  1245. positions of even-length rows were originally computed). If a common
  1246. axis of symmetry is detected, C<autoformat> assumes that the lines are
  1247. supposed to be centred, and switches to centre-justification mode for
  1248. that paragraph.
  1249.  
  1250. Note that this behaviour can to switched off entirely by setting the
  1251. C<"autocentre"> argument false.
  1252.  
  1253. =head2 Case transformations
  1254.  
  1255. The C<autoformat> subroutine can also optionally perform case
  1256. conversions on the text it processes. The C<{case =E<gt> I<type>}>
  1257. argument allows the user to specify five different conversions:
  1258.  
  1259. =over 4
  1260.  
  1261. =item C<'upper'>
  1262.  
  1263. This mode unconditionally converts every letter in the reformatted text
  1264. to upper-case;
  1265.  
  1266. =item C<'lower'>
  1267.  
  1268. This mode unconditionally converts every letter in the reformatted text
  1269. to lower-case;
  1270.  
  1271. =item C<'sentence'>
  1272.  
  1273. This mode attempts to generate correctly-cased sentences from the input
  1274. text. That is, the first letter after a sentence-terminating punctuator
  1275. is converted to upper-case. Then, each subsequent word in the sentence
  1276. is converted to lower-case, unless that word is originally mixed-case or
  1277. contains punctuation. For example, under C<{case =E<gt> 'sentence'}>:
  1278.  
  1279.         'POVERTY, MISERY, ETC. are the lot of the PhD candidate. alas!'
  1280.  
  1281. becomes:
  1282.  
  1283.         'Poverty, misery, etc. are the lot of the PhD candidate. Alas!'
  1284.  
  1285. Note that C<autoformat> is clever enough to recognize that the period
  1286. after abbreviations such as C<etc.> is not a sentence terminator.
  1287.  
  1288. If the argument is specified as C<'sentence '> (with one or more
  1289. trailing whitespace characters) those characters are used to replace the
  1290. single space that appears at the end of the sentence. For example,
  1291. C<autoformat($text, {case=E<gt>'sentence '}>) would produce:
  1292.  
  1293.         'Poverty, misery, etc. are the lot of the PhD candidate. Alas!'
  1294.  
  1295. =item C<'title'>
  1296.  
  1297. This mode behaves like C<'sentence'> except that the first letter of
  1298. I<every> word is capitalized:
  1299.  
  1300.         'What I Did On My Summer Vacation In Monterey'
  1301.  
  1302. =item C<'highlight'>
  1303.  
  1304. This mode behaves like C<'title'> except that trivial words are not
  1305. capitalized:
  1306.  
  1307.         'What I Did on my Summer Vacation in Monterey'
  1308.  
  1309. =back
  1310.  
  1311. =head2 Selective reformatting
  1312.  
  1313. You can select which paragraphs C<autoformat> actually reformats (or,
  1314. rather, those it I<doesn't> reformat) using the C<"ignore"> flag.
  1315.  
  1316. For example:
  1317.  
  1318.         # Reformat all paras except those containing "verbatim"...
  1319.         print autoformat { all => 1, ignore => qr/verbatim/i }, $text;
  1320.  
  1321.         # Reformat all paras except those less that 3 lines long...
  1322.         print autoformat { all => 1, ignore => sub { tr/\n/\n/ < 3
  1323.         } }, $text;
  1324.  
  1325.         # Reformat all paras except those that are indented...
  1326.         print autoformat { all => 1, ignore => qr/^\s/m }, $text;
  1327.  
  1328.         # Reformat all paras except those that are indented (easier)...
  1329.         print autoformat { all => 1, ignore => 'indented' }, $text;
  1330.  
  1331.  
  1332. =head1 SEE ALSO
  1333.  
  1334. The Text::Reform module
  1335.  
  1336. =head1 AUTHOR
  1337.  
  1338. Damian Conway (damian@conway.org)
  1339.  
  1340. =head1 BUGS
  1341.  
  1342. There are undoubtedly serious bugs lurking somewhere in code this funky
  1343. :-) Bug reports and other feedback are most welcome.
  1344.  
  1345. =head1 COPYRIGHT
  1346.  
  1347. Copyright (c) 1997-2000, Damian Conway. All Rights Reserved. This module
  1348. is free software. It may be used, redistributed and/or modified under
  1349. the terms of the Perl Artistic License (see
  1350. http://www.perl.com/perl/misc/Artistic.html)
  1351.