home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _a21e093b44458bab6e563fa98932e043 < prev    next >
Encoding:
Text File  |  2004-04-13  |  70.2 KB  |  2,407 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.04';
  6.  
  7. require Exporter;
  8.  
  9. @ISA = qw(Exporter);
  10. @EXPORT = qw( autoformat );
  11. @EXPORT_OK = qw( form tag break_with break_wrap break_TeX );
  12.  
  13.  
  14. my $IGNORABLES = join "|", qw {
  15.     a an at as and are
  16.     but by 
  17.     for from
  18.     in is
  19.     of on or
  20.     the to that 
  21.     with while whilst with without
  22. };
  23.  
  24.  
  25. my @bspecials = qw( [ | ] );
  26. my @lspecials = qw( < ^ > );
  27. my $ljustified = '[<]{2,}[>]{2,}';
  28. my $bjustified = '[[]{2,}[]]{2,}';
  29. my $bsingle    = '~+';
  30. my @specials = (@bspecials, @lspecials);
  31. my $fixed_fieldpat = join('|', ($ljustified, $bjustified,
  32.                 $bsingle,
  33.                 map { "\\$_\{2,}" } @specials));
  34. my ($lfieldmark, $bfieldmark, $fieldmark, $fieldpat, $decimal);
  35. my $emptyref = '';
  36.  
  37. sub import
  38. {
  39. #    use POSIX qw( localeconv );
  40. #    $decimal = localeconv()->{decimal_point} || '.';
  41.     $decimal = '.';
  42.  
  43.     my $lnumerical = '[>]+(?:'.quotemeta($decimal).'[<]{1,})';
  44.     my $bnumerical = '[]]+(?:'.quotemeta($decimal).'[[]{1,})';
  45.  
  46.     $fieldpat = join('|', ($lnumerical, $bnumerical,$fixed_fieldpat));
  47.  
  48.     $lfieldmark = join '|', ($lnumerical, $ljustified, map { "\\$_\{2}" } @lspecials);
  49.     $bfieldmark = join '|', ($bnumerical, $bjustified, $bsingle, map { "\\$_\{2}" } @bspecials);
  50.     $fieldmark  = join '|', ($lnumerical, $bnumerical,
  51.                  $bsingle,
  52.                  $ljustified, $bjustified,
  53.                  $lfieldmark, $bfieldmark);
  54.  
  55.     Text::Autoformat->export_to_level(1, @_);
  56. }
  57.  
  58. ###### USEFUL TOOLS ######################################
  59.  
  60. #===== form =============================================#
  61.  
  62. sub BAD_CONFIG { 'Configuration hash not allowed between format and data' }
  63.  
  64. sub break_with
  65. {
  66.     my $hyphen = $_[0];
  67.     my $hylen = length($hyphen);
  68.     my @ret;
  69.     sub
  70.     {
  71.         if ($_[2]<=$hylen)
  72.         {
  73.             @ret = (substr($_[0],0,1), substr($_[0],1))
  74.         }
  75.         else
  76.         {
  77.             @ret = (substr($_[0],0,$_[1]-length($hyphen)),
  78.                 substr($_[0],$_[1]-length($hyphen)))
  79.         }
  80.         if ($ret[0] =~ /\A\s*\Z/) { return ("",$_[0]); }
  81.         else { return ($ret[0].$hyphen,$ret[1]); }
  82.     }
  83.  
  84. }
  85.  
  86. sub break_wrap
  87. {
  88.     return \&break_wrap unless @_;
  89.     my ($text, $reqlen, $fldlen) = @_;
  90.     if ($reqlen==$fldlen) { $text =~ m/\A(\s*\S*)(.*)/s }
  91.     else                  { ("", $text) }
  92. }
  93.  
  94. my %hyp;
  95. sub break_TeX
  96. {
  97.     my $file = $_[0] || "";
  98.  
  99.     croak "Can't find TeX::Hypen module"
  100.         unless require "TeX/Hyphen.pm";
  101.  
  102.     $hyp{$file} = TeX::Hyphen->new($file||undef)
  103.             || croak "Can't open hyphenation file $file"
  104.         unless $hyp{$file};
  105.  
  106.     return sub {
  107.         for (reverse $hyp{$file}->hyphenate($_[0])) {
  108.             if ($_ < $_[1]) {
  109.                 return (substr($_[0],0,$_).'-',
  110.                     substr($_[0],$_) );
  111.             }
  112.         }
  113.         return ("",$_[0]);
  114.     }
  115. }
  116.  
  117. sub debug { print STDERR @_, "\n" if $::DEBUG || $::DEBUG }
  118.  
  119. sub notempty
  120. {
  121.     my $ne = ${$_[0]} =~ /\S/;
  122.     debug("\tnotempty('${$_[0]}') = $ne\n");
  123.     return $ne;
  124. }
  125.  
  126. sub replace($$$$)   # ($fmt, $len, $argref, $config)
  127. {
  128.     my $ref = $_[2];
  129.     my $text = '';
  130.     my $rem = $_[1];
  131.     my $config = $_[3];
  132.  
  133.     $$ref =~ s/\A\s*//;
  134.     my $fmtnum = length $_[0];
  135.  
  136.     if ($$ref =~ /\S/ && $fmtnum>2)
  137.     {
  138.     NUMERICAL:{
  139.         #use POSIX qw( strtod );
  140.         my ($ilen,$dlen) = map {length} $_[0] =~ m/([]>]+)\Q$decimal\E([[<]+)/;
  141.         my ($num,$unconsumed) = strtod($$ref);
  142.         if ($unconsumed == length $$ref)
  143.         {
  144.             $$ref =~ s/\s*\S*//;
  145.             redo NUMERICAL if $config->{numeric} =~ m/\bSkipNaN\b/i
  146.                        && $$ref =~ m/\S/;
  147.             $text = '?' x $ilen . $decimal . '?' x $dlen;
  148.             $rem = 0;
  149.             return $text;
  150.         }
  151.         my $formatted = sprintf "%$fmtnum.${dlen}lf", $num;
  152.         $text = (length $formatted > $fmtnum)
  153.             ? '#' x $ilen . $decimal . '#' x $dlen
  154.             : $formatted;
  155.         $text =~ s/(\Q$decimal\E\d+?)(0+)$/$1 . " " x length $2/e
  156.             unless $config->{numeric} =~ m/\bAllPlaces\b/i
  157.                 || $num =~ /\Q$decimal\E\d\d{$dlen,}$/;
  158.         if ($unconsumed)
  159.         {
  160.             if ($unconsumed == length $$ref)
  161.                 { $$ref =~ s/\A.[^0-9.+-]*// }
  162.             else
  163.                 { substr($$ref,0,-$unconsumed) = ""}
  164.         }
  165.         else            { $$ref = "" }
  166.         $rem = 0;
  167.         }
  168.     }
  169.     else
  170.     {
  171.         while ($$ref =~ /\S/)
  172.         {
  173.             last if !$config->{fill} && $$ref=~s/\A\n//;
  174.             last unless $$ref =~ /\A(\s*)(\S+)(.*)\z/s;
  175.             my ($ws, $word, $extra) = ($1,$2,$3);
  176.             my $nonnl = $ws =~ /[^\n]/;
  177.             $ws =~ s/\n/$nonnl? "" : " "/ge if $config->{fill};
  178.             my $lead = ($config->{squeeze} ? ($ws ? " " : "") : $ws);
  179.             my $match = $lead . $word;
  180.             last if $text && $match =~ /\n/;
  181.             my $len1 = length($match);
  182.             if ($len1 <= $rem)
  183.             {
  184.                 $text .= $match;
  185.                 $rem  -= $len1;
  186.                 $$ref = $extra;
  187.             }
  188.             else
  189.             {
  190.                 if ($len1 > $_[1] and $rem-length($lead)>$config->{minbreak})
  191.                 {
  192.                     my ($broken,$left) =
  193.                         $config->{break}->($match,$rem,$_[1]);    
  194.                     $text .= $broken;
  195.                     $$ref = $left.$extra;
  196.                     $rem -= length $broken;
  197.                 }
  198.                 last;
  199.             }
  200.         }
  201.     }
  202.  
  203.     unless (length $text)
  204.     {
  205.         $text = substr($$ref,0,$rem);
  206.         substr($$ref,0,$rem) = "";
  207.         $rem -= length $text;
  208.     }
  209.  
  210.     if ( $_[0] eq 'J' && $text =~ / / && length($$ref))     # FULLY JUSTIFIED
  211.     {
  212.         $text = reverse $text;
  213.         $text =~ s/( +)/($rem-->0?" ":"").$1/ge while $rem>0;
  214.         $text = reverse $text;
  215.     }
  216.     elsif ( $_[0] =~ /[~<[J]/ )             # LEFT JUSTIFIED
  217.     {
  218.         $text .= ' ' x $rem
  219.     }
  220.     elsif ( $_[0] =~ /\>|\]/ )            # RIGHT JUSTIFIED
  221.     {
  222.         substr($text,0,0) = ' ' x $rem;
  223.     }
  224.     elsif ( $_[0] =~ /\^|\|/ )            # CENTRE JUSTIFIED
  225.     {
  226.         my $halfrem = int($rem/2);
  227.         substr($text,0,0) = ' ' x $halfrem;
  228.         $text .= ' ' x ($rem-$halfrem);
  229.     }
  230.  
  231.     return $text;
  232. }
  233.  
  234. my %std_config =
  235. (
  236.     header     => sub{""},
  237.     footer     => sub{""},
  238.     pagefeed => sub{""},
  239.     pagelen     => 0,
  240.     pagenum     => do { \(my $pagenum = 1 )},
  241.     break     => break_with('-'),
  242.     minbreak => 2,
  243.     squeeze     => 0,
  244.     numeric     => "",
  245.     _used    => 1,
  246. );
  247.  
  248. sub lcr {
  249.     my ($data) = @_;
  250.     $data->{width}  ||= 72;
  251.     $data->{left}   ||= "";
  252.     $data->{centre} ||= $data->{center}||"";
  253.     $data->{right}  ||= "";
  254.     return sub {
  255.         my $l = ref $data->{left} eq 'CODE'
  256.                 ? $data->{left}->(@_) : $data->{left};
  257.         my $c = ref $data->{centre} eq 'CODE'
  258.                 ? $data->{centre}->(@_) : $data->{centre};
  259.         my $r = ref $data->{right} eq 'CODE'
  260.                 ? $data->{right}->(@_) : $data->{right};
  261.         my $gap = int(($data->{width}-length($c))/2-length($l));
  262.         return $l . " " x $gap
  263.              . $c . " " x ($data->{width}-length($l)-length($c)-$gap-length($r))
  264.              . $r;
  265.     }
  266. }
  267.  
  268. sub fix_config(\%)
  269. {
  270.     my ($config) = @_;
  271.     if (ref $config->{header} eq 'HASH') {
  272.         $config->{header} = lcr $config->{header};
  273.     }
  274.     unless (ref $config->{header} eq 'CODE') {
  275.         my $tmp = $config->{header}; $config->{header} = sub { $tmp }
  276.     }
  277.     if (ref $config->{footer} eq 'HASH') {
  278.         $config->{footer} = lcr $config->{footer};
  279.     }
  280.     unless (ref $config->{footer} eq 'CODE') {
  281.         my $tmp = $config->{footer}; $config->{footer} = sub { $tmp }
  282.     }
  283.     unless (ref $config->{pagefeed} eq 'CODE')
  284.         { my $tmp = $config->{pagefeed}; $config->{pagefeed} = sub { $tmp } }
  285.     unless (ref $config->{break} eq 'CODE')
  286.         { $config->{break} = break_with($config->{break}) }
  287.     unless (ref $config->{pagenum} eq 'SCALAR') 
  288.         { my $tmp = $config->{pagenum}; $config->{pagenum} = \$tmp }
  289. }
  290.  
  291. sub FormOpt::DESTROY
  292. {
  293.     carp "Configuration specified at $std_config{_line} was not used before it went out of scope"
  294.         if $^W && !$std_config{_used};
  295.     %std_config = %{$std_config{_prev}};
  296. }
  297.  
  298. sub form
  299. {
  300.     my $config = {%std_config};
  301.     my $startidx = 0;
  302.     if (@_ && ref($_[0]) eq 'HASH')        # RESETTING CONFIG
  303.     {
  304.         if (@_ > 1)            # TEMPORARY RESET
  305.         {
  306.             $config = {%$config, %{$_[$startidx++]}};
  307.             fix_config(%$config);
  308.             $startidx = 1;
  309.         }
  310.         elsif (defined wantarray)    # CONTEXT BEING CAPTURED
  311.         {
  312.             $_[0]->{_prev} = { %std_config };
  313.             $_[0]->{_used} = 0;
  314.             $_[0]->{_line} = join " line ", (caller)[1..2];;
  315.             %{$_[0]} = %std_config = (%std_config, %{$_[0]});
  316.             fix_config(%std_config);
  317.             return bless $_[0], 'FormOpt';
  318.         }
  319.         else                # PERMANENT RESET
  320.         {
  321.             $_[0]->{_used} = 1;
  322.             $_[0]->{_line} = join " line ", (caller)[1..2];;
  323.             %std_config = (%std_config, %{$_[0]});
  324.             fix_config(%std_config);
  325.             return;
  326.         }
  327.     }
  328.     $std_config{_used}++;
  329.     my @ref = map { ref } @_;
  330.     my @orig = @_;
  331.     my $caller = caller;
  332.     no strict;
  333.  
  334.     for my $nextarg (0..$#_)
  335.     {
  336.         my $next = $_[$nextarg];
  337.         if (!defined $next)
  338.         {
  339.             splice @_, $nextarg, 1, '';
  340.         }
  341.         elsif ($ref[$nextarg] eq 'ARRAY')
  342.         {
  343.             splice @_, $nextarg, 1, \join("\n", @$next)
  344.         }
  345.         elsif (!defined eval { local $SIG{__DIE__};
  346.                        $_[$nextarg] = $next;
  347.                        debug "writeable: [$_[$nextarg]]";
  348.                        1})
  349.         {
  350.                 debug "unwriteable: [$_[$nextarg]]";
  351.             my $arg = $_[$nextarg];
  352.             splice @_, $nextarg, 1, \$arg;
  353.         }
  354.         elsif (!$ref[$nextarg])
  355.         {
  356.             splice @_, $nextarg, 1, \$_[$nextarg];
  357.         }
  358.                 elsif ($ref[$nextarg] ne 'HASH' and $ref[$nextarg] ne 'SCALAR')
  359.                 {
  360.                        splice @_, $nextarg, 1, \"$next";
  361.                 }
  362.     }
  363.  
  364.     my $header = $config->{header}->(${$config->{pagenum}});
  365.     $header.="\n" if $header && substr($header,-1,1) ne "\n";
  366.  
  367.     my $footer = $config->{footer}->(${$config->{pagenum}});
  368.     $footer.="\n" if $footer && substr($footer,-1,1) ne "\n";
  369.  
  370.     my $prevfooter = $footer;
  371.  
  372.     my $linecount = $header=~tr/\n/\n/ + $footer=~tr/\n/\n/;
  373.     my $hfcount = $linecount;
  374.  
  375.     my $text = $header;
  376.  
  377.     while ($startidx < @_)
  378.     {
  379.         if ($ref[$startidx]||'' eq 'HASH')
  380.         {
  381.             $config = {%$config, %{$_[$startidx++]}};
  382.             fix_config(%$config);
  383.             next;
  384.         }
  385.         my $format = ${$_[$startidx++]}||"";
  386.         debug("format: [$format]");
  387.     
  388.         my @parts = split /(\n|(?:\\.)+|$fieldpat)/, $format;
  389.         push @parts, "\n" unless @parts && $parts[-1] eq "\n";
  390.         my $fieldcount = 0;
  391.         my $filled = 0;
  392.         my $firstline = 1;
  393.         while (!$filled)
  394.         {
  395.             my $nextarg = $startidx;
  396.             my @data;
  397.             foreach my $part ( @parts )
  398.             {
  399.                 if ($part =~ /\A(?:\\.)+/)
  400.                 {
  401.                     debug("esc literal: [$part]");
  402.                     my $tmp = $part;
  403.                     $tmp =~ s/\\(.)/$1/g;
  404.                     $text .= $tmp;
  405.                 }
  406.                 elsif ($part =~ /($lfieldmark)/)
  407.                 {
  408.                     if ($firstline)
  409.                     {
  410.                         $fieldcount++;
  411.                         if ($nextarg > $#_)
  412.                             { push @_,\$emptyref; push @ref, '' }
  413.                         my $type = $1;
  414.                         $type = 'J' if $part =~ /$ljustified/;
  415.                         croak BAD_CONFIG if ($ref[$startidx] eq 'HASH');
  416.                         debug("once field: [$part]");
  417.                         debug("data was: [${$_[$nextarg]}]");
  418.                         $text .= replace($type,length($part),$_[$nextarg],$config);
  419.                         debug("data now: [${$_[$nextarg]}]");
  420.                     }
  421.                     else
  422.                     {
  423.                         $text .= ' ' x length($part);
  424.                         debug("missing once field: [$part]");
  425.                     }
  426.                     $nextarg++;
  427.                 }
  428.                 elsif ($part =~ /($fieldmark)/ and substr($part,0,2) ne '~~')
  429.                 {
  430.                     $fieldcount++ if $firstline;
  431.                     if ($nextarg > $#_)
  432.                         { push @_,\$emptyref; push @ref, '' }
  433.                     my $type = $1;
  434.                     $type = 'J' if $part =~ /$bjustified/;
  435.                     croak BAD_CONFIG if ($ref[$startidx] eq 'HASH');
  436.                     debug("multi field: [$part]");
  437.                     debug("data was: [${$_[$nextarg]}]");
  438.                     $text .= replace($type,length($part),$_[$nextarg],$config);
  439.                     debug("data now: [${$_[$nextarg]}]");
  440.                     push @data, $_[$nextarg];
  441.                     $nextarg++;
  442.                 }
  443.                 else
  444.                 {
  445.                     debug("literal: [$part]");
  446.                     my $tmp = $part;
  447.                     $tmp =~ s/\0(\0*)/$1/g;
  448.                     $text .= $tmp;
  449.                     if ($part eq "\n")
  450.                     {
  451.                         $linecount++;
  452.                         if ($linecount>=$config->{pagelen})
  453.                         {
  454.                             ${$config->{pagenum}}++;
  455.                             my $pagefeed = $config->{pagefeed}->(${$config->{pagenum}});
  456.                             $header = $config->{header}->(${$config->{pagenum}});
  457.                             $header.="\n" if $header && substr($header,-1,1) ne "\n";
  458.                             $text .= $footer
  459.                                    . $pagefeed
  460.                                    . $header;
  461.                             $prevfooter = $footer;
  462.                             $footer = $config->{footer}->(${$config->{pagenum}});
  463.                             $footer.="\n" if $footer && substr($footer,-1,1) ne "\n";
  464.                             $linecount = $hfcount =
  465.                                 $header=~tr/\n/\n/ + $footer=~tr/\n/\n/;
  466.                             $header = $pagefeed
  467.                                 . $header;
  468.                         }
  469.                     }
  470.                 }
  471.                 debug("\tnextarg now:  $nextarg");
  472.                 debug("\tstartidx now: $startidx");
  473.             }
  474.             $firstline = 0;
  475.             $filled = ! grep { notempty $_ } @data;
  476.         }
  477.         $startidx += $fieldcount;
  478.     }
  479.  
  480.     # ADJUST FINAL PAGE HEADER OR FOOTER AS REQUIRED
  481.     if ($hfcount && $linecount == $hfcount)        # UNNEEDED HEADER
  482.     {
  483.         $text =~ s/\Q$header\E\Z//;
  484.     }
  485.     elsif ($linecount && $config->{pagelen})    # MISSING FOOTER
  486.     {
  487.         $text .= "\n" x ($config->{pagelen}-$linecount)
  488.                . $footer;
  489.         $prevfooter = $footer;
  490.     }
  491.  
  492.     # REPLACE LAST FOOTER
  493.     
  494.     if ($prevfooter) {
  495.         my $lastfooter = $config->{footer}->(${$config->{pagenum}},1);
  496.         $lastfooter.="\n"
  497.             if $lastfooter && substr($lastfooter,-1,1) ne "\n";
  498.         substr($text, -length($prevfooter)) = $lastfooter;
  499.     }
  500.  
  501.     # RESTORE ARG LIST
  502.     for my $i (0..$#orig)
  503.     {
  504.         if ($ref[$i] eq 'ARRAY')
  505.             { eval { @{$orig[$i]} = map "$_\n", split /\n/, ${$_[$i]} } }
  506.         elsif (!$ref[$i])
  507.             { eval { debug("restoring $i (".$_[$i].") to $orig[$i]");
  508.                  ${$_[$i]} = $orig[$i] } }
  509.     }
  510.  
  511.     ${$config->{pagenum}}++;
  512.     $text =~ s/[ ]+$//gm if $config->{trim};
  513.     return $text unless wantarray;
  514.     return map "$_\n", split /\n/, $text;
  515. }
  516.  
  517.  
  518. #==== tag ============================================#
  519.  
  520. sub invert($)
  521. {
  522.     my $inversion = reverse $_[0];
  523.     $inversion =~ tr/{[<(/}]>)/;
  524.     return $inversion;
  525. }
  526.  
  527. sub tag        # ($tag, $text; $opt_endtag)
  528. {
  529.     my ($tagleader,$tagindent,$ldelim,$tag,$tagargs,$tagtrailer) = 
  530.         ( $_[0] =~ /\A((?:[ \t]*\n)*)([ \t]*)(\W*)(\w+)(.*?)(\s*)\Z/ );
  531.  
  532.     $ldelim = '<' unless $ldelim;
  533.     $tagtrailer =~ s/([ \t]*)\Z//;
  534.     my $textindent = $1||"";
  535.  
  536.     my $rdelim = invert $ldelim;
  537.  
  538.     my $i;
  539.     for ($i = -1; -1-$i < length $rdelim && -1-$i < length $tagargs; $i--)
  540.     {
  541.         last unless substr($tagargs,$i,1) eq substr($rdelim,$i,1);
  542.     }
  543.     if ($i < -1)
  544.     {
  545.         $i++;
  546.         $tagargs = substr($tagargs,0,$i);
  547.         $rdelim = substr($rdelim,$i);
  548.     }
  549.  
  550.     my $endtag = $_[2] || "$ldelim/$tag$rdelim";
  551.  
  552.     return "$tagleader$tagindent$ldelim$tag$tagargs$rdelim$tagtrailer".
  553.         join("\n",map { "$tagindent$textindent$_" } split /\n/, $_[1]).
  554.         "$tagtrailer$tagindent$endtag$tagleader";
  555.  
  556. }
  557.  
  558.  
  559. ###### AUTOFORMATTING ####################################
  560.  
  561. my $default_margin = 72;
  562. my $default_widow  = 10;
  563.  
  564. $Text::Autoformat::widow_slack = 0.1;
  565.  
  566.  
  567.  
  568.  
  569. sub defn($)
  570. {
  571.     return $_[0] if defined $_[0];
  572.     return "";
  573. }
  574.  
  575. # BITS OF A TEXT LINE
  576.  
  577. my $quotechar = qq{[!#%=|:]};
  578. my $quotechunk = qq{(?:$quotechar(?![a-z])|[a-z]*>+)};
  579. my $quoter = qq{(?:(?i)(?:$quotechunk(?:[ \\t]*$quotechunk)*))};
  580.  
  581. my $separator = q/(?:[-_]{2,}|[=#*]{3,}|[+~]{4,})/;
  582.  
  583.  
  584. sub autoformat    # ($text, %args)
  585. {
  586.     my ($text,%args,$toSTDOUT);
  587.  
  588.     foreach ( @_ )
  589.     {
  590.         unless (ref || defined $text) { $text = $_ }
  591.         elsif (ref eq 'HASH') { %args = (%args, %$_) }
  592.         else { croak q{Usage: autoformat([text],[{options}])} }
  593.     }
  594.  
  595.     unless (defined $text) {
  596.         $text = join("",<STDIN>);
  597.         $toSTDOUT = !defined wantarray();
  598.     }
  599.  
  600.     $args{right}   = $default_margin unless exists $args{right};
  601.     $args{justify} = "" unless exists $args{justify};
  602.     $args{widow}   = 0 if $args{justify}||"" =~ /full/;
  603.     $args{widow}   = $default_widow unless exists $args{widow};
  604.     $args{case}    = '' unless exists $args{case};
  605.     $args{squeeze} = 1 unless exists $args{squeeze};
  606.     $args{gap}     = 0 unless exists $args{gap};
  607.     $args{impfill} = ! exists $args{fill};
  608.     $args{expfill} = $args{fill};
  609.     $args{_centred} = 1 if $args{justify} =~ /cent(er(ed)?|red?)/;
  610.  
  611.     # DETABIFY
  612.     my @rawlines = split /\n/, $text;
  613.     use Text::Tabs;
  614.     @rawlines = expand(@rawlines);
  615.  
  616.     # PARSE EACH LINE
  617.  
  618.     my $pre = 0;
  619.     my @lines;
  620.     foreach (@rawlines)
  621.     {
  622.             push @lines, { raw       => $_ };
  623.             s/\A([ \t]*)($quoter?)([ \t]*)//
  624.                 or die "Internal Error ($@) on '$_'";
  625.             $lines[-1]{presig} =  $lines[-1]{prespace}   = defn $1;
  626.             $lines[-1]{presig} .= $lines[-1]{quoter}     = defn $2;
  627.             $lines[-1]{presig} .= $lines[-1]{quotespace} = defn $3;
  628.  
  629.             $lines[-1]{hang}       = defn Hang->new($_);
  630.  
  631.             s/([ \t]*)(.*?)(\s*)$//
  632.                 or die "Internal Error ($@) on '$_'";
  633.             $lines[-1]{hangspace} = defn $1;
  634.             $lines[-1]{text} = defn $2;
  635.             $lines[-1]{empty} = $lines[-1]{hang}->empty() && $2 !~ /\S/;
  636.             $lines[-1]{separator} = $lines[-1]{text} =~ /^$separator$/;
  637.     }
  638.  
  639.     # SUBDIVIDE DOCUMENT INTO COHERENT SUBSECTIONS
  640.  
  641.     my @chunks;
  642.     push @chunks, [shift @lines];
  643.     foreach my $line (@lines)
  644.     {
  645.         if ($line->{separator} ||
  646.             $line->{quoter} ne $chunks[-1][-1]->{quoter} ||
  647.             $line->{empty} ||
  648.             @chunks && $chunks[-1][-1]->{empty})
  649.         {
  650.             push @chunks, [$line];
  651.         }
  652.         else
  653.         {
  654.             push @{$chunks[-1]}, $line;
  655.         }
  656.     }
  657.  
  658.  
  659.  
  660.  # DETECT CENTRED PARAS
  661.  
  662.     CHUNK: foreach my $chunk ( @chunks )
  663.     {
  664.         next CHUNK if @$chunk < 2;
  665.         my @length;
  666.         my $ave = 0;
  667.         foreach my $line (@$chunk)
  668.         {
  669.             my $prespace = $line->{quoter}  ? $line->{quotespace}
  670.                             : $line->{prespace};
  671.             my $pagewidth = 
  672.                 2*length($prespace) + length($line->{text});
  673.             push @length, [length $prespace,$pagewidth];
  674.             $ave += $pagewidth;
  675.         }
  676.         $ave /= @length;
  677.         my $diffpre = 0;
  678.         foreach my $l (0..$#length)
  679.         {
  680.             next CHUNK unless abs($length[$l][1]-$ave) <= 2;
  681.             $diffpre ||= $length[$l-1][0] != $length[$l][0]
  682.                 if $l > 0;
  683.         }
  684.         next CHUNK unless $diffpre;
  685.         foreach my $line (@$chunk)
  686.         {
  687.             $line->{centred} = 1;
  688.             ($line->{quoter} ? $line->{quotespace}
  689.                      : $line->{prespace}) = "";
  690.         }
  691.     }
  692.  
  693.     # REDIVIDE INTO PARAGRAPHS
  694.  
  695.     my @paras;
  696.     foreach my $chunk ( @chunks )
  697.     {
  698.         my $first = 1;
  699.         my $firstfrom;
  700.         foreach my $line ( @{$chunk} )
  701.         {
  702.             if ($first ||
  703.                 $line->{quoter} ne $paras[-1]->{quoter} ||
  704.                 $paras[-1]->{separator} ||
  705.                 !$line->{hang}->empty
  706.                )
  707.             {
  708.                 push @paras, $line;
  709.                 $first = 0;
  710.                 $firstfrom = length($line->{raw}) - length($line->{text});
  711.             }
  712.             else
  713.             {
  714.     my $extraspace = length($line->{raw}) - length($line->{text}) - $firstfrom;
  715.                 $paras[-1]->{text} .= "\n" . q{ }x$extraspace . $line->{text};
  716.                 $paras[-1]->{raw} .= "\n" . $line->{raw};
  717.             }
  718.         }
  719.     }
  720.  
  721.     # HANDLE FIRST PARA UNLESS $args{all}
  722.  
  723.     my $remainder = "";
  724.     unless ($args{all})
  725.     {
  726.         $remainder = join "\n", map { $_->{raw} } @paras[1..$#paras];
  727.         @paras = ( $paras[0] );
  728.     }
  729.  
  730.     # RE-CASE TEXT
  731.     if ($args{case}) {
  732.         foreach my $para ( @paras ) {
  733.             if ($args{case} =~ /upper/i) {
  734.                 $para->{text} =~ tr/a-z/A-Z/;
  735.             }
  736.             if ($args{case} =~ /lower/i) {
  737.                 $para->{text} =~ tr/A-Z/a-z/;
  738.             }
  739.             if ($args{case} =~ /title/i) {
  740.                 $para->{text} =~ s/(\S+)/entitle($1)/ge;
  741.             }
  742.             if ($args{case} =~ /highlight/i) {
  743.                 $para->{text} =~ s/(\S+)/entitle($1,1)/ge;
  744.                 $para->{text} =~ s/([a-z])/\U$1/i;
  745.             }
  746.             if ($args{case} =~ /sentence(\s*)/i) {
  747.                 my $trailer = $1;
  748.                 $args{squeeze}=0 if $trailer && $trailer ne " ";
  749.                 ensentence();
  750.                 $para->{text} =~ s/(\S+(\s+|$))/ensentence($1, $trailer)/ge;
  751.             }
  752.         }
  753.     }
  754.  
  755.     # ALIGN QUOTERS
  756.     # DETERMINE HANGING MARKER TYPE (BULLET, ALPHA, ROMAN, ETC.)
  757.  
  758.     my %sigs;
  759.     my $lastquoted = 0;
  760.     my $lastprespace = 0;
  761.     for my $i ( 0..$#paras )
  762.     {
  763.         my $para = $paras[$i];
  764.  
  765.      if ($para->{quoter})
  766.         {
  767.             if ($lastquoted) { $para->{prespace} = $lastprespace }
  768.             else         { $lastquoted = 1; $lastprespace = $para->{prespace} }
  769.         }
  770.         else
  771.         {
  772.             $lastquoted = 0;
  773.         }
  774.     }
  775.  
  776. # RENUMBER PARAGRAPHS
  777.  
  778.     for my $para ( @paras )
  779.     {
  780.         my $sig = $para->{presig} . $para->{hang}->signature();
  781.         push @{$sigs{$sig}{hangref}}, $para;
  782.         $sigs{$sig}{hangfields} = $para->{hang}->fields()-1
  783.             unless defined $sigs{$sig}{hangfields};
  784.     }
  785.  
  786.     while (my ($sig,$val) = each %sigs)
  787.     {
  788.         next unless $sig =~ /rom/;
  789.         field: for my $field ( 0..$val->{hangfields} )
  790.         {
  791.             my $romlen = 0;
  792.             foreach my $para ( @{$val->{hangref}} )
  793.             {
  794.                 my $hang = $para->{hang};
  795.                 my $fieldtype = $hang->field($field);
  796.                 next field 
  797.                     unless $fieldtype && $fieldtype =~ /rom|let/;
  798.                 if ($fieldtype eq 'let') {
  799.                     foreach my $para ( @{$val->{hangref}} ) {
  800.                         $hang->field($field=>'let')
  801.                     }
  802.                 }
  803.                 else {
  804.                     $romlen += length $hang->val($field);
  805.                 }
  806.             }
  807.             # NO ROMAN LETTER > 1 CHAR -> ALPHABETICS
  808.             if ($romlen <= @{$val->{hangref}}) {
  809.                 foreach my $para ( @{$val->{hangref}} ) {
  810.                     $para->{hang}->field($field=>'let')
  811.                 }
  812.             }
  813.         }
  814.     }
  815.  
  816.     my %prev;
  817.     for my $para ( @paras )
  818.     {
  819.         my $sig = $para->{presig} . $para->{hang}->signature();
  820.         unless ($para->{quoter}) {
  821.             $para->{hang}->incr($prev{""}, $prev{$sig});
  822.             $prev{""} = $prev{$sig} = $para->{hang}
  823.                 unless $para->{hang}->empty;
  824.         }
  825.             
  826.         # COLLECT MAXIMAL HANG LENGTHS BY SIGNATURE
  827.  
  828.         my $siglen = $para->{hang}->length();
  829.         $sigs{$sig}{hanglen} = $siglen
  830.             if ! $sigs{$sig}{hanglen} ||
  831.                $sigs{$sig}{hanglen} < $siglen;
  832.     }
  833.  
  834.     # PROPAGATE MAXIMAL HANG LENGTH
  835.  
  836.     while (my ($sig,$val) = each %sigs)
  837.     {
  838.         foreach (@{$val->{hangref}}) {
  839.             $_->{hanglen} = $val->{hanglen};
  840.         }
  841.     }
  842.  
  843.     # BUILD FORMAT FOR EACH PARA THEN FILL IT 
  844.  
  845.     $text = "";
  846.     my $gap = $paras[0]->{empty} ? 0 : $args{gap};
  847.     for my $para ( @paras )
  848.     {
  849.         if ($para->{empty}) {
  850.         $gap += 1 + ($para->{text} =~ tr/\n/\n/);
  851.         }
  852.         my $leftmargin = $args{left} ? " "x($args{left}-1)
  853.                      : $para->{prespace};
  854.         my $hlen = $para->{hanglen} || $para->{hang}->length;
  855.         my $hfield = ($hlen==1 ? '~' : '>'x$hlen);
  856.         my @hang;
  857.         push @hang, $para->{hang}->stringify if $hlen;
  858.         my $format = $leftmargin
  859.                . quotemeta($para->{quoter})
  860.                . $para->{quotespace}
  861.                . $hfield
  862.                . $para->{hangspace};
  863.         my $rightslack = int (($args{right}-length $leftmargin)*$Text::Autoformat::widow_slack);
  864.         my ($widow_okay, $rightindent, $firsttext, $newtext) = (0,0);
  865.         do {
  866.             my $tlen = $args{right}-$rightindent-length($leftmargin
  867.                          . $para->{quoter}
  868.                          . $para->{quotespace}
  869.                          . $hfield
  870.                          . $para->{hangspace});
  871.             next if blockquote($text,$para, $format, $tlen, \@hang, \%args);
  872.             my $tfield = ( $tlen==1                          ? '~'
  873.                  : $para->{centred}||$args{_centred} ? '|'x$tlen
  874.                  : $args{justify} eq 'right'         ? ']'x$tlen
  875.                  : $args{justify} eq 'full'          ? '['x($tlen-2) . ']]'
  876.                  : $para->{centred}||$args{_centred} ? '|'x$tlen
  877.                  :                                     '['x$tlen
  878.                      );
  879.         my $tryformat = "$format$tfield";
  880.         $newtext = (!$para->{empty} ? "\n"x($args{gap}-$gap) : "") 
  881.                  . form( { squeeze=>$args{squeeze}, trim=>1,
  882.                    fill => !(!($args{expfill}
  883.                     || $args{impfill} &&
  884.                        !$para->{centred}))
  885.                    },
  886.                 $tryformat, @hang,
  887.                 $para->{text});
  888.         $firsttext ||= $newtext;
  889.         $newtext =~ /\s*([^\n]*)$/;
  890.         $widow_okay = $para->{empty} || length($1) >= $args{widow};
  891.         # print "[$rightindent <= $rightslack : $widow_okay : $1]\n";
  892.         # print $tryformat;
  893.         # print $newtext;
  894.         } until $widow_okay || ++$rightindent > $rightslack;
  895.  
  896.         $text .= $widow_okay ? $newtext : $firsttext;
  897.         $gap = 0 unless $para->{empty};
  898.     }
  899.  
  900.  
  901.     # RETURN FORMATTED TEXT
  902.  
  903.     if ($toSTDOUT) { print STDOUT $text . $remainder; return }
  904.     return $text . $remainder;
  905. }
  906.  
  907. sub entitle {
  908.     my ($str,$ignore) = @_;
  909.     my $mixedcase = $str =~ /[a-z].*[A-Z]|[A-Z].*[a-z]/;
  910.     my $ignorable = $ignore && $str =~ /^[^a-z]*($IGNORABLES)[^a-z]*$/i;
  911.     $str = lc $str if $ignorable || ! $mixedcase ;
  912.     $str =~ s/([a-z])/\U$1/i unless $ignorable;
  913.     return $str;
  914. }
  915.  
  916. my $abbrev = join '|', qw{
  917.     etc[.]    pp[.]    ph[.]?d[.]    U[.]S[.]
  918. };
  919.  
  920. my $gen_abbrev = join '|', $abbrev, qw{
  921.      (^[^a-z]*([a-z][.])+)
  922. };
  923.  
  924. my $term = q{(?:[.]|[!?]+)};
  925.  
  926. my $eos = 1;
  927. my $brsent = 0;
  928.  
  929. sub ensentence {
  930.     do { $eos = 1; return } unless @_;
  931.     my ($str, $trailer) = @_;
  932.     if ($str =~ /^([^a-z]*)I[^a-z]*?($term?)[^a-z]*$/i) {
  933.         $eos = $2;
  934.         $brsent = $1 =~ /^[[(]/;
  935.         return uc $str
  936.     }
  937.     unless ($str =~ /[a-z].*[A-Z]|[A-Z].*[a-z]/) {
  938.         $str = lc $str;
  939.     }
  940.     if ($eos) {
  941.         $str =~ s/([a-z])/uc $1/ie;
  942.         $brsent = $str =~ /^[[(]/;
  943.     }
  944.     $eos = $str !~ /($gen_abbrev)[^a-z]*\s/i
  945.         && $str =~ /[a-z][^a-z]*$term([^a-z]*)\s/
  946.         && !($1=~/[])]/ && !$brsent);
  947.     $str =~ s/\s+$/$trailer/ if $eos && $trailer;
  948.     return $str;
  949. }
  950.  
  951. # blockquote($text,$para, $format, $tlen, \@hang, \%args);
  952. sub blockquote {
  953.     my ($dummy, $para, $format, $tlen, $hang, $args) = @_;
  954. =begin other
  955.     print STDERR "[", join("|", $para->{raw} =~
  956. / \A(\s*)        # $1 - leading whitespace (quotation)
  957.        (["']|``)        # $2 - opening quotemark
  958.        (.*)            # $3 - quotation
  959.        (''|\2)        # $4 closing quotemark
  960.        \s*?\n        # trailing whitespace
  961.        (\1[ ]+)        # $5 - leading whitespace (attribution)
  962.        (--|-)        # $6 - attribution introducer
  963.        ([^\n]*?$)        # $7 - attribution line 1
  964.        ((\5[^\n]*?$)*)        # $8 - attributions lines 2-N
  965.        \s*\Z
  966.      /xsm
  967. ), "]\n";
  968. =cut
  969.     $para->{text} =~
  970.         / \A(\s*)        # $1 - leading whitespace (quotation)
  971.        (["']|``)        # $2 - opening quotemark
  972.        (.*)            # $3 - quotation
  973.        (''|\2)        # $4 closing quotemark
  974.        \s*?\n        # trailing whitespace
  975.        (\1[ ]+)        # $5 - leading whitespace (attribution)
  976.        (--|-)        # $6 - attribution introducer
  977.        (.*?$)        # $7 - attribution line 1
  978.        ((\5.*?$)*)        # $8 - attributions lines 2-N
  979.        \s*\Z
  980.      /xsm
  981.      or return;
  982.  
  983.     #print "[$1][$2][$3][$4][$5][$6][$7]\n";
  984.     my $indent = length $1;
  985.     my $text = $2.$3.$4;
  986.     my $qindent = length $2;
  987.     my $aindent = length $5;
  988.     my $attribintro = $6;
  989.     my $attrib = $7.$8;
  990.     $text =~ s/\n/ /g;
  991.  
  992.     $_[0] .= 
  993.  
  994.                 form {squeeze=>$args->{squeeze}, trim=>1,
  995.           fill => $args->{expfill}
  996.                    },
  997.        $format . q{ }x$indent . q{<}x$tlen,
  998.              @$hang, $text,
  999.        $format . q{ }x($qindent) . q{[}x($tlen-$qindent), 
  1000.              @$hang, $text,
  1001.        {squeeze=>0},
  1002.        $format . q{ } x $aindent . q{>> } . q{[}x($tlen-$aindent-3),
  1003.              @$hang, $attribintro, $attrib;
  1004.     return 1;
  1005. }
  1006.  
  1007. # Emulation to avoid including POSIX:
  1008. sub strtod {
  1009.     my $str = $_[0]; # preserve the original.
  1010.     my ($num, $sign);
  1011.  
  1012.     # From the strtod manpage:
  1013.     # The expected form of the (initial portion of the) string
  1014.     # is optional leading white space as recognized by isspace(3),
  1015.     $str =~ s/^\s*//;
  1016.  
  1017.     # an optional plus (``+'') or minus sign (``-'')
  1018.     $sign = $str =~ s/^([-+])//;
  1019.     $sign ||= '+';
  1020.  
  1021.     # NOTE: do hex first...
  1022.     # or (ii) a hexadecimal number,
  1023.     if ($str =~ s/^0x([0-9a-f]+(?:\.[0-9a-f]*)?)(?:p([-+]?)([0-9a-f]+))?//i) {
  1024.     my $exp = hex($3) || 0;
  1025.     $exp *= -1 if ($2 and $2 eq '-');
  1026.     $num = hex($1) * (2 ** $exp);
  1027.     }
  1028.  
  1029.     # NOTE: and then decimal second...
  1030.     # and then either (i) a decimal number, [decimal assumed to be '.']
  1031.     elsif ($str =~ s/^([0-9]+(?:\.[0-9]*)?)(?:[Ee]([-+]?)([0-9]+))?//) {
  1032.     my $exp = $3 || 0;
  1033.     $exp *= -1 if ($2 and $2 eq '-');
  1034.     $num = $1 * (10 ** $exp);
  1035.     }
  1036.  
  1037.     # or (iii) an infinity,
  1038.     elsif ($str =~ s/^(?:infinity|inf)//i) {
  1039.     $num = 'inf';
  1040.     }
  1041.  
  1042.     # or (iv) a NAN (not-a-number).
  1043.     elsif ($str =~ s/^NAN(?:\([^)]*\))?//i) {
  1044.     $num = 'nan';
  1045.     }
  1046.  
  1047.     $num = 0 unless defined $num;
  1048.     $num *= -1 if ($sign eq '-');
  1049.  
  1050.     return wantarray ? ($num, length($str)) : $num;
  1051. }
  1052.  
  1053. package Hang;
  1054.  
  1055. # ROMAN NUMERALS
  1056.  
  1057. sub inv($@) { my ($k, %inv)=shift; for(0..$#_) {$inv{$_[$_]}=$_*$k} %inv } 
  1058. my @unit= ( "" , qw ( I II III IV V VI VII VIII IX ));
  1059. my @ten = ( "" , qw ( X XX XXX XL L LX LXX LXXX XC ));
  1060. my @hund= ( "" , qw ( C CC CCC CD D DC DCC DCCC CM ));
  1061. my @thou= ( "" , qw ( M MM MMM ));
  1062. my %rval= (inv(1,@unit),inv(10,@ten),inv(100,@hund),inv(1000,@thou));
  1063. my $rbpat= join ")(",join("|",reverse @thou), join("|",reverse @hund), join("|",reverse @ten), join("|",reverse @unit);
  1064. my $rpat= join ")(?:",join("|",reverse @thou), join("|",reverse @hund), join("|",reverse @ten), join("|",reverse @unit);
  1065.  
  1066. sub fromRoman($)
  1067. {
  1068.     return 0 unless $_[0] =~ /^.*?($rbpat).*$/i;
  1069.     return $rval{uc $1} + $rval{uc $2} + $rval{uc $3} + $rval{uc $4};
  1070. }
  1071.  
  1072. sub toRoman($$)
  1073. {
  1074.     my ($num,$example) = @_;
  1075.     return '' unless $num =~ /^([0-3]??)(\d??)(\d??)(\d)$/;
  1076.     my $roman = $thou[$1||0] . $hund[$2||0] . $ten[$3||0] . $unit[$4||0];
  1077.     return $example=~/[A-Z]/ ? uc $roman : lc $roman;
  1078. }
  1079.  
  1080. # BITS OF A NUMERIC VALUE
  1081.  
  1082. my $num = q/(?:\d+)/;
  1083. my $rom = qq/(?:(?=[MDCLXVI])(?:$rpat))/;
  1084. my $let = q/[A-Za-z]/;
  1085. my $pbr = q/[[(<]/;
  1086. my $sbr = q/])>/;
  1087. my $ows = q/[ \t]*/;
  1088. my %close = ( '[' => ']', '(' => ')', '<' => '>', "" => '' );
  1089.  
  1090. my $hangPS      = qq{(?i:ps:|(?:p\\.?)+s\\.?(?:[ \\t]*:)?)};
  1091. my $hangNB      = qq{(?i:n\\.?b\\.?(?:[ \\t]*:)?)};
  1092. my $hangword    = qq{(?:(?:Note)[ \\t]*:)};
  1093. my $hangbullet  = qq{[*.+-]};
  1094. my $hang        = qq{(?:(?i)(?:$hangNB|$hangword|$hangbullet)(?=[ \t]))};
  1095.  
  1096. # IMPLEMENTATION
  1097.  
  1098. sub new { 
  1099.     my ($class, $orig) = @_;
  1100.     my $origlen = length $orig;
  1101.     my @vals;
  1102.     if ($_[1] =~ s#\A($hangPS)##) {
  1103.         @vals = { type => 'ps', val => $1 }
  1104.     }
  1105.     elsif ($_[1] =~ s#\A($hang)##) {
  1106.         @vals = { type => 'bul', val => $1 }
  1107.     }
  1108.     else {
  1109.         local $^W;
  1110.         my $cut;
  1111.         while (length $_[1]) {
  1112.             last if $_[1] =~ m#\A($ows)($abbrev)#
  1113.                  && (length $1 || !@vals);    # ws-separated or first
  1114.  
  1115.             $cut = $origlen - length $_[1];
  1116.             my $pre = $_[1] =~ s#\A($ows$pbr$ows)## ? $1 : "";
  1117.             my $val =  $_[1] =~ s#\A($num)##  && { type=>'num', val=>$1 }
  1118.                    || $_[1] =~ s#\A($rom)##i && { type=>'rom', val=>$1, nval=>fromRoman($1) }
  1119.                    || $_[1] =~ s#\A($let(?!$let))##i && { type=>'let', val=>$1 }
  1120.                    || { val => "", type => "" };
  1121.             $_[1] = $pre.$_[1] and last unless $val->{val};
  1122.             $val->{post} = $pre && $_[1] =~ s#\A($ows()[.:/]?[$close{$pre}][.:/]?)## && $1
  1123.                              || $_[1] =~ s#\A($ows()[$sbr.:/])## && $1
  1124.                              || "";
  1125.             $val->{pre}  = $pre;
  1126.             $val->{cut}  = $cut;
  1127.             push @vals, $val;
  1128.         }
  1129.         while (@vals && !$vals[-1]{post}) {
  1130.             $_[1] = substr($orig,pop(@vals)->{cut});
  1131.         }
  1132.     }
  1133.     # check for orphaned years...
  1134.     if (@vals==1 && $vals[0]->{type} eq 'num'
  1135.              && $vals[0]->{val} >= 1000
  1136.              && $vals[0]->{post} eq '.')  {
  1137.         $_[1] = substr($orig,pop(@vals)->{cut});
  1138.  
  1139.         }
  1140.     return NullHang->new if !@vals;
  1141.     bless \@vals, $class;
  1142. } 
  1143.  
  1144. sub incr {
  1145.     local $^W;
  1146.     my ($self, $prev, $prevsig) = @_;
  1147.     my $level;
  1148.     # check compatibility
  1149.  
  1150.     return unless $prev && !$prev->empty;
  1151.  
  1152.     for $level (0..(@$self<@$prev ? $#$self : $#$prev)) {
  1153.         if ($self->[$level]{type} ne $prev->[$level]{type}) {
  1154.             return if @$self<=@$prev;    # no incr if going up
  1155.             $prev = $prevsig;
  1156.             last;
  1157.         }
  1158.     }
  1159.     return unless $prev && !$prev->empty;
  1160.     if ($self->[0]{type} eq 'ps') {
  1161.         my $count = 1 + $prev->[0]{val} =~ s/(p[.]?)/$1/gi;
  1162.         $prev->[0]{val} =~ /^(p[.]?).*(s[.]?[:]?)/;
  1163.         $self->[0]{val} = $1  x $count . $2;
  1164.     }
  1165.     elsif ($self->[0]{type} eq 'bul') {
  1166.         # do nothing
  1167.     }
  1168.     elsif (@$self>@$prev) {    # going down level(s)
  1169.         for $level (0..$#$prev) {
  1170.                 @{$self->[$level]}{'val','nval'} = @{$prev->[$level]}{'val','nval'};
  1171.         }
  1172.         for $level (@$prev..$#$self) {
  1173.                 _reset($self->[$level]);
  1174.         }
  1175.     }
  1176.     else    # same level or going up
  1177.     {
  1178.         for $level (0..$#$self) {
  1179.             @{$self->[$level]}{'val','nval'} = @{$prev->[$level]}{'val','nval'};
  1180.         }
  1181.         _incr($self->[-1])
  1182.     }
  1183. }
  1184.  
  1185. sub _incr {
  1186.     local $^W;
  1187.     if ($_[0]{type} eq 'rom') {
  1188.         $_[0]{val} = toRoman(++$_[0]{nval},$_[0]{val});
  1189.     }
  1190.     else {
  1191.         $_[0]{val}++ unless $_[0]{type} eq 'let' && $_[0]{val}=~/Z/i;
  1192.     }
  1193. }
  1194.  
  1195. sub _reset {
  1196.     local $^W;
  1197.     if ($_[0]{type} eq 'rom') {
  1198.         $_[0]{val} = toRoman($_[0]{nval}=1,$_[0]{val});
  1199.     }
  1200.     elsif ($_[0]{type} eq 'let') {
  1201.         $_[0]{val} = $_[0]{val} =~ /[A-Z]/ ? 'A' : 'a';
  1202.     }
  1203.     else {
  1204.         $_[0]{val} = 1;
  1205.     }
  1206. }
  1207.  
  1208. sub stringify {
  1209.     my ($self) = @_;
  1210.     my ($str, $level) = ("");
  1211.     for $level (@$self) {
  1212.         local $^W;
  1213.         $str .= join "", @{$level}{'pre','val','post'};
  1214.     }
  1215.     return $str;
  1216. } 
  1217.  
  1218. sub val {
  1219.     my ($self, $i) = @_;
  1220.     return $self->[$i]{val};
  1221. }
  1222.  
  1223. sub fields { return scalar @{$_[0]} }
  1224.  
  1225. sub field {
  1226.     my ($self, $i, $newval) = @_;
  1227.     $self->[$i]{type} = $newval if @_>2;
  1228.     return $self->[$i]{type};
  1229. }
  1230.  
  1231. sub signature {
  1232.     local $^W;
  1233.     my ($self) = @_;
  1234.     my ($str, $level) = ("");
  1235.     for $level (@$self) {
  1236.         $level->{type} ||= "";
  1237.         $str .= join "", $level->{pre},
  1238.                          ($level->{type} =~ /rom|let/ ? "romlet" : $level->{type}),
  1239.                          $level->{post};
  1240.     }
  1241.     return $str;
  1242. } 
  1243.  
  1244. sub length {
  1245.     length $_[0]->stringify
  1246. }
  1247.  
  1248. sub empty { 0 }
  1249.  
  1250. package NullHang;
  1251.  
  1252. sub new       { bless {}, $_[0] }
  1253. sub stringify { "" }
  1254. sub length    { 0 }
  1255. sub incr      {}
  1256. sub empty     { 1 }
  1257. sub signature     { "" }
  1258. sub fields { return 0 }
  1259. sub field { return "" }
  1260. sub val { return "" }
  1261. 1;
  1262.  
  1263. __END__
  1264.  
  1265. =head1 NAME
  1266.  
  1267. Text::Autoformat - Automatic and manual text wrapping and reformating formatting
  1268.  
  1269. =head1 VERSION
  1270.  
  1271. This document describes version 1.04 of Text::Autoformat,
  1272. released December  5, 2000.
  1273.  
  1274. =head1 SYNOPSIS
  1275.  
  1276.  # Minimal use: read from STDIN, format to STDOUT...
  1277.  
  1278.     use Text::Autoformat;
  1279.     autoformat;
  1280.  
  1281.  # In-memory formatting...
  1282.  
  1283.     $formatted = autoformat $rawtext;
  1284.  
  1285.  # Configuration...
  1286.  
  1287.     $formatted = autoformat $rawtext, { %options };
  1288.  
  1289.  # Margins (1..72 by default)...
  1290.  
  1291.     $formatted = autoformat $rawtext, { left=>8, right=>70 };
  1292.  
  1293.  # Justification (left by default)...
  1294.  
  1295.     $formatted = autoformat $rawtext, { justify => 'left' };
  1296.     $formatted = autoformat $rawtext, { justify => 'right' };
  1297.     $formatted = autoformat $rawtext, { justify => 'full' };
  1298.     $formatted = autoformat $rawtext, { justify => 'centre' };
  1299.  
  1300.  # Filling (does so by default)...
  1301.  
  1302.     $formatted = autoformat $rawtext, { fill=>0 };
  1303.  
  1304.  # Squeezing whitespace (does so by default)...
  1305.  
  1306.     $formatted = autoformat $rawtext, { squeeze=>0 };
  1307.  
  1308.  # Case conversions...
  1309.  
  1310.     $formatted = autoformat $rawtext, { case => 'lower' };
  1311.     $formatted = autoformat $rawtext, { case => 'upper' };
  1312.     $formatted = autoformat $rawtext, { case => 'sentence' };
  1313.     $formatted = autoformat $rawtext, { case => 'title' };
  1314.     $formatted = autoformat $rawtext, { case => 'highlight' };
  1315.  
  1316.  
  1317. =head1 BACKGROUND
  1318.  
  1319. =head2 The problem
  1320.  
  1321. Perl plaintext formatters just aren't smart enough. Given a typical
  1322. piece of plaintext in need of formatting:
  1323.  
  1324.         In comp.lang.perl.misc you wrote:
  1325.         : > <CN = Clooless Noobie> writes:
  1326.         : > CN> PERL sux because:
  1327.         : > CN>    * It doesn't have a switch statement and you have to put $
  1328.         : > CN>signs in front of everything
  1329.         : > CN>    * There are too many OR operators: having |, || and 'or'
  1330.         : > CN>operators is confusing
  1331.         : > CN>    * VB rools, yeah!!!!!!!!!
  1332.         : > CN> So anyway, how can I stop reloads on a web page?
  1333.         : > CN> Email replies only, thanks - I don't read this newsgroup.
  1334.         : >
  1335.         : > Begone, sirrah! You are a pathetic, Bill-loving, microcephalic
  1336.         : > script-infant.
  1337.         : Sheesh, what's with this group - ask a question, get toasted! And how
  1338.         : *dare* you accuse me of Ianuphilia!
  1339.  
  1340. both the venerable Unix L<fmt> tool and Perl's standard Text::Wrap module
  1341. produce:
  1342.  
  1343.         In comp.lang.perl.misc you wrote:  : > <CN = Clooless Noobie>
  1344.         writes:  : > CN> PERL sux because:  : > CN>    * It doesn't
  1345.         have a switch statement and you have to put $ : > CN>signs in
  1346.         front of everything : > CN>    * There are too many OR
  1347.         operators: having |, || and 'or' : > CN>operators is confusing
  1348.         : > CN>    * VB rools, yeah!!!!!!!!!  : > CN> So anyway, how
  1349.         can I stop reloads on a web page?  : > CN> Email replies only,
  1350.         thanks - I don't read this newsgroup.  : > : > Begone, sirrah!
  1351.         You are a pathetic, Bill-loving, microcephalic : >
  1352.         script-infant.  : Sheesh, what's with this group - ask a
  1353.         question, get toasted! And how : *dare* you accuse me of
  1354.         Ianuphilia!
  1355.  
  1356. Other formatting modules -- such as Text::Correct and Text::Format --
  1357. provide more control over their output, but produce equally poor results
  1358. when applied to arbitrary input. They simply don't understand the
  1359. structural conventions of the text they're reformatting.
  1360.  
  1361. =head2 The solution
  1362.  
  1363. The Text::Autoformat module provides a subroutine named C<autoformat> that
  1364. wraps text to specified margins. However, C<autoformat> reformats its
  1365. input by analysing the text's structure, so it wraps the above example
  1366. like so:
  1367.  
  1368.         In comp.lang.perl.misc you wrote:
  1369.         : > <CN = Clooless Noobie> writes:
  1370.         : > CN> PERL sux because:
  1371.         : > CN>    * It doesn't have a switch statement and you
  1372.         : > CN>      have to put $ signs in front of everything
  1373.         : > CN>    * There are too many OR operators: having |, ||
  1374.         : > CN>      and 'or' operators is confusing
  1375.         : > CN>    * VB rools, yeah!!!!!!!!! So anyway, how can I
  1376.         : > CN>      stop reloads on a web page? Email replies
  1377.         : > CN>      only, thanks - I don't read this newsgroup.
  1378.         : >
  1379.         : > Begone, sirrah! You are a pathetic, Bill-loving,
  1380.         : > microcephalic script-infant.
  1381.         : Sheesh, what's with this group - ask a question, get toasted!
  1382.         : And how *dare* you accuse me of Ianuphilia!
  1383.  
  1384. Note that the various quoting conventions have been observed. In fact,
  1385. their structure has been used to determine where some paragraphs begin.
  1386. Furthermore C<autoformat> correctly distinguished between the leading
  1387. '*' bullets of the nested list (which were outdented) and the leading
  1388. emphatic '*' of "*dare*" (which was inlined).
  1389.  
  1390. =head1 DESCRIPTION
  1391.  
  1392. =head2 Paragraphs
  1393.  
  1394. The fundamental task of the C<autoformat> subroutine is to identify and
  1395. rearrange independent paragraphs in a text. Paragraphs typically consist
  1396. of a series of lines containing at least one non-whitespace character,
  1397. followed by one or more lines containing only optional whitespace.
  1398. This is a more liberal definition than many other formatters
  1399. use: most require an empty line to terminate a paragraph. Paragraphs may
  1400. also be denoted by bulleting, numbering, or quoting (see the following
  1401. sections).
  1402.  
  1403. Once a paragraph has been isolated, C<autoformat> fills and re-wraps its
  1404. lines according to the margins that are specified in its argument list.
  1405. These are placed after the text to be formatted, in a hash reference:
  1406.  
  1407.         $tidied = autoformat($messy, {left=>20, right=>60});
  1408.  
  1409. By default, C<autoformat> uses a left margin of 1 (first column) and a
  1410. right margin of 72.
  1411.  
  1412. Normally, C<autoformat> only reformats the first paragraph it encounters,
  1413. and leaves the remainder of the text unaltered. This behaviour is useful
  1414. because it allows a one-liner invoking the subroutine to be mapped
  1415. onto a convenient keystroke in a text editor, to provide 
  1416. one-paragraph-at-a-time reformatting:
  1417.  
  1418.         % cat .exrc
  1419.  
  1420.         map f !Gperl -MText::Autoformat -e'autoformat'
  1421.  
  1422. (Note that to facilitate such one-liners, if C<autoformat> is called
  1423. in a void context without any text data, it takes its text from
  1424. C<STDIN> and writes its result to C<STDOUT>).
  1425.  
  1426. To enable C<autoformat> to rearrange the entire input text at once, the
  1427. C<all> argument is used:
  1428.  
  1429.         $tidied_all = autoformat($messy, {left=>20, right=>60, all=>1});
  1430.  
  1431.  
  1432. =head2 Bulleting and (re-)numbering
  1433.  
  1434. Often plaintext will include lists that are either:
  1435.  
  1436.         * bulleted,
  1437.         * simply numbered (i.e. 1., 2., 3., etc.), or
  1438.         * hierarchically numbered (1, 1.1, 1.2, 1.3, 2, 2.1. and so forth).
  1439.  
  1440. In such lists, each bulleted item is implicitly a separate paragraph,
  1441. and is formatted individually, with the appropriate indentation:
  1442.  
  1443.         * bulleted,
  1444.         * simply numbered (i.e. 1., 2., 3.,
  1445.           etc.), or
  1446.         * hierarchically numbered (1, 1.1,
  1447.           1.2, 1.3, 2, 2.1. and so forth).
  1448.  
  1449. More importantly, if the points are numbered, the numbering is
  1450. checked and reordered. For example, a list whose points have been
  1451. rearranged:
  1452.  
  1453.         2. Analyze problem
  1454.         3. Design algorithm
  1455.         1. Code solution
  1456.         5. Test
  1457.         4. Ship
  1458.  
  1459. would be renumbered automatically by C<autoformat>:
  1460.  
  1461.         1. Analyze problem
  1462.         2. Design algorithm
  1463.         3. Code solution
  1464.         4. Ship
  1465.         5. Test
  1466.  
  1467. The same reordering would be performed if the "numbering" was by letters
  1468. (C<a.> C<b.> C<c.> etc.) or Roman numerals (C<i.> C<ii.> C<iii.)> or by
  1469. some combination of these (C<1a.> C<1b.> C<2a.> C<2b.> etc.) Handling
  1470. disordered lists of letters and Roman numerals presents an interesting
  1471. challenge. A list such as:
  1472.  
  1473.         C. Put cat in box.
  1474.         D. Close lid.
  1475.         E. Activate Geiger counter.
  1476.  
  1477. should be reordered as C<A.> C<B.> C<C.,> whereas:
  1478.  
  1479.         C. Put cat in box.
  1480.         D. Close lid.
  1481.         XLI. Activate Geiger counter.
  1482.  
  1483. should be reordered C<I.> C<II.> C<III.> 
  1484.  
  1485. The C<autoformat> subroutine solves this problem by always interpreting 
  1486. alphabetic bullets as being letters, unless the full list consists
  1487. only of valid Roman numerals, at least one of which is two or
  1488. more characters long.
  1489.  
  1490. =head2 Quoting
  1491.  
  1492. Another case in which contiguous lines may be interpreted as belonging
  1493. to different paragraphs, is where they are quoted with distinct
  1494. quoters. For example:
  1495.  
  1496.         : > CN> So anyway, how can I stop reloads on a web page?
  1497.         : > CN> Email replies only, thanks - I don't read this newsgroup.
  1498.         : > Begone, sirrah! You are a pathetic, Bill-loving,
  1499.         : > microcephalic script-infant.
  1500.         : Sheesh, what's with this group - ask a question, get toasted!
  1501.         : And how *dare* you accuse me of Ianuphilia!
  1502.  
  1503. C<autoformat> recognizes the various quoting conventions used in this example
  1504. and treats it as three paragraphs to be independently reformatted.
  1505.  
  1506. Block quotations present a different challenge. A typical formatter would
  1507. render the following quotation:
  1508.  
  1509.         "We are all of us in the gutter,
  1510.          but some of us are looking at the stars"
  1511.                                 -- Oscar Wilde
  1512.  
  1513. like so:
  1514.  
  1515.         "We are all of us in the gutter, but some of us are looking at
  1516.         the stars" -- Oscar Wilde
  1517.  
  1518. C<autoformat> recognizes the quotation structure by matching the following regular
  1519. expression against the text component of each paragraph:
  1520.  
  1521.         / \A(\s*)               # leading whitespace for quotation
  1522.           (["']|``)             # opening quotemark
  1523.           (.*)                  # quotation
  1524.           (''|\2)               # closing quotemark
  1525.           \s*?\n                # trailing whitespace after quotation
  1526.           (\1[ ]+)              # leading whitespace for attribution
  1527.                                 #   (must be indented more than quotation)
  1528.           (--|-)                # attribution introducer
  1529.           ([^\n]*?\n)           # first attribution line
  1530.           ((\5[^\n]*?$)*)       # other attribution lines 
  1531.                                 #   (indented no less than first line)
  1532.           \s*\Z                 # optional whitespace to end of paragraph
  1533.         /xsm
  1534.  
  1535. When reformatted (see below), the indentation and the attribution
  1536. structure will be preserved:
  1537.  
  1538.         "We are all of us in the gutter, but some of us are looking
  1539.          at the stars"
  1540.                                 -- Oscar Wilde
  1541.  
  1542. =head2 Widow control
  1543.  
  1544. Note that in the last example, C<autoformat> broke the line at column
  1545. 68, four characters earlier than it should have. It did so because, if
  1546. the full margin width had been used, the formatting would have left the
  1547. last two words by themselves on an oddly short last line:
  1548.  
  1549.         "We are all of us in the gutter, but some of us are looking at
  1550.          the stars"
  1551.  
  1552. This phenomenon is known as "widowing" and is heavily frowned upon in
  1553. typesetting circles. It looks ugly in plaintext too, so C<autoformat> 
  1554. avoids it by stealing extra words from earlier lines in a
  1555. paragraph, so as to leave enough for a reasonable last line. The heuristic
  1556. used is that final lines must be at least 10 characters long (though
  1557. this number may be adjusted by passing a C<widow =E<gt> I<minlength>>
  1558. argument to C<autoformat>).
  1559.  
  1560. If the last line is too short,
  1561. the paragraph's right margin is reduced by one column, and the paragraph
  1562. is reformatted. This process iterates until either the last line exceeds
  1563. nine characters or the margins have been narrowed by 10% of their
  1564. original separation. In the latter case, the reformatter gives up and uses its
  1565. original formatting.
  1566.  
  1567.  
  1568. =head2 Justification
  1569.  
  1570. The C<autoformat> subroutine also takes a named argument: C<{justify
  1571. =E<gt> I<type>}>, which specifies how each paragraph is to be justified.
  1572. The options are: C<'left'> (the default), C<'right',> C<'centre'> (or
  1573. C<'center'>), and C<'full'>. These act on the complete paragraph text
  1574. (but I<not> on any quoters before that text). For example, with C<'right'>
  1575. justification:
  1576.  
  1577.         R3>     Now is the Winter of our discontent made
  1578.         R3> glorious Summer by this son of York. And all
  1579.         R3> the clouds that lour'd upon our house In the
  1580.         R3>              deep bosom of the ocean buried.
  1581.  
  1582. Full justification is interesting in a fixed-width medium like plaintext
  1583. because it usually results in uneven spacing between words. Typically,
  1584. formatters provide this by distributing the extra spaces into the first
  1585. available gaps of each line:
  1586.  
  1587.         R3> Now  is  the  Winter  of our discontent made
  1588.         R3> glorious Summer by this son of York. And all
  1589.         R3> the  clouds  that  lour'd  upon our house In
  1590.         R3> the deep bosom of the ocean buried.
  1591.  
  1592. This produces a rather jarring visual effect, so C<autoformat> reverses
  1593. the strategy and inserts extra spaces at the end of lines:
  1594.  
  1595.         R3> Now is the Winter  of  our  discontent  made
  1596.         R3> glorious Summer by this son of York. And all
  1597.         R3> the clouds that lour'd  upon  our  house  In
  1598.         R3> the deep bosom of the ocean buried.
  1599.  
  1600. Most readers find this less disconcerting.
  1601.  
  1602. =head2 Implicit centring
  1603.  
  1604. Even if explicit centring is not specified, C<autoformat> will attempt
  1605. to automatically detect centred paragraphs and preserve their
  1606. justification. It does this by examining each line of the paragraph and
  1607. asking: "if this line were part of a centred paragraph, where would the
  1608. centre line have been?"
  1609.  
  1610. The answer can be determined by adding the length of leading whitespace
  1611. before the first word, plus half the length of the full set of words
  1612. on the line. That is, for a single line:
  1613.  
  1614.         $line =~ /^(\s*)(.*?)(\s*)$/
  1615.         $centre = length($1)+0.5*length($2);
  1616.  
  1617. By making the same estimate for every line, and then comparing the
  1618. estimates, it is possible to deduce whether all the lines are centred
  1619. with respect to the same axis of symmetry (with an allowance of
  1620. E<plusminus>1 to cater for the inevitable rounding when the centre
  1621. positions of even-length rows were originally computed). If a common
  1622. axis of symmetry is detected, C<autoformat> assumes that the lines are
  1623. supposed to be centred, and switches to centre-justification mode for
  1624. that paragraph.
  1625.  
  1626. =head2 Case transformations
  1627.  
  1628. The C<autoformat> subroutine can also optionally perform case conversions
  1629. on the text it processes. The C<{case =E<gt> I<type>}> argument allows the
  1630. user to specify five different conversions:
  1631.  
  1632. =over 4
  1633.  
  1634. =item C<'upper'>
  1635.  
  1636. This mode unconditionally converts every letter in the reformatted text to upper-case;
  1637.  
  1638. =item C<'lower'>
  1639.  
  1640. This mode unconditionally converts every letter in the reformatted text to lower-case;
  1641.  
  1642. =item C<'sentence'>
  1643.  
  1644. This mode attempts to generate correctly-cased sentences from the input text.
  1645. That is, the first letter after a sentence-terminating punctuator is converted
  1646. to upper-case. Then, each subsequent word in the sentence is converted to
  1647. lower-case, unless that word is originally mixed-case or contains punctuation.
  1648. For example, under C<{case =E<gt> 'sentence'}>:
  1649.  
  1650.         'POVERTY, MISERY, ETC. are the lot of the PhD candidate. alas!'
  1651.  
  1652. becomes:
  1653.  
  1654.         'Poverty, misery, etc. are the lot of the PhD candidate. Alas!'
  1655.  
  1656. Note that C<autoformat> is clever enough to recognize that the period after abbreviations such as C<etc.> is not a sentence terminator.
  1657.  
  1658. If the argument is specified as C<'sentence  '> (with one or more trailing
  1659. whitespace characters) those characters are used to replace the single space
  1660. that appears at the end of the sentence. For example,
  1661. C<autoformat($text, {case=E<gt>'sentence  '}>) would produce:
  1662.  
  1663.         'Poverty, misery, etc. are the lot of the PhD candidate.  Alas!'
  1664.  
  1665. =item C<'title'>
  1666.  
  1667. This mode behaves like C<'sentence'> except that the first letter of
  1668. I<every> word is capitalized:
  1669.  
  1670.         'What I Did On My Summer Vacation In Monterey'
  1671.  
  1672. =item C<'highlight'>
  1673.  
  1674. This mode behaves like C<'title'> except that trivial words are not
  1675. capitalized:
  1676.  
  1677.         'What I Did on my Summer Vacation in Monterey'
  1678.  
  1679. =back
  1680.  
  1681. =head1 OTHER FEATURES
  1682.  
  1683. =head2 The C<form> sub
  1684.  
  1685. The C<form()> subroutine may be exported from the module.
  1686. It takes a series of format (or "picture") strings followed by
  1687. replacement values, interpolates those values into each picture string,
  1688. and returns the result. The effect is similar to the inbuilt perl
  1689. C<format> mechanism, although the field specification syntax is
  1690. simpler and some of the formatting behaviour is more sophisticated.
  1691.  
  1692. A picture string consists of sequences of the following characters:
  1693.  
  1694. =over 8
  1695.  
  1696. =item <
  1697.  
  1698. Left-justified field indicator.
  1699. A series of sequential <'s specify
  1700. a left-justified field to be filled by a subsequent value.
  1701.  
  1702. =item >
  1703.  
  1704. Right-justified field indicator.
  1705. A series of sequential >'s specify
  1706. a right-justified field to be filled by a subsequent value.
  1707.  
  1708. =item ^
  1709.  
  1710. Centre-justified field indicator.
  1711. A series of sequential ^'s specify
  1712. a centred field to be filled by a subsequent value.
  1713.  
  1714. =item >>>.<<<<
  1715.  
  1716. A numerically formatted field with the specified number of digits to
  1717. either side of the decimal place. See L<Numerical formatting> below.
  1718.  
  1719.  
  1720. =item [
  1721.  
  1722. Left-justified block field indicator.
  1723. Just like a < field, except it repeats as required on subsequent lines. See
  1724. below.
  1725.  
  1726. =item ]
  1727.  
  1728. Right-justified block field indicator.
  1729. Just like a > field, except it repeats as required on subsequent lines. See
  1730. below.
  1731.  
  1732. =item |
  1733.  
  1734. Centre-justified block field indicator.
  1735. Just like a ^ field, except it repeats as required on subsequent lines. See
  1736. below.
  1737.  
  1738. =item ]]].[[[[
  1739.  
  1740. A numerically formatted block field with the specified number of digits to
  1741. either side of the decimal place.
  1742. Just like a >>>.<<<< field, except it repeats as required on
  1743. subsequent lines. See below. 
  1744.  
  1745. =item \
  1746.  
  1747. Literal escape of next character (e.g. C<\|> is formatted as '|', not a one
  1748. character wide centre-justified block field).
  1749.  
  1750. =item Any other character
  1751.  
  1752. That literal character.
  1753.  
  1754. =back
  1755.  
  1756. Any substitution value which is C<undef> (either explicitly so, or because it
  1757. is missing) is replaced by an empty string.
  1758.  
  1759.  
  1760.  
  1761. =head2 Controlling line filling.
  1762.  
  1763. Note that, unlike the a perl C<format>, C<form> preserves whitespace
  1764. (including newlines) unless called with certain options.
  1765.  
  1766. The "squeeze" option (when specified with a true value) causes any sequence
  1767. of spaces and/or tabs (but not newlines) in an interpolated string to be
  1768. replaced with a single space.
  1769.  
  1770. The "fill" option causes newlines to also be squeezed.
  1771.  
  1772. Hence:
  1773.  
  1774.     $frmt = "# [[[[[[[[[[[[[[[[[[[[[";
  1775.     $data = "h  e\t \tl lo\nworld\t\t\t\t\t";
  1776.  
  1777.     print form $frmt, $data;
  1778.     # h  e            l lo
  1779.     # world
  1780.  
  1781.     print form {squeeze=>1}, $frmt, $data;
  1782.     # h e l lo
  1783.     # world
  1784.  
  1785.     print form {fill=>1}, $frmt, $data;
  1786.     # h  e            l lo world
  1787.  
  1788.     print form {squeeze=>1, fill=>1}, $frmt, $data;
  1789.     # h e l lo world
  1790.  
  1791.  
  1792. Whether or not filling or squeezing is in effect, C<form> can also be
  1793. directed to trim any extra whitespace from the end of each line it
  1794. formats, using the "trim" option. If this option is specified with a
  1795. true value, every line returned by C<form> will automatically have the
  1796. substitution C<s/[ \t]+$//gm> applied to it.
  1797.  
  1798. Hence:
  1799.  
  1800.     print length form "[[[[[[[[[[", "short";
  1801.     # 11
  1802.  
  1803.     print length form {trim=>1}, "[[[[[[[[[[", "short";
  1804.     # 6
  1805.  
  1806.  
  1807.  
  1808. =head2 Temporary and permanent default options
  1809.  
  1810. If C<form> is called with options, but no template string or data, it resets
  1811. it's defaults to the options specified. If called in a void context:
  1812.  
  1813.         form { squeeze => 1, trim => 1 };
  1814.  
  1815. the options become permanent defaults.
  1816.  
  1817. However, when called with only options in non-void context, C<form>
  1818. resets its defaults to those options and returns an object. The reset
  1819. default values persist only until that returned object is destroyed.
  1820. Hence to temporarily reset C<form>'s defaults within a single subroutine:
  1821.  
  1822.         sub single {
  1823.                 my $tmp = form { squeeze => 1, trim => 1 };
  1824.  
  1825.                 # do formatting with the obove defaults
  1826.  
  1827.         } # form's defaults revert to previous values as $tmp object destroyed
  1828.  
  1829.  
  1830. =head2 How C<form> hyphenates
  1831.  
  1832. Any line with a block field repeats on subsequent lines until all block fields
  1833. on that line have consumed all their data. Non-block fields on these lines are
  1834. replaced by the appropriate number of spaces.
  1835.  
  1836. Words are wrapped whole, unless they will not fit into the field at
  1837. all, in which case they are broken and (by default) hyphenated. Simple
  1838. hyphenation is used (i.e. break at the I<N-1>th character and insert a
  1839. '-'), unless a suitable alternative subroutine is specified instead.
  1840.  
  1841. Words will not be broken if the break would leave less than 2 characters on
  1842. the current line. This minimum can be varied by setting the 'minbreak' option
  1843. to a numeric value indicating the minumum total broken characters (including
  1844. hyphens) required on the current line. Note that, for very narrow fields,
  1845. words will still be broken (but I<unhyphenated>). For example:
  1846.  
  1847.         print form '|', 'split';
  1848.  
  1849. would print:
  1850.  
  1851.         s
  1852.         p
  1853.         l
  1854.         i
  1855.         t
  1856.  
  1857. whilst:
  1858.  
  1859.         print form {minbreak=>1}, '|', 'split';
  1860.  
  1861. would print:
  1862.  
  1863.         s-
  1864.         p-
  1865.         l-
  1866.         i-
  1867.         t
  1868.  
  1869. Alternative breaking subroutines can be specified using the "break" option in a
  1870. configuration hash. For example:
  1871.  
  1872.         form { break => \&my_line_breaker }
  1873.              $format_str,
  1874.              @data;
  1875.  
  1876. C<form> expects any user-defined line-breaking subroutine to take three
  1877. arguments (the string to be broken, the maximum permissible length of
  1878. the initial section, and the total width of the field being filled).
  1879. The C<hypenate> sub must return a list of two strings: the initial
  1880. (broken) section of the word, and the remainder of the string
  1881. respectively).
  1882.  
  1883. For example:
  1884.  
  1885.         sub tilde_break = sub($$$)
  1886.         {
  1887.                 (substr($_[0],0,$_[1]-1).'~', substr($_[0],$_[1]-1));
  1888.         }
  1889.  
  1890.         form { break => \&tilde_break }
  1891.              $format_str,
  1892.              @data;
  1893.  
  1894.  
  1895. makes '~' the hyphenation character, whilst:
  1896.  
  1897.         sub wrap_and_slop = sub($$$)
  1898.         {
  1899.                 my ($text, $reqlen, $fldlen) = @_;
  1900.                 if ($reqlen==$fldlen) { $text =~ m/\A(\s*\S*)(.*)/s }
  1901.                 else                  { ("", $text) }
  1902.         }
  1903.  
  1904.         form { break => \&wrap_and_slop }
  1905.              $format_str,
  1906.              @data;
  1907.  
  1908. wraps excessively long words to the next line and "slops" them over
  1909. the right margin if necessary.
  1910.  
  1911. The Text::Autoformat package provides three functions to simplify the use
  1912. of variant hyphenation schemes. The exportable subroutine
  1913. C<Text::Autoformat::break_wrap> generates a reference to a subroutine
  1914. implementing the "wrap-and-slop" algorithm shown in the last example,
  1915. which could therefore be rewritten:
  1916.  
  1917.         use Text::Autoformat qw( form break_wrap );
  1918.  
  1919.         form { break => break_wrap }
  1920.              $format_str,
  1921.              @data;
  1922.  
  1923. The subroutine C<Text::Autoformat::break_with> takes a single string
  1924. argument and returns a reference to a sub which hyphenates with that
  1925. string. Hence the first of the two examples could be rewritten:
  1926.  
  1927.         use Text::Autoformat qw( form break_wrap );
  1928.  
  1929.         form { break => break_with('~') }
  1930.              $format_str,
  1931.              @data;
  1932.  
  1933. The subroutine C<Text::Autoformat::break_TeX> 
  1934. returns a reference to a sub which hyphenates using 
  1935. Jan Pazdziora's TeX::Hyphen module. For example:
  1936.  
  1937.         use Text::Autoformat qw( form break_wrap );
  1938.  
  1939.         form { break => break_TeX }
  1940.              $format_str,
  1941.              @data;
  1942.  
  1943. Note that in the previous examples there is no leading '\&' before
  1944. C<break_wrap>, C<break_with>, or C<break_TeX>, since each is being
  1945. directly I<called> (and returns a reference to some other suitable
  1946. subroutine);
  1947.  
  1948.  
  1949. =head2 The C<form> formatting algorithm
  1950.  
  1951. The algorithm C<form> uses is:
  1952.  
  1953.         1. split the first string in the argument list
  1954.            into individual format lines and add a terminating
  1955.            newline (unless one is already present).
  1956.  
  1957.         2. for each format line...
  1958.  
  1959.                 2.1. determine the number of fields and shift
  1960.                      that many values off the argument list and
  1961.                      into the filling list. If insufficient
  1962.                      arguments are available, generate as many 
  1963.                      empty strings as are required.
  1964.  
  1965.                 2.2. generate a text line by filling each field
  1966.                      in the format line with the initial contents
  1967.                      of the corresponding arg in the filling list
  1968.                      (and remove those initial contents from the arg).
  1969.  
  1970.                 2.3. replace any <,>, or ^ fields by an equivalent
  1971.                      number of spaces. Splice out the corresponding
  1972.                      args from the filling list.
  1973.  
  1974.                 2.4. Repeat from step 2.2 until all args in the
  1975.                      filling list are empty.
  1976.  
  1977.         3. concatenate the text lines generated in step 2
  1978.  
  1979.         4. repeat from step 1 until the argument list is empty
  1980.  
  1981.  
  1982. =head2 C<form> examples
  1983.  
  1984. As an example of the use of C<form>, the following:
  1985.  
  1986.         $count = 1;
  1987.         $text = "A big long piece of text to be formatted exquisitely";
  1988.  
  1989.         print form q
  1990.         {
  1991.                 ||||  <<<<<<<<<<
  1992.                 ----------------
  1993.                 ^^^^  ]]]]]]]]]]\|
  1994.                                 =
  1995.                 ]]].[[[
  1996.                 
  1997.         }, $count, $text, $count+11, $text, "123 123.4\n123.456789";
  1998.  
  1999. produces the following output:
  2000.  
  2001.                  1    A big long
  2002.                 ----------------
  2003.                  12     piece of|
  2004.                       text to be|
  2005.                        formatted|
  2006.                       exquisite-|
  2007.                               ly|
  2008.                                 =
  2009.                 123.0
  2010.                 123.4
  2011.                 123.456
  2012.  
  2013. Picture strings and replacement values can be interleaved in the
  2014. traditional C<format> format, but care is needed to ensure that the
  2015. correct number of substitution values are provided. For example:
  2016.  
  2017.         $report = form
  2018.                 'Name           Rank    Serial Number',
  2019.                 '====           ====    =============',
  2020.                 '<<<<<<<<<<<<<  ^^^^    <<<<<<<<<<<<<',
  2021.                  $name,         $rank,  $serial_number,
  2022.                 ''
  2023.                 'Age    Sex     Description',
  2024.                 '===    ===     ===========',
  2025.                 '^^^    ^^^     [[[[[[[[[[[',
  2026.                  $age,  $sex,   $description;
  2027.  
  2028.  
  2029. =head2 How C<form> consumes strings
  2030.  
  2031. Unlike C<format>, within C<form> non-block fields I<do> consume the text
  2032. they format, so the following:
  2033.  
  2034.         $text = "a line of text to be formatted over three lines";
  2035.         print form "<<<<<<<<<<\n  <<<<<<<<\n    <<<<<<\n",
  2036.                     $text,        $text,        $text;
  2037.  
  2038. produces:
  2039.  
  2040.         a line of
  2041.           text to
  2042.             be fo-
  2043.  
  2044. not:
  2045.  
  2046.         a line of
  2047.           a line 
  2048.             a line
  2049.  
  2050. To achieve the latter effect, convert the variable arguments
  2051. to independent literals (by double-quoted interpolation):
  2052.  
  2053.         $text = "a line of text to be formatted over three lines";
  2054.         print form "<<<<<<<<<<\n  <<<<<<<<\n    <<<<<<\n",
  2055.                    "$text",      "$text",      "$text";
  2056.  
  2057. Although values passed from variable arguments are progressively consumed
  2058. I<within> C<form>, the values of the original variables passed to C<form>
  2059. are I<not> altered.  Hence:
  2060.  
  2061.         $text = "a line of text to be formatted over three lines";
  2062.         print form "<<<<<<<<<<\n  <<<<<<<<\n    <<<<<<\n",
  2063.                     $text,        $text,        $text;
  2064.         print $text, "\n";
  2065.  
  2066. will print:
  2067.  
  2068.         a line of
  2069.           text to
  2070.             be fo-
  2071.         a line of text to be formatted over three lines
  2072.  
  2073. To cause C<form> to consume the values of the original variables passed to
  2074. it, pass them as references. Thus:
  2075.  
  2076.         $text = "a line of text to be formatted over three lines";
  2077.         print form "<<<<<<<<<<\n  <<<<<<<<\n    <<<<<<\n",
  2078.                     \$text,       \$text,       \$text;
  2079.         print $text, "\n";
  2080.  
  2081. will print:
  2082.  
  2083.         a line of
  2084.           text to
  2085.             be fo-
  2086.         rmatted over three lines
  2087.  
  2088. Note that, for safety, the "non-consuming" behaviour takes precedence,
  2089. so if a variable is passed to C<form> both by reference I<and> by value,
  2090. its final value will be unchanged.
  2091.  
  2092. =head2 Numerical formatting
  2093.  
  2094. The ">>>.<<<" and "]]].[[[" field specifiers may be used to format
  2095. numeric values about a fixed decimal place marker. For example:
  2096.  
  2097.         print form '(]]]]].[[)', <<EONUMS;
  2098.                    1
  2099.                    1.0
  2100.                    1.001
  2101.                    1.009
  2102.                    123.456
  2103.                    1234567
  2104.                    one two
  2105.         EONUMS
  2106.  
  2107. would print:
  2108.                    
  2109.         (    1.0 )
  2110.         (    1.0 )
  2111.         (    1.00)
  2112.         (    1.01)
  2113.         (  123.46)
  2114.         (#####.##)
  2115.         (?????.??)
  2116.         (?????.??)
  2117.  
  2118. Fractions are rounded to the specified number of places after the
  2119. decimal, but only significant digits are shown. That's why, in the
  2120. above example, 1 and 1.0 are formatted as "1.0", whilst 1.001 is
  2121. formatted as "1.00".
  2122.  
  2123. You can specify that the maximal number of decimal places always be used
  2124. by giving the configuration option 'numeric' a value that matches
  2125. /\bAllPlaces\b/i. For example:
  2126.  
  2127.         print form { numeric => AllPlaces },
  2128.                    '(]]]]].[[)', <<'EONUMS';
  2129.                    1
  2130.                    1.0
  2131.         EONUMS
  2132.  
  2133. would print:
  2134.                    
  2135.         (    1.00)
  2136.         (    1.00)
  2137.  
  2138. Note that although decimal digits are rounded to fit the specified width, the
  2139. integral part of a number is never modified. If there are not enough places
  2140. before the decimal place to represent the number, the entire number is 
  2141. replaced with hashes.
  2142.  
  2143. If a non-numeric sequence is passed as data for a numeric field, it is
  2144. formatted as a series of question marks. This querulous behaviour can be
  2145. changed by giving the configuration option 'numeric' a value that
  2146. matches /\bSkipNaN\b/i in which case, any invalid numeric data is simply
  2147. ignored. For example:
  2148.  
  2149.  
  2150.         print form { numeric => 'SkipNaN' }
  2151.                    '(]]]]].[[)',
  2152.                    <<EONUMS;
  2153.                    1
  2154.                    two three
  2155.                    4
  2156.         EONUMS
  2157.  
  2158. would print:
  2159.                    
  2160.         (    1.0 )
  2161.         (    4.0 )
  2162.  
  2163.  
  2164. =head2 Filling block fields with lists of values
  2165.  
  2166. If an argument corresponding to a field is an array reference, then C<form>
  2167. automatically joins the elements of the array into a single string, separating
  2168. each element with a newline character. As a result, a call like this:
  2169.  
  2170.         @values = qw( 1 10 100 1000 );
  2171.         print form "(]]]].[[)", \@values;
  2172.  
  2173. will print out
  2174.  
  2175.          (   1.00)
  2176.          (  10.00)
  2177.          ( 100.00)
  2178.          (1000.00)
  2179.  
  2180. as might be expected.
  2181.  
  2182. Note however that arrays must be passed by reference (so that C<form>
  2183. knows that the entire array holds data for a single field). If the previous
  2184. example had not passed @values by reference:
  2185.  
  2186.         @values = qw( 1 10 100 1000 );
  2187.         print form "(]]]].[[)", @values;
  2188.  
  2189. the output would have been:
  2190.  
  2191.          (   1.00)
  2192.          10
  2193.          100
  2194.          1000
  2195.  
  2196. This is because @values would have been interpolated into C<form>'s
  2197. argument list, so only $value[0] would have been used as the data for
  2198. the initial format string. The remaining elements of @value would have
  2199. been treated as separate format strings, and printed out "verbatim".
  2200.  
  2201. Note too that, because arrays must be passed using a reference, their
  2202. original contents are consumed by C<form>, just like the contents of
  2203. scalars passed by reference.
  2204.  
  2205. To avoid having an array consumed by C<form>, pass it as an anonymous
  2206. array:
  2207.  
  2208.         print form "(]]]].[[)", [@values];
  2209.  
  2210.  
  2211. =head2 Headers, footers, and pages
  2212.  
  2213. The C<form> subroutine can also insert headers, footers, and page-feeds
  2214. as it formats. These features are controlled by the "header", "footer",
  2215. "pagefeed", "pagelen", and "pagenum" options.
  2216.  
  2217. The "pagenum" option takes a scalar value or a reference to a scalar
  2218. variable and starts page numbering at that value. If a reference to a
  2219. scalar variable is specified, the value of that variable is updated as
  2220. the formatting proceeds, so that the final page number is available in
  2221. it after formatting. This can be useful for multi-part reports.
  2222.  
  2223. The "pagelen" option specifies the total number of lines in a page (including
  2224. headers, footers, and page-feeds).
  2225.  
  2226. If the "header" option is specified with a string value, that string is
  2227. used as the header of every page generated. If it is specified as a reference
  2228. to a subroutine, that subroutine is called at the start of every page and
  2229. its return value used as the header string. When called, the subroutine is
  2230. passed the current page number.
  2231.  
  2232. Likewise, if the "footer" option is specified with a string value, that
  2233. string is used as the footer of every page generated. If it is specified
  2234. as a reference to a subroutine, that subroutine is called at the I<start>
  2235. of every page and its return value used as the footer string. When called,
  2236. the footer subroutine is passed the current page number. If the option is
  2237. specified as a hash, it acts as described above for the "header" option.
  2238.  
  2239. Both the header and footer options can also be specified as hash references.
  2240. In this case the hash entires for keys "left", "centre" (or "center"), and
  2241. "right" specify what is to appear on the left, centre, and right of the
  2242. header/footer. The entry for the key "width" specifies how wide the
  2243. footer is to be. The  "left", "centre", and "right" values may be literal
  2244. strings, or subroutines (just as a normal header/footer specification may
  2245. be.) See the second example, below.
  2246.  
  2247. The "pagefeed" option acts in exactly the same way, to produce a
  2248. pagefeed which is appended after the footer. But note that the pagefeed
  2249. is not counted as part of the page length.
  2250.  
  2251. All three of these page components are recomputed at the start of each
  2252. new page, before the page contents are formatted (recomputing the header
  2253. and footer makes it possible to determine how many lines of data to
  2254. format so as to adhere to the specified page length).
  2255.  
  2256. When the call to C<form> is complete and the data has been fully formatted,
  2257. the footer subroutine is called one last time, with an extra argument of 1.
  2258. The string returned by this final call is used as the final footer.
  2259.  
  2260. So for example, a 60-line per page report, starting at page 7,
  2261. with appropriate headers and footers might be set up like so:
  2262.  
  2263.         $page = 7;
  2264.  
  2265.         form { header => sub { "Page $_[0]\n\n" },
  2266.                footer => sub { return "" if $_[1];
  2267.                                "-"x50 . "\n" . form ">"x50", "...".($_[0]+1);
  2268.                              },
  2269.                pagefeed => "\n\n",
  2270.                pagelen  => 60
  2271.                pagenum  => \$page,
  2272.              },
  2273.              $template,
  2274.              @data;
  2275.  
  2276. Note the recursive use of C<form> within the "footer" option.
  2277.  
  2278. Alternatively, to set up headers and footers such that the running
  2279. head is right justified in the header and the page number is centred
  2280. in the footer:
  2281.  
  2282.         form { header => { right => "Running head" },
  2283.                footer => { centre => sub { "Page $_[0]" } },
  2284.                pagelen  => 60
  2285.              },
  2286.              $template,
  2287.              @data;
  2288.  
  2289.  
  2290.  
  2291. =head2 The C<tag> sub
  2292.  
  2293. The C<tag> subroutine may be exported from the module.
  2294. It takes two arguments: a tag specifier and a text to be
  2295. entagged. The tag specifier indicates the indenting of the tag, and of the
  2296. text. The sub generates an end-tag (using the usual "/I<tag>" variant),
  2297. unless an explicit end-tag is provided as the third argument.
  2298.  
  2299. The tag specifier consists of the following components (in order):
  2300.  
  2301. =over 4
  2302.  
  2303. =item An optional vertical spacer (zero or more whitespace-separated newlines)
  2304.  
  2305. One or more whitespace characters up to a final mandatory newline. This
  2306. vertical space is inserted before the tag and after the end-tag
  2307.  
  2308. =item An optional tag indent
  2309.  
  2310. Zero or more whitespace characters. Both the tag and the end-tag are indented
  2311. by this whitespace.
  2312.  
  2313. =item An optional left (opening) tag delimiter
  2314.  
  2315. Zero or more non-"word" characters (not alphanumeric or '_').
  2316. If the opening delimiter is omitted, the character '<' is used.
  2317.  
  2318. =item A tag
  2319.  
  2320. One or more "word" characters (alphanumeric or '_').
  2321.  
  2322. =item Optional tag arguments
  2323.  
  2324. Any number of any characters
  2325.  
  2326. =item An optional right (closing) tag delimiter
  2327.  
  2328. Zero or more non-"word" characters which balance some sequential portion
  2329. of the opening tag delimiter. For example, if the opening delimiter
  2330. is "<-(" then any of the following are acceptible closing delimiters:
  2331. ")->", "->", or ">".
  2332. If the closing delimiter is omitted, the "inverse" of the opening delimiter 
  2333. is used (for example, ")->"),
  2334.  
  2335. =item An optional vertical spacer (zero or more newlines)
  2336.  
  2337. One or more whitespace characters up to a mandatory newline. This
  2338. vertical space is inserted before and after the complete text.
  2339.  
  2340. =item An optional text indent
  2341.  
  2342. Zero or more space of tab characters. Each line of text is indented
  2343. by this whitespace (in addition to the tag indent).
  2344.  
  2345.  
  2346. =back
  2347.  
  2348. For example:
  2349.  
  2350.         $text = "three lines\nof tagged\ntext";
  2351.  
  2352.         print tag "A HREF=#nextsection", $text;
  2353.  
  2354. prints:
  2355.  
  2356.         <A HREF=#nextsection>three lines
  2357.         of tagged
  2358.         text</A>
  2359.  
  2360. whereas:
  2361.  
  2362.         print tag "[-:GRIN>>>\n", $text;
  2363.  
  2364. prints:
  2365.  
  2366.         [-:GRIN>>>:-]
  2367.         three lines
  2368.         of tagged
  2369.         text
  2370.         [-:/GRIN>>>:-]
  2371.  
  2372. and:
  2373.  
  2374.         print tag "\n\n   <BOLD>\n\n   ", $text, "<END BOLD>";
  2375.  
  2376. prints:
  2377.  
  2378. S< >
  2379.  
  2380.            <BOLD>
  2381.  
  2382.               three lines
  2383.               of tagged
  2384.               text
  2385.  
  2386.            <END BOLD>
  2387.  
  2388. S< >
  2389.  
  2390. (with the indicated spacing fore and aft).
  2391.  
  2392. =head1 AUTHOR
  2393.  
  2394. Damian Conway (damian@conway.org)
  2395.  
  2396. =head1 BUGS
  2397.  
  2398. There are undoubtedly serious bugs lurking somewhere in code this funky :-)
  2399. Bug reports and other feedback are most welcome.
  2400.  
  2401. =head1 COPYRIGHT
  2402.  
  2403. Copyright (c) 1997-2000, Damian Conway. All Rights Reserved.
  2404. This module is free software. It may be used, redistributed
  2405. and/or modified under the terms of the Perl Artistic License
  2406.   (see http://www.perl.com/perl/misc/Artistic.html)
  2407.