code/SystemTag/row.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: row.coretag,v 1.4 2007-03-30 23:40:49 pajamian Exp $
   9
  10 UserTag row                 Order        width
  11 UserTag row                 hasEndTag
  12 UserTag row                 Interpolate
  13 UserTag row                 PosNumber    1
  14 UserTag row                 Version      $Revision: 1.4 $
  15 UserTag row                 Routine      <<EOR
  16 sub tag_column {
  17         my($spec,$text) = @_;
  18         my($append,$f,$i,$line,$usable);
  19         my(%def) = qw(
  20                                         width 0
  21                                         spacing 1
  22                                         gutter 2
  23                                         wrap 1
  24                                         html 0
  25                                         align left
  26                                 );
  27         my(%spec)       = ();
  28         my(@out)        = ();
  29         my(@lines)      = ();
  30
  31         $spec =~ s/\n/ /g;
  32         $spec =~ s/^\s+//;
  33         $spec =~ s/\s+$//;
  34         $spec = lc $spec;
  35
  36         $spec =~ s/\s*=\s*/=/;
  37         $spec =~ s/^(\d+)/width=$1/;
  38         %spec = split /[\s=]+/, $spec;
  39
  40         for(keys %def) {
  41                 $spec{$_} = $def{$_} unless defined $spec{$_};
  42         }
  43
  44         if($spec{'html'} && $spec{'wrap'}) {
  45                 ::logError("tag_column: can't have 'wrap' and 'html' specified at same time.");
  46                 $spec{wrap} = 0;
  47         }
  48
  49         if(! $spec{align} or $spec{align} !~ /^n/i) {
  50                 $text =~ s/\s+/ /g;
  51         }
  52
  53         my $len = sub {
  54                 my($txt) = @_;
  55                 if (1 or $spec{html}) {
  56                         $txt =~
  57                         s{ <
  58                                    (
  59                                          [^>'"] +
  60                                                 |
  61                                          ".*?"
  62                                                 |
  63                                          '.*?'
  64                                         ) +
  65                                 >
  66                         }{}gsx;
  67                 }
  68                 return length($txt);
  69         };
  70
  71         $usable = $spec{'width'} - $spec{'gutter'};
  72         return "BAD_WIDTH" if  $usable < 1;
  73
  74         if($spec{'align'} =~ /^[ln]/i) {
  75                 $f = sub {
  76                                         $_[0] .
  77                                         ' ' x ($usable - $len->($_[0])) .
  78                                         ' ' x $spec{'gutter'};
  79                                         };
  80         }
  81         elsif($spec{'align'} =~ /^r/i) {
  82                 $f = sub {
  83                                         ' ' x ($usable - $len->($_[0])) .
  84                                         $_[0] .
  85                                         ' ' x $spec{'gutter'};
  86                                         };
  87         }
  88         elsif($spec{'align'} =~ /^i/i) {
  89                 $spec{'wrap'} = 0;
  90                 $usable = 9999;
  91                 $f = sub { @_ };
  92         }
  93         else {
  94                 return "BAD JUSTIFICATION SPECIFICATION: $spec{'align'}";
  95         }
  96
  97         $append = '';
  98         if($spec{'spacing'} > 1) {
  99                 $append .= "\n" x ($spec{'spacing'} - 1);
 100         }
 101
 102         if($spec{'align'} =~ /^n/i) {
 103                 @lines = split(/\r?\n/, $text);
 104         }
 105         elsif(is_yes($spec{'wrap'}) and length($text) > $usable) {
 106                 @lines = wrap($text,$usable);
 107         }
 108         elsif($spec{'align'} =~ /^i/i) {
 109                 $lines[0] = ' ' x $spec{'width'};
 110                 $lines[1] = $text . ' ' x $spec{'gutter'};
 111         }
 112         elsif (! $spec{'html'}) {
 113                 $lines[0] = substr($text,0,$usable);
 114         }
 115
 116         foreach $line (@lines) {
 117                 push @out , &{$f}($line);
 118                 for($i = 1; $i < $spec{'spacing'}; $i++) {
 119                         push @out, '';
 120                 }
 121         }
 122         @out;
 123 }
 124
 125 sub wrap {
 126     my ($str, $width) = @_;
 127     my @a = ();
 128     my ($l, $b);
 129
 130     for (;;) {
 131         $str =~ s/^ +//;
 132         $l = length($str);
 133         last if $l == 0;
 134         if ($l <= $width) {
 135             push @a, $str;
 136             last;
 137         }
 138         $b = rindex($str, " ", $width - 1);
 139         if ($b == -1) {
 140             push @a, substr($str, 0, $width);
 141             $str = substr($str, $width);
 142         }
 143         else {
 144             push @a, substr($str, 0, $b);
 145             $str = substr($str, $b + 1);
 146         }
 147     }
 148     return @a;
 149 }
 150
 151 sub {
 152     my($width,$text) = @_;
 153         my($col,$spec);
 154         my(@lines);
 155         my(@len);
 156         my(@out);
 157         my($i,$j,$k);
 158         my($x,$y,$line);
 159
 160         $i = 0;
 161         while( $text =~ s!\[col(?:umn)?\s+
 162                                                 ([^\]]+)
 163                                                 \]
 164                                                 ((?s:.)*?)
 165                                                 \[/col(?:umn)?\] !!ix    ) {
 166                 $spec = $1;
 167                 $col = $2;
 168                 $lines[$i] = [];
 169                 @{$lines[$i]} = tag_column($spec,$col);
 170                 # Discover X dimension
 171                 $len[$i] = length(${$lines[$i]}[0]);
 172                 if(defined ${$lines[$i]}[1] and ${$lines[$i]}[1] =~ /^<\s*input\s+/i) {
 173                         shift @{$lines[$i]};
 174                 }
 175                 $i++;
 176         }
 177         my $totlen = 0;
 178         for(@len) { $totlen += $_ }
 179         if ($totlen > $width) {
 180                 return " B A D   R O W  S P E C I F I C A T I O N - columns too wide.\n"
 181         }
 182
 183         # Discover y dimension
 184         $j = $#{$lines[0]};
 185         for ($k = 1; $k < $i; $k++) {
 186                 $j = $#{$lines[$k]} > $j ? $#{$lines[$k]} : $j;
 187         }
 188
 189         for($y = 0; $y <= $j; $y++) {
 190                 $line = '';
 191                 for($x = 0; $x < $i; $x++) {
 192                         if(defined ${$lines[$x]}[$y]) {
 193                                 $line .= ${$lines[$x]}[$y];
 194                                 $line =~ s/\s+$//
 195                                         if ($i - $x) == 1;
 196                         }
 197                         elsif (($i - $x) > 1) {
 198                                 $line  .= ' ' x $len[$x];
 199                         }
 200                         else {
 201                                 $line =~ s/\s+$//;
 202                         }
 203                 }
 204                 push @out, $line;
 205         }
 206         join "\n", @out;
 207 }
 208 EOR