| blib/lib/LaTeX/Replicase.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 459 | 495 | 92.7 |
| branch | 300 | 368 | 81.5 |
| condition | 158 | 229 | 69.0 |
| subroutine | 21 | 21 | 100.0 |
| pod | 2 | 2 | 100.0 |
| total | 940 | 1115 | 84.3 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package LaTeX::Replicase; | ||||||
| 2 | |||||||
| 3 | 2 | 2 | 290838 | use 5.010; | |||
| 2 | 8 | ||||||
| 4 | 2 | 2 | 10 | use strict; | |||
| 2 | 12 | ||||||
| 2 | 65 | ||||||
| 5 | 2 | 2 | 9 | use warnings; | |||
| 2 | 3 | ||||||
| 2 | 99 | ||||||
| 6 | 2 | 2 | 12 | use utf8; | |||
| 2 | 6 | ||||||
| 2 | 10 | ||||||
| 7 | |||||||
| 8 | 2 | 2 | 158 | use File::Basename qw(fileparse); | |||
| 2 | 3 | ||||||
| 2 | 226 | ||||||
| 9 | 2 | 2 | 12 | use File::Path qw(make_path); | |||
| 2 | 3 | ||||||
| 2 | 135 | ||||||
| 10 | 2 | 2 | 16874 | use File::Compare; | |||
| 2 | 2350 | ||||||
| 2 | 190 | ||||||
| 11 | 2 | 2 | 15 | use Carp; | |||
| 2 | 3 | ||||||
| 2 | 19097 | ||||||
| 12 | |||||||
| 13 | require Exporter; | ||||||
| 14 | |||||||
| 15 | our @ISA = qw(Exporter); | ||||||
| 16 | |||||||
| 17 | our %EXPORT_TAGS = ('all' => [ qw( | ||||||
| 18 | replication | ||||||
| 19 | tex_escape | ||||||
| 20 | ) ], | ||||||
| 21 | ); | ||||||
| 22 | |||||||
| 23 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||||||
| 24 | our @EXPORT = qw( ); | ||||||
| 25 | |||||||
| 26 | our $VERSION = '0.599'; | ||||||
| 27 | our $DEBUG; $DEBUG = 0 unless defined $DEBUG; | ||||||
| 28 | our @logs; | ||||||
| 29 | our $nlo = 1; # Number Line Output, start of 1 | ||||||
| 30 | |||||||
| 31 | sub tex_escape { | ||||||
| 32 | 15 | 100 | 66 | 15 | 1 | 336375 | return if ! $_[0] or $_[0] =~/^[a-zA-Z0-9,=:;!\.\s\+\-\*]+$/ or $_[0] =~s/^%%%://; |
| 100 | |||||||
| 33 | |||||||
| 34 | 11 | 30 | for( $_[0] ) { | ||||
| 35 | 11 | 29 | s/\\/\\textbackslash\{\}/g; | ||||
| 36 | 11 | 82 | s/([%}{_&\$\#])/\\$1/g; # masking active symbols | ||||
| 37 | 11 | 61 | s/\^/\\$&\{\}/g; # ^ --> \^{} | ||||
| 38 | |||||||
| 39 | 11 | 100 | 66 | 61 | s/~/\\texttt\{\\~\{\}\}/g if $_[1] && $_[1] =~/~/; # tilde (~) --> \texttt{\~{}} | ||
| 40 | } | ||||||
| 41 | } | ||||||
| 42 | |||||||
| 43 | |||||||
| 44 | sub replication { | ||||||
| 45 | 21 | 21 | 1 | 241860 | my( $source, $info, %op ) = @_; | ||
| 46 | |||||||
| 47 | 21 | 100 | 48 | our $DEBUG; $DEBUG = $op{debug} if defined $op{debug}; | |||
| 21 | 120 | ||||||
| 48 | 21 | 56 | $DEBUG += 0; | ||||
| 49 | 21 | 74 | our @logs = (); | ||||
| 50 | |||||||
| 51 | 21 | 100 | 66 | 136 | if( defined( $source ) && length( $source ) ) { | ||
| 52 | |||||||
| 53 | 20 | 100 | 109 | if(ref \$source eq 'SCALAR') { | |||
| 100 | |||||||
| 54 | 17 | 45 | for( $source ) { | ||||
| 55 | 17 | 88 | s/^\s+//; | ||||
| 56 | 17 | 50 | s/\s+.*//s; | ||||
| 57 | |||||||
| 58 | 17 | 50 | 868 | $_ = (glob)[0] if $^O =~/(?:linux|bsd|darwin|solaris|sunos)/; | |||
| 59 | } | ||||||
| 60 | } | ||||||
| 61 | elsif(ref $source ne 'ARRAY') { | ||||||
| 62 | 1 | 4 | $_ = "!!! ERROR#6: invalid FILE or ARRAY input!"; | ||||
| 63 | 1 | 50 | 5 | $op{silent} or carp $_; | |||
| 64 | |||||||
| 65 | 1 | 3 | push @logs, $_; | ||||
| 66 | 1 | 6 | return \@logs; | ||||
| 67 | } | ||||||
| 68 | |||||||
| 69 | } | ||||||
| 70 | else { | ||||||
| 71 | 1 | 5 | $_ = "!!! ERROR#0: undefined input FILE or ARRAY!"; | ||||
| 72 | 1 | 50 | 5 | $op{silent} or carp $_; | |||
| 73 | |||||||
| 74 | 1 | 4 | push @logs, $_; | ||||
| 75 | 1 | 5 | return \@logs; | ||||
| 76 | } | ||||||
| 77 | |||||||
| 78 | 19 | 100 | 122 | push @logs, "--> Checking source data: '$source'" if $DEBUG; | |||
| 79 | |||||||
| 80 | 19 | 100 | 100 | 382 | if((ref \$source eq 'SCALAR' and ! -s $source) or (ref $source eq 'ARRAY' and ! @$source)) { | ||
| 66 | |||||||
| 66 | |||||||
| 81 | 1 | 4 | $_ = "!!! ERROR#1: source ('$source') does NOT exist or is EMPTY!"; | ||||
| 82 | 1 | 50 | 33 | $op{silent} or carp $_; | |||
| 83 | |||||||
| 84 | 1 | 4 | push @logs, $_; | ||||
| 85 | 1 | 5 | return \@logs; | ||||
| 86 | } | ||||||
| 87 | |||||||
| 88 | # global data of TeX file | ||||||
| 89 | 18 | 100 | 100 | 171 | unless( $info | ||
| 66 | |||||||
| 90 | and (( ref $info eq 'HASH' and %$info ) or (ref $info eq 'ARRAY' and @$info )) | ||||||
| 91 | ) { | ||||||
| 92 | 2 | 6 | $_= "!!! ERROR#2: EMPTY or WRONG data!"; | ||||
| 93 | 2 | 50 | 8 | $op{silent} or carp $_; | |||
| 94 | |||||||
| 95 | 2 | 6 | push @logs, $_; | ||||
| 96 | 2 | 12 | return \@logs; | ||||
| 97 | } | ||||||
| 98 | |||||||
| 99 | # environments: global for %%%V:, %%%VAR: ; and local for %%%VAR: | ||||||
| 100 | 16 | 45 | my $data = my $vardata = $info; | ||||
| 101 | |||||||
| 102 | 16 | 38 | my( $filename, $dir ); | ||||
| 103 | 16 | 100 | 49 | if( ref \$source eq 'SCALAR') { | |||
| 104 | 14 | 547 | ( $filename, $dir, my($ext)) = fileparse( $source ); | ||||
| 105 | } | ||||||
| 106 | else { # for ARRAY input | ||||||
| 107 | 2 | 7 | $filename = 'ready.tex'; | ||||
| 108 | 2 | 5 | $dir = '.'; | ||||
| 109 | } | ||||||
| 110 | |||||||
| 111 | 16 | 51 | my( $fh, $ofile ); | ||||
| 112 | 16 | 100 | 66 | 100 | if( defined( $_ = $op{ofile} ) && length ) { | ||
| 113 | 15 | 100 | 60 | if(/::STDOUT$/) { | |||
| 114 | 1 | 4 | $fh = $ofile = $_; | ||||
| 115 | } | ||||||
| 116 | else { | ||||||
| 117 | 14 | 50 | s/^\s+//; | ||||
| 118 | 14 | 39 | s/\s+.*//s; | ||||
| 119 | 14 | 50 | 550 | $ofile = ( $^O =~/(?:linux|bsd|darwin|solaris|sunos)/ ) ? (glob)[0] : $_; | |||
| 120 | } | ||||||
| 121 | } | ||||||
| 122 | else { | ||||||
| 123 | 1 | 33 | 6 | my $outdir = $op{outdir} // "$dir/$$"; # Target dir for ready TeX file | |||
| 124 | 1 | 50 | 4 | if( length $outdir ) { | |||
| 125 | 1 | 4 | for( $outdir ) { | ||||
| 126 | 1 | 3 | s/^\s+//; | ||||
| 127 | 1 | 5 | s/\s+.*//s; | ||||
| 128 | |||||||
| 129 | 1 | 50 | 54 | $_ = (glob)[0] if $^O =~/(?:linux|bsd|darwin|solaris|sunos)/; | |||
| 130 | } | ||||||
| 131 | } | ||||||
| 132 | else { # for $outdir = '' | ||||||
| 133 | 0 | 0 | $outdir = "./$$"; | ||||
| 134 | } | ||||||
| 135 | |||||||
| 136 | 1 | 50 | 40 | unless( -d $outdir ) { | |||
| 137 | 1 | 285 | make_path( $outdir, {error => \my $err} ); | ||||
| 138 | |||||||
| 139 | 1 | 50 | 33 | 13 | if ($err && @$err) { | ||
| 140 | |||||||
| 141 | 0 | 0 | for my $diag (@$err) { | ||||
| 142 | 0 | 0 | my( $path, $message ) = %$diag; | ||||
| 143 | 0 | 0 | 0 | 0 | $_ = ( $path && length( $path ) ) ? | ||
| 144 | "!!! ERROR#7: ('$path' creation problem) $message" : | ||||||
| 145 | "!!! ERROR#8: (general error) $message"; | ||||||
| 146 | 0 | 0 | 0 | $op{silent} or carp $_; | |||
| 147 | 0 | 0 | push @logs, $_; | ||||
| 148 | } | ||||||
| 149 | |||||||
| 150 | 0 | 0 | return \@logs; | ||||
| 151 | } | ||||||
| 152 | |||||||
| 153 | } | ||||||
| 154 | |||||||
| 155 | 1 | 4 | $ofile = "$outdir/$filename"; | ||||
| 156 | } | ||||||
| 157 | |||||||
| 158 | 16 | 100 | 79 | push @logs, "--> Using '$ofile' file as output" if $DEBUG; | |||
| 159 | |||||||
| 160 | # new file must be different | ||||||
| 161 | 16 | 100 | 66 | 330 | if( -s $ofile and ref \$source eq 'SCALAR' | ||
| 66 | |||||||
| 66 | |||||||
| 162 | and ( | ||||||
| 163 | ( $source eq $ofile and compare( $source, $ofile ) == 0 ) | ||||||
| 164 | or | ||||||
| 165 | ( join(',', stat $source) eq join(',', stat $ofile) ) | ||||||
| 166 | ) | ||||||
| 167 | ) { | ||||||
| 168 | 1 | 195 | $_= "!!! ERROR#3: Input (template) & output files match. Can't overwrite template file!"; | ||||
| 169 | 1 | 50 | 6 | $op{silent} or carp $_; | |||
| 170 | |||||||
| 171 | 1 | 4 | push @logs, $_; | ||||
| 172 | 1 | 6 | return \@logs; | ||||
| 173 | } | ||||||
| 174 | |||||||
| 175 | 15 | 46 | my $TEMPLATE; | ||||
| 176 | 15 | 100 | 63 | if( ref \$source eq 'SCALAR') { | |||
| 177 | 13 | 100 | 52 | my $mode = $op{utf8} ? ':utf8' : ''; | |||
| 178 | |||||||
| 179 | 13 | 100 | 43 | push @logs, "--> Open '$source'" if $DEBUG; | |||
| 180 | |||||||
| 181 | 13 | 50 | 668 | open $TEMPLATE, "<:raw$mode", $source or do{ | |||
| 182 | 0 | 0 | $_= "!!! ERROR#4: $!"; | ||||
| 183 | 0 | 0 | 0 | $op{silent} or carp $_; | |||
| 184 | |||||||
| 185 | 0 | 0 | push @logs, $_; | ||||
| 186 | 0 | 0 | return \@logs; | ||||
| 187 | }; | ||||||
| 188 | } | ||||||
| 189 | |||||||
| 190 | 15 | 100 | 140 | unless( $fh ) { # it's not "::STDOUT" | |||
| 191 | 14 | 100 | 61 | my $mode = $op{utf8} ? ':encoding(utf8)' : ''; | |||
| 192 | |||||||
| 193 | 14 | 100 | 65 | push @logs, "--> Open '$ofile'" if $DEBUG; | |||
| 194 | |||||||
| 195 | 1 | 50 | 1 | 993 | open $fh, ">$mode", $ofile or do{ | ||
| 1 | 19 | ||||||
| 1 | 6 | ||||||
| 14 | 1660 | ||||||
| 196 | 0 | 0 | $_= "!!! ERROR#5: $!"; | ||||
| 197 | 0 | 0 | 0 | $op{silent} or carp $_; | |||
| 198 | |||||||
| 199 | 0 | 0 | push @logs, $_; | ||||
| 200 | 0 | 0 | return \@logs; | ||||
| 201 | }; | ||||||
| 202 | } | ||||||
| 203 | |||||||
| 204 | 15 | 1483 | $nlo = 1; | ||||
| 205 | 15 | 36 | my $chkVAR = 0; # check %%%VAR for ARRAY|HASH|SCALAR|REF->SCALAR type | ||||
| 206 | 15 | 66 | my $key; | ||||
| 207 | my $tdz; # flag of The Dead Zone | ||||||
| 208 | 15 | 0 | my @columns; | ||||
| 209 | |||||||
| 210 | =for comment | ||||||
| 211 | =begin comment | ||||||
| 212 | @columns: | ||||||
| 213 | [...]: -- table columns | ||||||
| 214 | [...]{...} -- descriptions (properties) of table columns: | ||||||
| 215 | {ki} -- name (key || index ) of a variable from $data->{ $key } | ||||||
| 216 | {%} -- NO \par | ||||||
| 217 | {p} -- to paste text on right | ||||||
| 218 | {head}[...] -- TeX strings before %%%V: | ||||||
| 219 | {tail}[...] -- TeX strings after %%%V: | ||||||
| 220 | {eX}[...] -- indices of {head} that eXcept for the first and last elements and rows of %%%VAR: | ||||||
| 221 | =end comment | ||||||
| 222 | =cut | ||||||
| 223 | |||||||
| 224 | 15 | 100 | 45 | if( $TEMPLATE ) { | |||
| 225 | 13 | 345 | while( my $z = <$TEMPLATE> ) { | ||||
| 226 | |||||||
| 227 | 870 | 100 | 2465 | if( &_line_decryption( $fh, $info, \$z, \$data, \$vardata, \$chkVAR, \$key, \$tdz, \@columns, \%op ) ) { | |||
| 228 | 10 | 21 | print { $fh } <$TEMPLATE>; | ||||
| 10 | 182 | ||||||
| 229 | 10 | 48 | last; #--> Exit template | ||||
| 230 | } | ||||||
| 231 | 860 | 3295 | undef $z; | ||||
| 232 | |||||||
| 233 | } | ||||||
| 234 | 13 | 198 | close $TEMPLATE; | ||||
| 235 | } | ||||||
| 236 | else { | ||||||
| 237 | 2 | 5 | my $e; | ||||
| 238 | 2 | 7 | for my $z ( @$source ) { | ||||
| 239 | |||||||
| 240 | 228 | 100 | 530 | if( $e ) { | |||
| 241 | 6 | 11 | print { $fh } $z; | ||||
| 6 | 55 | ||||||
| 242 | } | ||||||
| 243 | else { | ||||||
| 244 | 222 | 600 | $e = &_line_decryption( $fh, $info, \$z, \$data, \$vardata, \$chkVAR, \$key, \$tdz, \@columns, \%op ); | ||||
| 245 | } | ||||||
| 246 | } | ||||||
| 247 | } | ||||||
| 248 | |||||||
| 249 | 15 | 50 | 50 | if( defined $key ) { | |||
| 250 | 0 | 0 | &_var_output( $fh, $key, $vardata, \@columns, \%op ); | ||||
| 251 | |||||||
| 252 | 0 | 0 | $_ = "~~> l.$. WARNING#1: Missing '%%%ENDx' tag for '$key'"; | ||||
| 253 | 0 | 0 | 0 | $op{silent} or carp $_; | |||
| 254 | 0 | 0 | push @logs, $_; | ||||
| 255 | } | ||||||
| 256 | |||||||
| 257 | 15 | 100 | 1471 | $ofile =~/::STDOUT$/ or close $fh; | |||
| 258 | |||||||
| 259 | 15 | 100 | 192 | @logs or return; | |||
| 260 | 6 | 70 | return \@logs; | ||||
| 261 | } | ||||||
| 262 | |||||||
| 263 | #--------------------- | ||||||
| 264 | # Internal function(s) | ||||||
| 265 | |||||||
| 266 | sub _line_decryption { | ||||||
| 267 | 1092 | 1092 | 3016 | my( $fh, $info, $z, $data, $vardata, $chkVAR, $key, $tdz, $columns, $op ) = @_; | |||
| 268 | |||||||
| 269 | 1092 | 1840 | our $DEBUG; | ||||
| 270 | 1092 | 1830 | our @logs; | ||||
| 271 | 1092 | 1798 | our $nlo; | ||||
| 272 | |||||||
| 273 | 1092 | 100 | 3453 | if( defined $$key ) { # We are in VAR-structure | |||
| 100 | |||||||
| 274 | |||||||
| 275 | 471 | 100 | 2290 | return unless $$z =~/%%%[AETV]\S*:/; # Nope control tags --> drop TeX line | |||
| 276 | |||||||
| 277 | 357 | 100 | 66 | 2845 | if( $$z =~/%%%(?:END(? |
||
| 50 | 100 | ||||||
| 0 | |||||||
| 33 | |||||||
| 66 | |||||||
| 278 | 70 | 616 | my $t = $+{t}; | ||||
| 279 | 70 | 316 | &_var_output( $fh, $$key, $$vardata, $columns, $op ); | ||||
| 280 | |||||||
| 281 | # Clear the VAR-structure for the next external VARiable | ||||||
| 282 | 70 | 165 | $$chkVAR = 0; | ||||
| 283 | 70 | 157 | undef $$key; | ||||
| 284 | 70 | 404 | @$columns = (); | ||||
| 285 | |||||||
| 286 | 70 | 100 | 100 | 313 | return 1 if $t && $t eq 'T'; # end of template area --> Exit template | ||
| 287 | |||||||
| 288 | 64 | 100 | 66 | 187 | undef $$tdz if $t && $t eq 'Z'; | ||
| 289 | |||||||
| 290 | 64 | 100 | 547 | return if $$z =~/%%%ENDZ?:/; # end of %%%VAR: tag | |||
| 291 | |||||||
| 292 | 10 | 100 | 72 | if( $$z =~/%%%+TDZ:/) { # The Dead Zone | |||
| 293 | 7 | 18 | $$tdz = 1; | ||||
| 294 | 7 | 29 | return; | ||||
| 295 | } | ||||||
| 296 | |||||||
| 297 | } | ||||||
| 298 | elsif( (ref $$vardata eq 'HASH' and ( | ||||||
| 299 | ref $$vardata->{ $$key } eq 'HASH' | ||||||
| 300 | or ref $$vardata->{ $$key } eq 'ARRAY' | ||||||
| 301 | or ref \$$vardata->{ $$key } eq 'SCALAR' | ||||||
| 302 | or ref $$vardata->{ $$key } eq 'SCALAR' # REF->SCALAR | ||||||
| 303 | ) | ||||||
| 304 | ) | ||||||
| 305 | or (ref $$vardata eq 'ARRAY' and ( | ||||||
| 306 | ref $$vardata->[ $$key ] eq 'HASH' | ||||||
| 307 | or ref $$vardata->[ $$key ] eq 'ARRAY' | ||||||
| 308 | or ref \$$vardata->[ $$key ] eq 'SCALAR' | ||||||
| 309 | or ref $$vardata->[ $$key ] eq 'SCALAR' # REF->SCALAR | ||||||
| 310 | ) | ||||||
| 311 | ) | ||||||
| 312 | ) { | ||||||
| 313 | 287 | 100 | 822 | my $vk = ref $$vardata eq 'HASH' ? $$vardata->{ $$key } : $$vardata->[ $$key ]; | |||
| 314 | 287 | 100 | 100 | 1089 | my $sclr = (ref \$vk eq 'SCALAR' or ref $vk eq 'SCALAR') ? 1 : 0; | ||
| 315 | |||||||
| 316 | # Index of column in target table | ||||||
| 317 | 287 | 100 | 100 | 1284 | my $j = ( @$columns && exists( $columns->[-1]{ki} ) ) ? | ||
| 50 | |||||||
| 318 | @$columns : | ||||||
| 319 | ($#$columns // 0); | ||||||
| 320 | 287 | 100 | 100 | 1014 | $j = 0 if $j < 0 or $sclr; | ||
| 321 | |||||||
| 322 | 287 | 100 | 100 | 4661 | if( ! $sclr and $$z =~/%%%V:\s*([^\s:%#]+)(%?)\s?(.*)/) { | ||
| 100 | 100 | ||||||
| 323 | # this V-variable is nested in a VAR-structure | ||||||
| 324 | 112 | 308 | my $ki = $1; # name (key or index) of V-variable | ||||
| 325 | 112 | 235 | my $Np = $2; # NO \par | ||||
| 326 | 112 | 267 | my $paste = $3; # on right | ||||
| 327 | |||||||
| 328 | 112 | 100 | 100 | 2086 | if( $$chkVAR == 0b0001) { # V-variable is in {HASH|ARRAY}.ARRAY of VAR-structure | ||
| 100 | 66 | ||||||
| 100 | 33 | ||||||
| 100 | |||||||
| 329 | |||||||
| 330 | 32 | 100 | 66 | 309 | if( $ki eq '@') { | ||
| 100 | 66 | ||||||
| 50 | |||||||
| 331 | 1 | 3 | $ki = '0-'; # ALL elements | ||||
| 332 | 1 | 5 | $columns->[$j]{ki} = $ki; # starting index (unnamed meaning) | ||||
| 333 | } | ||||||
| 334 | elsif( $ki =~/^\-*(\d+)$/ && ($1 < @$vk or ($ki < 0 && $1 == @$vk)) ) { | ||||||
| 335 | # specific indices, e.g.: 0 or 3 or -1 | ||||||
| 336 | 16 | 55 | $columns->[$j]{ki} = $ki; | ||||
| 337 | } | ||||||
| 338 | elsif( $ki =~/^[\d,\-]+$/) { | ||||||
| 339 | # mixed indexes, e.g.: 1-3,6-7-9,-,4,-5,0,7- or 3- (i.e. 3..arr_end) or 0-5 (0..5) or -1- (-1,-2,..arr_start) | ||||||
| 340 | 15 | 39 | for( $ki ) { | ||||
| 341 | 15 | 79 | s/\-+/-/g; | ||||
| 342 | 15 | 54 | s/,+/,/g; | ||||
| 343 | } | ||||||
| 344 | 15 | 52 | $columns->[$j]{ki} = $ki; | ||||
| 345 | } | ||||||
| 346 | else { | ||||||
| 347 | 0 | 0 | 0 | 0 | push @logs, "~~> l.$. WARNING#8: ARRAY index is not numeric in %%%V:". $ki if $DEBUG or ! $op->{ignore}; | ||
| 348 | } | ||||||
| 349 | |||||||
| 350 | } | ||||||
| 351 | elsif( $$chkVAR == 0b0010) { # V-variable is in {HASH|ARRAY}.HASH of VAR-structure | ||||||
| 352 | |||||||
| 353 | 35 | 81 | for my $d ( @$vk ) { | ||||
| 354 | 35 | 50 | 110 | if( exists $d->{$ki} ) { | |||
| 355 | 35 | 95 | $columns->[$j]{ki} = $ki; # save variable name in j-th column | ||||
| 356 | 35 | 150 | last; | ||||
| 357 | } | ||||||
| 358 | } | ||||||
| 359 | } | ||||||
| 360 | elsif( $$chkVAR == 0b0100 or $$chkVAR == 0b01000 ) { # V-variable is SCALAR (or REF->SCALAR) in regular ARRAY of VAR-structure | ||||||
| 361 | |||||||
| 362 | 15 | 100 | 33 | 101 | if( $ki eq '@') { | ||
| 100 | 66 | ||||||
| 100 | |||||||
| 363 | 5 | 13 | $ki = '0-'; # ALL elements | ||||
| 364 | 5 | 17 | $columns->[$j]{ki} = $ki; # starting index (unnamed meaning) | ||||
| 365 | } | ||||||
| 366 | elsif( $ki =~/^\-*(\d+)$/ && ($1 < @$vk or ($ki < 0 && $1 == @$vk)) ) { | ||||||
| 367 | # specific indices, e.g.: 0 or 3 or -1 | ||||||
| 368 | 4 | 15 | $columns->[$j]{ki} = $ki; | ||||
| 369 | } | ||||||
| 370 | elsif( $ki =~/^[\d,\-]+$/) { | ||||||
| 371 | # mixed indexes, e.g.: 1-3,6-7-9,-,4,-5,0,7- or 3- (i.e. 3..arr_end) or 0-5 (0..5) or -1- (-1,-2,..arr_start) | ||||||
| 372 | 5 | 14 | for( $ki ) { | ||||
| 373 | 5 | 28 | s/\-+/-/g; | ||||
| 374 | 5 | 24 | s/,+/,/g; | ||||
| 375 | } | ||||||
| 376 | 5 | 15 | $columns->[$j]{ki} = $ki; | ||||
| 377 | } | ||||||
| 378 | |||||||
| 379 | } | ||||||
| 380 | elsif( ref $vk eq 'HASH' | ||||||
| 381 | and ( (ref \$vk->{$ki} eq 'SCALAR' and defined( $vk->{$ki} ) ) | ||||||
| 382 | or ( ref $vk->{$ki} eq 'SCALAR' and defined( ${ $vk->{$ki} } ) ) | ||||||
| 383 | or ( $ki eq '@' | ||||||
| 384 | and exists($vk->{$ki}) | ||||||
| 385 | and ref $vk->{$ki} eq 'ARRAY' | ||||||
| 386 | ) | ||||||
| 387 | ) | ||||||
| 388 | ) { | ||||||
| 389 | 24 | 71 | $columns->[$j]{ki} = $ki; # save variable key in j-th element | ||||
| 390 | } | ||||||
| 391 | |||||||
| 392 | 112 | 100 | 434 | &_set_column( $Np, $paste, $columns->[$j] ) if exists $columns->[$j]{ki}; | |||
| 393 | } | ||||||
| 394 | elsif( $$z =~/(? %?)/ |
||||||
| 395 | or $$z =~/^\s*%%%+ADD(? %?)\s?(? |
||||||
| 396 | ) { | ||||||
| 397 | 173 | 1129 | my $s = $+{s}; | ||||
| 398 | |||||||
| 399 | 173 | 100 | 880 | if( $+{p} ) { | |||
| 400 | 45 | 100 | 128 | length($s) or return; | |||
| 401 | } | ||||||
| 402 | else { | ||||||
| 403 | 128 | 312 | $s .= "\n"; | ||||
| 404 | } | ||||||
| 405 | |||||||
| 406 | 172 | 100 | 759 | if( $+{t} eq 'E') { # %%%ADDE: | |||
| 407 | 23 | 50 | 33 | 162 | if( @$columns && exists( $columns->[-1]{ki} ) && (! $columns->[$j] or $sclr) ) { | ||
| 66 | |||||||
| 33 | |||||||
| 408 | 23 | 42 | push @{ $columns->[-1]{tail} }, $s; | ||||
| 23 | 90 | ||||||
| 409 | } | ||||||
| 410 | else { | ||||||
| 411 | 0 | 0 | push @{ $columns->[$j]{head} }, $s; | ||||
| 0 | 0 | ||||||
| 412 | } | ||||||
| 413 | } | ||||||
| 414 | else { | ||||||
| 415 | 149 | 286 | push @{ $columns->[$j]{head} }, $s; | ||||
| 149 | 712 | ||||||
| 416 | 149 | 100 | 100 | 1007 | $columns->[$j]{eX}{ $#{ $columns->[$j]{head} } } = undef if ! $sclr and $+{t} eq 'X'; # $$chkVAR && ... %%%ADDX: | ||
| 33 | 176 | ||||||
| 417 | } | ||||||
| 418 | } | ||||||
| 419 | |||||||
| 420 | 286 | 1245 | return; | ||||
| 421 | } | ||||||
| 422 | else { | ||||||
| 423 | 0 | 0 | return; | ||||
| 424 | } | ||||||
| 425 | |||||||
| 426 | } | ||||||
| 427 | elsif( $$z =~/%%%+END(? |
||||||
| 428 | |||||||
| 429 | # Clear the VAR-structure for the next external variable | ||||||
| 430 | 38 | 88 | $$chkVAR = 0; | ||||
| 431 | 38 | 70 | undef $$key; | ||||
| 432 | 38 | 78 | @$columns = (); | ||||
| 433 | |||||||
| 434 | 38 | 100 | 434 | return 1 if $+{t} eq 'T'; # end of template area --> Exit template | |||
| 435 | |||||||
| 436 | 32 | 100 | 178 | undef $$tdz if $+{t} eq 'Z'; # End of TDZ | |||
| 437 | 32 | 123 | return; | ||||
| 438 | } | ||||||
| 439 | |||||||
| 440 | 586 | 100 | 1675 | $$tdz = 1 if $$z =~s/^\s*%%%+TDZ:\s?[\r\n]*//; # The Dead Zone | |||
| 441 | |||||||
| 442 | 586 | 100 | 1349 | if( $$tdz ) { # The Dead Zone is ON | |||
| 443 | 124 | 100 | 304 | if( length $$z ) {# Output TeX | |||
| 444 | 116 | 244 | print { $fh } $$z; | ||||
| 116 | 345 | ||||||
| 445 | 116 | 212 | ++$nlo; | ||||
| 446 | } | ||||||
| 447 | 124 | 365 | return; | ||||
| 448 | } | ||||||
| 449 | |||||||
| 450 | 462 | 100 | 2322 | if( $$z =~/(.*?)\s?%%%+VAR:\s*([^\s:%#]+)(%?)\s?(.*)/) { | |||
| 50 | |||||||
| 100 | |||||||
| 451 | 86 | 264 | my $before = $1; | ||||
| 452 | 86 | 199 | my $k = $2; # name (key) | ||||
| 453 | 86 | 201 | my $Np = $3; # NO \par | ||||
| 454 | 86 | 219 | my $paste = $4; # on right text for SCALAR only | ||||
| 455 | |||||||
| 456 | # root or global structure (environment) | ||||||
| 457 | 86 | 100 | 255 | my $vd = ( $k =~s/^\/+//) ? $info : $$data; | |||
| 458 | |||||||
| 459 | 86 | 156 | my $x; # for unknown/undefined sub-key | ||||
| 460 | |||||||
| 461 | # Search nested sub-keys | ||||||
| 462 | 86 | 285 | for my $sk ( split '/', $k ) { | ||||
| 463 | 87 | 197 | $$vardata = $vd; | ||||
| 464 | 87 | 50 | 232 | length( $sk ) or next; | |||
| 465 | |||||||
| 466 | 87 | 100 | 66 | 687 | if( $sk =~/^\d+$/ && ref $vd eq 'ARRAY' and defined( $vd->[$sk] )) { | ||
| 100 | 66 | ||||||
| 66 | |||||||
| 467 | 3 | 100 | 9 | last if &_data_redef( $sk, $vd->[$sk], \$k, \$vd, \$x ); | |||
| 468 | } | ||||||
| 469 | elsif( ref $vd eq 'HASH' and exists( $vd->{$sk} )) { | ||||||
| 470 | 69 | 100 | 218 | last if &_data_redef( $sk, $vd->{$sk}, \$k, \$vd, \$x ); | |||
| 471 | } | ||||||
| 472 | else { | ||||||
| 473 | 15 | 35 | $x = $sk; | ||||
| 474 | 15 | 31 | last; | ||||
| 475 | } | ||||||
| 476 | } | ||||||
| 477 | |||||||
| 478 | # Clear the VAR-structure for a new variable | ||||||
| 479 | 86 | 191 | $$chkVAR = 0; | ||||
| 480 | 86 | 174 | undef $$key; | ||||
| 481 | 86 | 170 | @$columns = (); | ||||
| 482 | |||||||
| 483 | 86 | 100 | 206 | if( $x ) { | |||
| 484 | 15 | 100 | 100 | 101 | push @logs, "~~> l.$. WARNING#2: unknown or undef ARRAY|HASH|SCALAR|REF.SCALAR of sub-key '$x' in %%%VAR:". $k if $DEBUG or ! $op->{ignore}; | ||
| 485 | |||||||
| 486 | 15 | 31 | $$vardata = $$data; | ||||
| 487 | 15 | 28 | print { $fh } $$z; | ||||
| 15 | 34 | ||||||
| 488 | 15 | 27 | ++$nlo; | ||||
| 489 | 15 | 52 | return; | ||||
| 490 | } | ||||||
| 491 | |||||||
| 492 | # key or sub-...sub-key is found | ||||||
| 493 | 71 | 100 | 209 | push @logs, "--> l.$. Found %%%VAR:". $k if $DEBUG; | |||
| 494 | |||||||
| 495 | 71 | 50 | 225 | my $vk = ref $$vardata eq 'HASH' ? $$vardata->{$k} : | |||
| 100 | |||||||
| 496 | (ref $$vardata eq 'ARRAY' ? $$vardata->[$k] : undef); | ||||||
| 497 | |||||||
| 498 | 71 | 50 | 213 | unless( $vk ) { | |||
| 499 | 0 | 0 | 0 | 0 | push @logs, "~~> l.$. NOT defined key in %%%VAR:". $k if $DEBUG && $op->{def}; | ||
| 500 | 0 | 0 | return; | ||||
| 501 | } | ||||||
| 502 | |||||||
| 503 | 71 | 100 | 239 | return if &_chk_var( $fh, $k, $vk, $Np, \$paste, \$before, $chkVAR, $columns, $z, $op ); | |||
| 504 | |||||||
| 505 | # push @logs, "--> l.$. Remember key = '$k' (chkVAR=$$chkVAR), type: ".ref($vk) if $DEBUG; ###AG | ||||||
| 506 | |||||||
| 507 | 70 | 159 | $$key = $k; # save key name | ||||
| 508 | 70 | 249 | return; | ||||
| 509 | |||||||
| 510 | } | ||||||
| 511 | elsif( $$z =~/%%%V:\s*=(def|esc|ignore|silent|debug)=\s*(\S*)/) { # setting up facultative options | ||||||
| 512 | 0 | 0 | 0 | $op->{$1} = $2 || 0; | |||
| 513 | 0 | 0 | return; | ||||
| 514 | } | ||||||
| 515 | elsif( $$z =~/%%%V:\s*(? %?)\s?(? |
||||||
| 516 | 48 | 283 | my $k = $+{k}; | ||||
| 517 | |||||||
| 518 | 48 | 126 | my %el; | ||||
| 519 | 48 | 233 | &_set_column( $+{p}, $+{s}, \%el ); | ||||
| 520 | |||||||
| 521 | 48 | 127 | my $inidata = $$data; # save initial environment | ||||
| 522 | |||||||
| 523 | 48 | 100 | 178 | if( $k =~s/^\/+//) { | |||
| 524 | 7 | 19 | $$data = $info; # reset to root environment | ||||
| 525 | |||||||
| 526 | 7 | 100 | 30 | length($k) or return; | |||
| 527 | } | ||||||
| 528 | |||||||
| 529 | # Search nested sub-keys | ||||||
| 530 | 44 | 85 | my $x = 0; # for unknown sub-key | ||||
| 531 | 44 | 133 | for my $sk ( split '/', $k ) { | ||||
| 532 | 51 | 50 | 146 | length( $sk ) or next; | |||
| 533 | |||||||
| 534 | 51 | 86 | my $d; | ||||
| 535 | 51 | 100 | 100 | 411 | if( $sk =~/^\d+$/ && ref $$data eq 'ARRAY' && defined( $$data->[$sk] )) { | ||
| 100 | 66 | ||||||
| 66 | |||||||
| 536 | 6 | 15 | $d = $$data->[$sk]; | ||||
| 537 | } | ||||||
| 538 | elsif( ref $$data eq 'HASH' && exists( $$data->{$sk} )) { | ||||||
| 539 | 15 | 41 | $d = $$data->{$sk}; | ||||
| 540 | } | ||||||
| 541 | else { | ||||||
| 542 | 30 | 100 | 100 | 195 | push @logs, "~~> l.$. WARNING#3: unknown sub-key '$sk' in %%%V:". $k if $DEBUG or ! $op->{ignore}; | ||
| 543 | |||||||
| 544 | 30 | 58 | print { $fh } $$z; | ||||
| 30 | 64 | ||||||
| 545 | 30 | 58 | ++$nlo; | ||||
| 546 | |||||||
| 547 | 30 | 58 | $x = 1; | ||||
| 548 | 30 | 62 | last; | ||||
| 549 | } | ||||||
| 550 | |||||||
| 551 | # Check type | ||||||
| 552 | 21 | 100 | 100 | 158 | if( (ref $d eq 'ARRAY' or ref $d eq 'HASH') ) { | ||
| 553 | 9 | 20 | $$data = $d; # sub-key (path) found: redefined | ||||
| 554 | 9 | 22 | next; | ||||
| 555 | } | ||||||
| 556 | |||||||
| 557 | 12 | 24 | my $v; | ||||
| 558 | 12 | 100 | 46 | if( ref \$d eq 'SCALAR') { | |||
| 100 | |||||||
| 559 | 10 | 22 | $v = $d; | ||||
| 560 | } | ||||||
| 561 | elsif( ref $d eq 'SCALAR') { # REF->SCALAR | ||||||
| 562 | 1 | 4 | $v = $$d; | ||||
| 563 | } | ||||||
| 564 | else { | ||||||
| 565 | 1 | 50 | 33 | 15 | push @logs, "~~> l.$. WARNING#4: wrong type (not SCALAR|ARRAY|HASH) of '$sk' in %%%V:". $k if $DEBUG or ! $op->{ignore}; | ||
| 566 | |||||||
| 567 | 1 | 4 | print { $fh } $$z; | ||||
| 1 | 4 | ||||||
| 568 | 1 | 3 | ++$nlo; | ||||
| 569 | |||||||
| 570 | 1 | 3 | $x = 1; | ||||
| 571 | 1 | 4 | last; | ||||
| 572 | } | ||||||
| 573 | |||||||
| 574 | 11 | 52 | &_v_print( $fh, $k, $v, \%el, $op ); | ||||
| 575 | |||||||
| 576 | 11 | 23 | $x = 1; | ||||
| 577 | 11 | 27 | last; | ||||
| 578 | } | ||||||
| 579 | |||||||
| 580 | 44 | 100 | 125 | $$data = $inidata if $x; # value found or unknown sub-key: reset to initial environment | |||
| 581 | |||||||
| 582 | 44 | 153 | return; | ||||
| 583 | } | ||||||
| 584 | |||||||
| 585 | 328 | 586 | print { $fh } $$z; | ||||
| 328 | 1416 | ||||||
| 586 | 328 | 585 | ++$nlo; | ||||
| 587 | |||||||
| 588 | 328 | 1104 | return; | ||||
| 589 | } | ||||||
| 590 | |||||||
| 591 | |||||||
| 592 | sub _set_column { | ||||||
| 593 | 179 | 179 | 652 | my( $Np, $paste, $column ) = @_; | |||
| 594 | |||||||
| 595 | 179 | 100 | 525 | $column->{'%'} = 1 if $Np; | |||
| 596 | 179 | 100 | 537 | $column->{p} = $paste if length $paste; | |||
| 597 | } | ||||||
| 598 | |||||||
| 599 | sub _data_redef { | ||||||
| 600 | 72 | 72 | 212 | my( $sk, $d, $k, $data, $x ) = @_; | |||
| 601 | |||||||
| 602 | 72 | 100 | 100 | 274 | if( ref $d eq 'ARRAY' or ref $d eq 'HASH') { | ||
| 603 | 46 | 101 | $$data = $d; # redefined for %%%VAR: | ||||
| 604 | 46 | 181 | return 0; | ||||
| 605 | } | ||||||
| 606 | |||||||
| 607 | 26 | 50 | 66 | 95 | if( ref \$d eq 'SCALAR' or ref $d eq 'SCALAR') { | ||
| 608 | 26 | 56 | $$k = $sk; | ||||
| 609 | } | ||||||
| 610 | else { | ||||||
| 611 | 0 | 0 | $$x = $sk; | ||||
| 612 | } | ||||||
| 613 | 26 | 93 | return 1; | ||||
| 614 | } | ||||||
| 615 | |||||||
| 616 | sub _chk_var { | ||||||
| 617 | 71 | 71 | 287 | my( $fh, $k, $vk, $Np, $paste, $before, $chkVAR, $columns, $z, $op ) = @_; | |||
| 618 | |||||||
| 619 | 71 | 146 | our $DEBUG; | ||||
| 620 | 71 | 138 | our @logs; | ||||
| 621 | 71 | 121 | our $nlo; | ||||
| 622 | |||||||
| 623 | 71 | 100 | 100 | 263 | if( ref $vk eq 'ARRAY') { | ||
| 100 | |||||||
| 624 | |||||||
| 625 | 36 | 100 | 63 | if( @{ $vk } ) { | |||
| 36 | 96 | ||||||
| 626 | # Check ARRAY.{ARRAY|HASH|SCALAR[.REF]} | ||||||
| 627 | |||||||
| 628 | 35 | 85 | for my $d ( @{ $vk } ) { | ||||
| 35 | 96 | ||||||
| 629 | 127 | 100 | 375 | if(ref $d eq 'ARRAY'){ | |||
| 100 | |||||||
| 100 | |||||||
| 50 | |||||||
| 630 | 35 | 77 | $$chkVAR |= 0b00001; | ||||
| 631 | } | ||||||
| 632 | elsif(ref $d eq 'HASH') { | ||||||
| 633 | 22 | 54 | $$chkVAR |= 0b00010; | ||||
| 634 | } | ||||||
| 635 | elsif(ref \$d eq 'SCALAR') { | ||||||
| 636 | 66 | 141 | $$chkVAR |= 0b00100; | ||||
| 637 | } | ||||||
| 638 | elsif(ref $d eq 'SCALAR') { # REF->SCALAR | ||||||
| 639 | 4 | 9 | $$chkVAR |= 0b01000; | ||||
| 640 | } | ||||||
| 641 | else { | ||||||
| 642 | 0 | 0 | $$chkVAR |= 0b10000; | ||||
| 643 | } | ||||||
| 644 | } | ||||||
| 645 | } | ||||||
| 646 | else { | ||||||
| 647 | 1 | 3 | $$chkVAR |= 0b00100; # by default, SCALAR | ||||
| 648 | } | ||||||
| 649 | |||||||
| 650 | 36 | 100 | 66 | 258 | if( ! $$chkVAR or $$chkVAR > 0b01000 or ($$chkVAR & ($$chkVAR - 1)) ) { | ||
| 66 | |||||||
| 651 | 1 | 50 | 33 | 13 | push @logs, "~~> l.$. WARNING#6: mixed types (ARRAY with HASH with SCALAR or other) of %%%VAR:". $k if $DEBUG or ! $op->{ignore}; | ||
| 652 | |||||||
| 653 | 1 | 3 | print { $fh } $$z; | ||||
| 1 | 4 | ||||||
| 654 | 1 | 3 | ++$nlo; | ||||
| 655 | 1 | 6 | return 1; | ||||
| 656 | } | ||||||
| 657 | } | ||||||
| 658 | elsif( ref \$vk eq 'SCALAR' or ref $vk eq 'SCALAR') { | ||||||
| 659 | 26 | 96 | $columns->[0]{ki} = $k; | ||||
| 660 | 26 | 94 | &_set_column( $Np, $$paste, $columns->[0] ); | ||||
| 661 | } | ||||||
| 662 | |||||||
| 663 | 70 | 100 | 192 | if( $$before ) {# Output prefix TeX | |||
| 664 | 13 | 39 | print { $fh } $$before; | ||||
| 13 | 61 | ||||||
| 665 | # ++$nlo; | ||||||
| 666 | } | ||||||
| 667 | |||||||
| 668 | 70 | 225 | return 0; | ||||
| 669 | } | ||||||
| 670 | |||||||
| 671 | # VALUE output | ||||||
| 672 | sub _v_print { | ||||||
| 673 | 418 | 418 | 1186 | my( $fh, $k, $v, $el, $op ) = @_; | |||
| 674 | 418 | 100 | 1072 | $v = $$v if ref $v eq 'SCALAR'; | |||
| 675 | |||||||
| 676 | 418 | 714 | our $DEBUG; | ||||
| 677 | 418 | 718 | our @logs; | ||||
| 678 | 418 | 776 | our $nlo; | ||||
| 679 | |||||||
| 680 | 418 | 100 | 953 | if( defined $v ) { | |||
| 681 | 378 | 100 | 1017 | tex_escape( $v, $op->{esc} ) if $op->{esc}; | |||
| 682 | |||||||
| 683 | 378 | 100 | 960 | push @logs, "--> l.$.>$nlo".' Insert %%%V[AR]:'. $k .'= '. $v if $DEBUG; | |||
| 684 | |||||||
| 685 | 378 | 679 | print { $fh } $v; | ||||
| 378 | 1756 | ||||||
| 686 | 378 | 100 | 1199 | print { $fh } $el->{p} if exists $el->{p}; | |||
| 10 | 71 | ||||||
| 687 | |||||||
| 688 | 378 | 1235 | ++$nlo while $v =~/\n/g; | ||||
| 689 | |||||||
| 690 | 378 | 100 | 1113 | return if $el->{'%'}; | |||
| 691 | |||||||
| 692 | 252 | 467 | print { $fh } "\n"; # NO:YES \par | ||||
| 252 | 821 | ||||||
| 693 | 252 | 630 | ++$nlo; | ||||
| 694 | } | ||||||
| 695 | else { | ||||||
| 696 | 40 | 50 | 66 | 143 | push @logs, "~~> l.$.".' NOT defined %%%V[AR]:'. $k if $DEBUG && $op->{def}; | ||
| 697 | } | ||||||
| 698 | |||||||
| 699 | } | ||||||
| 700 | |||||||
| 701 | # HEAD-TAIL output | ||||||
| 702 | sub _ht_print { | ||||||
| 703 | 814 | 814 | 2044 | my( $fh, $el, $ht, $border ) = @_; | |||
| 704 | |||||||
| 705 | 814 | 100 | 2462 | $el->{$ht} or return; | |||
| 706 | |||||||
| 707 | 401 | 752 | our $DEBUG; | ||||
| 708 | 401 | 691 | our @logs; | ||||
| 709 | 401 | 713 | our $nlo; | ||||
| 710 | |||||||
| 711 | 401 | 721 | my $i = 0; | ||||
| 712 | 401 | 712 | foreach( @{ $el->{$ht} } ) { | ||||
| 401 | 1152 | ||||||
| 713 | 490 | 100 | 100 | 1985 | next if $ht eq 'head' and $border && exists( $el->{eX} ) && exists( $el->{eX}{$i} ); | ||
| 100 | |||||||
| 100 | |||||||
| 714 | |||||||
| 715 | 457 | 100 | 1183 | push @logs, "-->\tl.$.>$nlo Insert $ht: ". $_ if $DEBUG; | |||
| 716 | |||||||
| 717 | 457 | 838 | print { $fh } $_; | ||||
| 457 | 2801 | ||||||
| 718 | 457 | 998 | ++$nlo; | ||||
| 719 | } | ||||||
| 720 | continue { | ||||||
| 721 | 490 | 1274 | ++$i; | ||||
| 722 | } | ||||||
| 723 | |||||||
| 724 | } | ||||||
| 725 | |||||||
| 726 | # HEAD-VALUE-TAIL output | ||||||
| 727 | sub _hvt_print { | ||||||
| 728 | 411 | 411 | 1148 | my( $fh, $ki, $val, $el, $op, $border ) = @_; | |||
| 729 | |||||||
| 730 | 411 | 3246 | our $DEBUG; | ||||
| 731 | 411 | 687 | our @logs; | ||||
| 732 | 411 | 4428 | our $nlo; | ||||
| 733 | |||||||
| 734 | 411 | 100 | 100 | 6732 | if( length($ki) and ! defined $val ) { | ||
| 735 | 4 | 50 | 66 | 19 | push @logs, "~~> l.$.".' NOT defined %%%V:'. $ki if $DEBUG && $op->{def}; | ||
| 736 | 4 | 12 | return; | ||||
| 737 | } | ||||||
| 738 | |||||||
| 739 | # output head of variable | ||||||
| 740 | 407 | 3235 | &_ht_print( $fh, $el, 'head', $border ); | ||||
| 741 | |||||||
| 742 | # output value of variable | ||||||
| 743 | 407 | 1173 | &_v_print; # ( $fh, $ki, $val, $el, $op ); | ||||
| 744 | |||||||
| 745 | # output tail of variable | ||||||
| 746 | 407 | 912 | &_ht_print( $fh, $el, 'tail', 0); | ||||
| 747 | } | ||||||
| 748 | |||||||
| 749 | |||||||
| 750 | sub _s_a_prn { | ||||||
| 751 | 197 | 197 | 542 | my( $fh, $i, $values, $el, $op, $border, $col ) = @_; | |||
| 752 | |||||||
| 753 | 197 | 417 | my $val = $values->[$i]; | ||||
| 754 | 197 | 100 | 478 | $val = $$val if ref $val eq 'SCALAR'; | |||
| 755 | |||||||
| 756 | 197 | 100 | 482 | if( ref \$val eq 'SCALAR') { | |||
| 50 | |||||||
| 757 | 195 | 592 | &_hvt_print( $fh, $i, $val, $el, $op, $$border ); | ||||
| 758 | 195 | 352 | ++$$col; | ||||
| 759 | 195 | 831 | $$border = 0; | ||||
| 760 | } | ||||||
| 761 | elsif( ref $val eq 'ARRAY') { # [...].ARRAY.ARRAY | ||||||
| 762 | 2 | 5 | for( @$val ) { | ||||
| 763 | 17 | 50 | 48 | next if ref \$_ ne 'SCALAR'; | |||
| 764 | |||||||
| 765 | 17 | 52 | &_hvt_print( $fh, $i, $_, $el, $op, $$border ); | ||||
| 766 | 17 | 34 | ++$$col; | ||||
| 767 | 17 | 43 | $$border = 0; | ||||
| 768 | } | ||||||
| 769 | } | ||||||
| 770 | |||||||
| 771 | } | ||||||
| 772 | |||||||
| 773 | |||||||
| 774 | sub _mixed_indices { | ||||||
| 775 | 123 | 123 | 359 | my( $fh, $ki, $values, $el, $op, $border ) = @_; | |||
| 776 | |||||||
| 777 | 123 | 263 | my $nd = @$values; | ||||
| 778 | 123 | 215 | my $col = 0; | ||||
| 779 | |||||||
| 780 | 123 | 446 | for my $ii ( split ',', $ki ) { # e.g. -1-,1-3,6-7-9,-,4,-5,0,7- | ||||
| 781 | 139 | 100 | 355 | next if $ii eq '-'; | |||
| 782 | |||||||
| 783 | 138 | 100 | 381 | if( $ii =~/^(\-[1-9]\d*)\-(\d*)$/) { # -1- i.e. reverse: -1,-2,..-@arr (i.e. arr_start) | |||
| 784 | 12 | 39 | my $s = $1; | ||||
| 785 | 12 | 66 | 62 | my $e = -1*($2 || $nd); | |||
| 786 | 12 | 100 | 62 | $s = -1*$nd if abs($s) > $nd; | |||
| 787 | 12 | 100 | 50 | $e = -1*$nd if abs($e) > $nd; | |||
| 788 | 12 | 100 | 54 | ($s, $e) = ($e, $s) if $e > $s; | |||
| 789 | |||||||
| 790 | 12 | 42 | for( my $i = $s; $i >= $e; --$i ) { | ||||
| 791 | 38 | 132 | &_s_a_prn( $fh, $i, $values, $el, $op, \$border, \$col ); | ||||
| 792 | } | ||||||
| 793 | 12 | 38 | next; | ||||
| 794 | } | ||||||
| 795 | |||||||
| 796 | 126 | 100 | 323 | if( $ii =~/^\-[0-9]+$/ ) { # -5 | |||
| 797 | 1 | 5 | my $i = $ii+0; | ||||
| 798 | |||||||
| 799 | 1 | 50 | 6 | if( abs($i) <= $nd ) { | |||
| 800 | 1 | 4 | &_s_a_prn( $fh, $i, $values, $el, $op, \$border, \$col ); | ||||
| 801 | } | ||||||
| 802 | 1 | 3 | next; | ||||
| 803 | } | ||||||
| 804 | |||||||
| 805 | 125 | 422 | my @n = grep{length} sort{$a <=> $b} split '-', $ii; | ||||
| 126 | 481 | ||||||
| 1 | 6 | ||||||
| 806 | |||||||
| 807 | 125 | 100 | 66 | 609 | if( @n < 2 and $n[0] < $nd ) { # e.g. 4 || 0 || 7(-) | ||
| 808 | 124 | 100 | 327 | if( $ii =~/\-$/) { # 7(-) | |||
| 809 | |||||||
| 810 | 17 | 60 | for( my $i = $n[0]; $i < $nd; ++$i ) { | ||||
| 811 | 49 | 129 | &_s_a_prn( $fh, $i, $values, $el, $op, \$border, \$col ); | ||||
| 812 | } | ||||||
| 813 | |||||||
| 814 | } | ||||||
| 815 | else { # 4 || 0 | ||||||
| 816 | 107 | 293 | &_s_a_prn( $fh, $n[0], $values, $el, $op, \$border, \$col ); | ||||
| 817 | } | ||||||
| 818 | |||||||
| 819 | } | ||||||
| 820 | else { # 1-3 ->(1..3) || 6-7-9 ->(6..9) | ||||||
| 821 | 1 | 6 | for( my $i = $n[0]; $i <= $n[-1]; ++$i ) { | ||||
| 822 | 2 | 8 | &_s_a_prn( $fh, $i, $values, $el, $op, \$border, \$col ); | ||||
| 823 | } | ||||||
| 824 | } | ||||||
| 825 | |||||||
| 826 | } | ||||||
| 827 | |||||||
| 828 | 123 | 537 | return $col; | ||||
| 829 | } | ||||||
| 830 | |||||||
| 831 | |||||||
| 832 | sub _var_output { | ||||||
| 833 | 70 | 70 | 233 | my( $fh, $key, $vardata, $columns, $op ) = @_; | |||
| 834 | 70 | 100 | 248 | my $values = (ref $vardata eq 'HASH') ? $vardata->{ $key } : $vardata->[ $key ]; | |||
| 835 | |||||||
| 836 | 70 | 50 | 191 | @$columns or return; | |||
| 837 | |||||||
| 838 | 70 | 116 | our $DEBUG; | ||||
| 839 | 70 | 111 | our @logs; | ||||
| 840 | 70 | 116 | our $nlo; | ||||
| 841 | |||||||
| 842 | 70 | 100 | 100 | 331 | if( ref \$values eq 'SCALAR' or ref $values eq 'SCALAR') { # key => SCALAR | ||
| 843 | 26 | 112 | &_hvt_print( $fh, $key, $values, $columns->[0], $op ); | ||||
| 844 | 26 | 67 | return; | ||||
| 845 | } | ||||||
| 846 | |||||||
| 847 | 44 | 100 | 206 | if( ref $values eq 'ARRAY') { # key => ARRAY | |||
| 50 | |||||||
| 848 | |||||||
| 849 | 35 | 100 | 93 | unless( @$values ) { | |||
| 850 | 1 | 50 | 33 | 12 | push @logs, "~~> l.$. WARNING#7: empty ARRAY of %%%VAR:". $key if $DEBUG or ! $op->{ignore}; | ||
| 851 | 1 | 3 | return; | ||||
| 852 | } | ||||||
| 853 | |||||||
| 854 | # Forming a table | ||||||
| 855 | 34 | 64 | my $row = 0; | ||||
| 856 | 34 | 67 | my $nd = @$values; | ||||
| 857 | |||||||
| 858 | _var_output_M0: | ||||||
| 859 | 34 | 87 | foreach my $d ( @$values ) { # loop through table rows | ||||
| 860 | |||||||
| 861 | 89 | 100 | 261 | push @logs, '--> Table row = '. $row if $DEBUG; | |||
| 862 | |||||||
| 863 | 89 | 177 | my $col = 0; | ||||
| 864 | 89 | 201 | foreach my $el ( @$columns ) { # loop through table columns (for ARRAY.HASH) or rows (for ARRAY.SCALAR) | ||||
| 865 | |||||||
| 866 | 260 | 598 | my $ki = $el->{ki}; | ||||
| 867 | 260 | 100 | 100 | 949 | my $border = ((! $row and ! $col) or ($row >= $#{ $values } and (!defined( $ki ) or !length( $ki )) ) ) ? 1 : 0; | ||
| 868 | |||||||
| 869 | 260 | 482 | my $val; | ||||
| 870 | 260 | 100 | 554 | if( defined $ki ) { | |||
| 871 | 223 | 100 | 100 | 1292 | if( ref \$d eq 'SCALAR' or ref $d eq 'SCALAR') { # (ARRAY.SCALAR or ARRAY.REF->SCALAR) in regular vector | ||
| 100 | 66 | ||||||
| 50 | |||||||
| 0 | |||||||
| 872 | |||||||
| 873 | 25 | 50 | 131 | if( $ki =~/^[\d,\-]+$/) { | |||
| 874 | # mixed indices, e.g.: 1-3,6-7-9,-,4,-5,0,7- or 3- (i.e. 3..arr_end) or 0-5 (0..5) or -1- (-1,-2,..arr_start) | ||||||
| 875 | 25 | 100 | 112 | last _var_output_M0 if $row; | |||
| 876 | |||||||
| 877 | 14 | 50 | 38 | if( $_ = &_mixed_indices( $fh, $ki, $values, $el, $op, $border ) ) { | |||
| 878 | 14 | 32 | $col += $_ - 1; | ||||
| 879 | } | ||||||
| 880 | } | ||||||
| 881 | 14 | 36 | next; | ||||
| 882 | } | ||||||
| 883 | elsif( ref $d eq 'HASH' and defined( $d->{$ki} ) ) { # ARRAY.HASH | ||||||
| 884 | 89 | 221 | $val = $d->{$ki}; | ||||
| 885 | |||||||
| 886 | 89 | 100 | 348 | if( ref $val eq 'ARRAY') { # ARRAY.HASH.ARRAY | |||
| 50 | |||||||
| 887 | 2 | 7 | for my $vv ( @$val ) { | ||||
| 888 | 14 | 50 | 37 | next unless ref \$vv eq 'SCALAR'; | |||
| 889 | |||||||
| 890 | 14 | 43 | &_hvt_print( $fh, $ki, $vv, $el, $op, $border ); | ||||
| 891 | 14 | 27 | ++$col; | ||||
| 892 | } | ||||||
| 893 | 2 | 8 | next; | ||||
| 894 | } | ||||||
| 895 | elsif( ref \$val ne 'SCALAR') { # TODO for REF | ||||||
| 896 | 0 | 0 | next; | ||||
| 897 | } | ||||||
| 898 | } | ||||||
| 899 | elsif( ref $d eq 'ARRAY') { # ARRAY.ARRAY | ||||||
| 900 | |||||||
| 901 | 109 | 50 | 635 | if( $ki =~/^[\d,\-]+$/) { | |||
| 902 | # mixed indices, e.g.: 1-3,6-7-9,-,4,-5,0,7- or 3- (i.e. 3..arr_end) or 0-5 (0..5) or -1- (-1,-2,..arr_start) | ||||||
| 903 | 109 | 50 | 264 | $_ = &_mixed_indices( $fh, $ki, $d, $el, $op, $border ) and $col += $_ - 1; | |||
| 904 | } | ||||||
| 905 | |||||||
| 906 | 109 | 260 | next; | ||||
| 907 | } | ||||||
| 908 | elsif( $op->{def} ) { | ||||||
| 909 | |||||||
| 910 | 0 | 0 | 0 | push @logs, "~~> l.$. NOT defined %%%V:". $ki if $DEBUG; | |||
| 911 | |||||||
| 912 | 0 | 0 | next; | ||||
| 913 | } | ||||||
| 914 | } | ||||||
| 915 | else { | ||||||
| 916 | # empty parameter -- at the very end of the columns (parameters) | ||||||
| 917 | 37 | 89 | $ki = ''; | ||||
| 918 | } | ||||||
| 919 | |||||||
| 920 | 124 | 361 | &_hvt_print( $fh, $ki, $val, $el, $op, $border ); | ||||
| 921 | } | ||||||
| 922 | continue { | ||||||
| 923 | 249 | 545 | ++$col; | ||||
| 924 | } | ||||||
| 925 | } | ||||||
| 926 | continue { | ||||||
| 927 | 78 | 202 | ++$row; | ||||
| 928 | } | ||||||
| 929 | |||||||
| 930 | } | ||||||
| 931 | elsif( ref $values eq 'HASH') { | ||||||
| 932 | |||||||
| 933 | 9 | 19 | my $col = 0; | ||||
| 934 | 9 | 27 | foreach my $el ( @$columns ) { # loop through parameters of %%%VAR-structure | ||||
| 935 | |||||||
| 936 | 27 | 63 | my $ki = $el->{ki}; | ||||
| 937 | 27 | 100 | 100 | 82 | my $border = ( ! $col or ($col >= $#{ $columns } and (!defined( $ki ) or !length( $ki )) )) ? 1 : 0; | ||
| 938 | |||||||
| 939 | 27 | 55 | my $val; | ||||
| 940 | 27 | 100 | 66 | if( defined $ki ) { | |||
| 941 | 24 | 100 | 66 | 138 | if( ref \$values->{$ki} eq 'SCALAR' and defined( $values->{$ki} )) { # HASH.SCALAR | ||
| 100 | 66 | ||||||
| 50 | 33 | ||||||
| 0 | |||||||
| 942 | 21 | 49 | $val = $values->{$ki}; | ||||
| 943 | } | ||||||
| 944 | 1 | 5 | elsif( ref $values->{$ki} eq 'SCALAR' and defined( ${ $values->{$ki} } )) { # HASH.REF->SCALAR | ||||
| 945 | 1 | 3 | $val = ${ $values->{$ki} }; | ||||
| 1 | 3 | ||||||
| 946 | } | ||||||
| 947 | elsif( $ki eq '@' and ref $values->{'@'} eq 'ARRAY') { | ||||||
| 948 | 2 | 4 | for my $k ( @{ $values->{'@'} } ) { | ||||
| 2 | 7 | ||||||
| 949 | 11 | 100 | 66 | 63 | next unless defined($k) && exists( $values->{$k} ); | ||
| 950 | |||||||
| 951 | 10 | 54 | my $v; | ||||
| 952 | 10 | 100 | 38 | if( ref \$values->{$k} eq 'SCALAR') { | |||
| 100 | |||||||
| 50 | |||||||
| 953 | 8 | 17 | $v = $values->{$k}; | ||||
| 954 | } | ||||||
| 955 | elsif( ref $values->{$k} eq 'SCALAR') { | ||||||
| 956 | 1 | 2 | $v = ${ $values->{$k} }; | ||||
| 1 | 4 | ||||||
| 957 | } | ||||||
| 958 | elsif( $op->{def} ) { | ||||||
| 959 | 0 | 0 | 0 | push @logs, "-->\tl.$. ". 'NOT HASH.ARRAY.SCALAR %%%V:@->{'.$k."} in %%%VAR:". $key if $DEBUG; | |||
| 960 | |||||||
| 961 | 0 | 0 | next; | ||||
| 962 | } | ||||||
| 963 | |||||||
| 964 | 10 | 34 | &_hvt_print( $fh, $k, $v, $el, $op, $border ); | ||||
| 965 | 10 | 20 | $border = 0; | ||||
| 966 | } | ||||||
| 967 | 2 | 6 | next; | ||||
| 968 | } | ||||||
| 969 | elsif( $op->{def} ) { | ||||||
| 970 | 0 | 0 | 0 | push @logs, "~~> l.$. NOT HASH.SCALAR or NOT defined %%%V:". $ki if $DEBUG; | |||
| 971 | |||||||
| 972 | 0 | 0 | next; | ||||
| 973 | } | ||||||
| 974 | } | ||||||
| 975 | else { | ||||||
| 976 | # empty parameter -- at the very end of the columns (parameters) | ||||||
| 977 | 3 | 7 | $ki = ''; | ||||
| 978 | } | ||||||
| 979 | |||||||
| 980 | 25 | 61 | &_hvt_print( $fh, $ki, $val, $el, $op, $border ); | ||||
| 981 | } | ||||||
| 982 | continue { | ||||||
| 983 | 27 | 65 | ++$col; | ||||
| 984 | } | ||||||
| 985 | } | ||||||
| 986 | |||||||
| 987 | } | ||||||
| 988 | |||||||
| 989 | 1; | ||||||
| 990 | |||||||
| 991 | __END__ |