| 1 | #!/usr/bin/perl -w |
|---|
| 2 | |
|---|
| 3 | #package: UAM Text Tools |
|---|
| 4 | #component: kon (search context) |
|---|
| 5 | #version: 1.0 |
|---|
| 6 | #author: Justyna Walkowska |
|---|
| 7 | |
|---|
| 8 | use strict; |
|---|
| 9 | use Getopt::Long; |
|---|
| 10 | use locale; |
|---|
| 11 | use File::HomeDir; |
|---|
| 12 | |
|---|
| 13 | Getopt::Long::Configure('no_ignore_case_always'); |
|---|
| 14 | |
|---|
| 15 | my $l='30c'; |
|---|
| 16 | my $r='30c'; |
|---|
| 17 | my $trim=0; |
|---|
| 18 | my $white=0; |
|---|
| 19 | my $bon='[0-9]+ [0-9]+ BOM .*'; |
|---|
| 20 | my $eon='[0-9]+ [0-9]+ EOM .*'; |
|---|
| 21 | my $bod='['; |
|---|
| 22 | my $eod=']'; |
|---|
| 23 | my $column=0; |
|---|
| 24 | my $ignore=0; |
|---|
| 25 | my $help=0; |
|---|
| 26 | |
|---|
| 27 | my $systemconfigfile='/usr/local/etc/utt/kon.conf'; |
|---|
| 28 | #my $userconfigfile="$ENV{'HOME'}/.utt/kon.conf"; |
|---|
| 29 | my $userconfigfile=home()."/.utt/kon.conf"; |
|---|
| 30 | |
|---|
| 31 | #read configuration files########################### |
|---|
| 32 | my $file; |
|---|
| 33 | foreach $file ($systemconfigfile, $userconfigfile){ |
|---|
| 34 | if(open(CONFIG, $file)){ |
|---|
| 35 | while (<CONFIG>) { |
|---|
| 36 | chomp; |
|---|
| 37 | s/#.*//; |
|---|
| 38 | s/^\s+//; |
|---|
| 39 | s/\s+$//; |
|---|
| 40 | next unless length; |
|---|
| 41 | my ($name, $value) = split(/\s*=\s*/, $_, 2); |
|---|
| 42 | if(($name eq "left")or($name eq "l")){ |
|---|
| 43 | $l=$value; |
|---|
| 44 | } |
|---|
| 45 | elsif(($name eq "right")or($name eq "r")){ |
|---|
| 46 | $r=$value; |
|---|
| 47 | } |
|---|
| 48 | elsif(($name eq "trim")or($name eq "t")){ |
|---|
| 49 | $trim=1; |
|---|
| 50 | } |
|---|
| 51 | elsif(($name eq "white")or($name eq "w")){ |
|---|
| 52 | $white=1; |
|---|
| 53 | } |
|---|
| 54 | elsif($name eq "bom"){ |
|---|
| 55 | $bon=$value; |
|---|
| 56 | } |
|---|
| 57 | elsif($name eq "eom"){ |
|---|
| 58 | $eon=$value; |
|---|
| 59 | } |
|---|
| 60 | elsif($name eq "bod"){ |
|---|
| 61 | $bod=$value; |
|---|
| 62 | } |
|---|
| 63 | elsif($name eq "eod"){ |
|---|
| 64 | $eod=$value; |
|---|
| 65 | } |
|---|
| 66 | elsif(($name eq "column")or($name eq "c")){ |
|---|
| 67 | $column=$value; |
|---|
| 68 | } |
|---|
| 69 | elsif(($name eq "ignore")or($name eq "i")){ |
|---|
| 70 | $ignore=1; |
|---|
| 71 | } |
|---|
| 72 | elsif(($name eq "help")or($name eq "h")){ |
|---|
| 73 | $help=1; |
|---|
| 74 | } |
|---|
| 75 | |
|---|
| 76 | } |
|---|
| 77 | close CONFIG; |
|---|
| 78 | } |
|---|
| 79 | } |
|---|
| 80 | ######################################################### |
|---|
| 81 | |
|---|
| 82 | GetOptions("left|l=s" => \$l, |
|---|
| 83 | "right|r=s" => \$r, |
|---|
| 84 | "trim|t" => \$trim, |
|---|
| 85 | "white|w" => \$white, |
|---|
| 86 | "bom=s" => \$bon, |
|---|
| 87 | "eom=s" => \$eon, |
|---|
| 88 | "bod=s" => \$bod, |
|---|
| 89 | "eod=s" => \$eod, |
|---|
| 90 | "column|c=s" => \$column, |
|---|
| 91 | "ignore|i" => \$ignore, |
|---|
| 92 | "help|h" => \$help); |
|---|
| 93 | |
|---|
| 94 | if(!($column=~/^[0-9]+$/)){$column=0;} |
|---|
| 95 | |
|---|
| 96 | if($help) |
|---|
| 97 | { |
|---|
| 98 | print <<'END' |
|---|
| 99 | Options: |
|---|
| 100 | --help -h Help. |
|---|
| 101 | --left -l Left context info (default='30c') |
|---|
| 102 | Examples: |
|---|
| 103 | -l=5c: left context is 5 characters |
|---|
| 104 | -l=5w: left context is 5 words |
|---|
| 105 | -l=5s: left context is 5 non-empty input lines |
|---|
| 106 | -l='\s*\S+\sr\S+BOS': left context starts with the given regex |
|---|
| 107 | --right -r Right context info (default='30c') |
|---|
| 108 | --trim -t Clear incomplete words from output |
|---|
| 109 | --white -w DO NOT change all white characters into spaces |
|---|
| 110 | --column -c Left column minimal width in characters (default = 0) |
|---|
| 111 | --ignore -i Ignore input inconsistency |
|---|
| 112 | --bon Beginning of selected segment |
|---|
| 113 | (regex, default='[0-9]+ [0-9]+ BOM .*') |
|---|
| 114 | --eon End of selected segment |
|---|
| 115 | (regex, default='[0-9]+ [0-9]+ EOM .*') |
|---|
| 116 | --bod Selected segment beginning display (default='[') |
|---|
| 117 | --eod Selected segment end display (default=']') |
|---|
| 118 | |
|---|
| 119 | END |
|---|
| 120 | ; |
|---|
| 121 | exit 0; |
|---|
| 122 | } |
|---|
| 123 | |
|---|
| 124 | |
|---|
| 125 | my $seg_no=0; |
|---|
| 126 | my $seg_size=0; |
|---|
| 127 | |
|---|
| 128 | my $left_type; |
|---|
| 129 | my $left_size; |
|---|
| 130 | my $right_type; |
|---|
| 131 | my $right_size; |
|---|
| 132 | |
|---|
| 133 | set_lr_types($l, $r, \$left_type,\$left_size,\$right_type,\$right_size, $trim); |
|---|
| 134 | |
|---|
| 135 | |
|---|
| 136 | my $inn=0; |
|---|
| 137 | my $after_bos=0; |
|---|
| 138 | my $before_eos=0; |
|---|
| 139 | |
|---|
| 140 | my @LEFT; #tablica skalarów |
|---|
| 141 | my @CENTER; #tablica skalarów |
|---|
| 142 | my @RIGHT; |
|---|
| 143 | |
|---|
| 144 | my @current_center; |
|---|
| 145 | my @current_left; #skalar dla c, w pp. tablica |
|---|
| 146 | my @current_left_words; |
|---|
| 147 | my @current_right_words_number; |
|---|
| 148 | |
|---|
| 149 | |
|---|
| 150 | while(<>){ |
|---|
| 151 | my $line = $_; |
|---|
| 152 | chomp $line; |
|---|
| 153 | my @line = split / /, $line; |
|---|
| 154 | my $line_s=@line; |
|---|
| 155 | |
|---|
| 156 | if(!line_format_ok(@line)){next;} |
|---|
| 157 | |
|---|
| 158 | if(!$white){white_into_spaces(\@line);} |
|---|
| 159 | else{if($line[2] eq "S"){symbols_into_white(\$line[3]);}} |
|---|
| 160 | |
|---|
| 161 | if(!input_consistent(\$seg_no,\$seg_size,$line[0],$line[1],$ignore)){ |
|---|
| 162 | eof_or_inconsistency(\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,$left_type,$right_type); |
|---|
| 163 | @current_center=(); |
|---|
| 164 | @current_left=(); |
|---|
| 165 | @current_left_words=(); |
|---|
| 166 | @current_right_words_number=(); |
|---|
| 167 | $after_bos=0; |
|---|
| 168 | $before_eos=0; |
|---|
| 169 | } |
|---|
| 170 | |
|---|
| 171 | remember_current_left($left_type,$left_size,\@current_left,\@line, \@current_left_words, $line, \$after_bos, \$before_eos); |
|---|
| 172 | remember_center($line,\@line,\$inn,\@current_center,$white,\@CENTER,\@current_left,\@LEFT, \$after_bos, \$before_eos, \@RIGHT, \@current_right_words_number); |
|---|
| 173 | remember_right($right_type,$left_type,$right_size,\@line,\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,\@current_right_words_number, $line, \$before_eos); |
|---|
| 174 | } |
|---|
| 175 | |
|---|
| 176 | eof_or_inconsistency(\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,$left_type,$right_type); |
|---|
| 177 | exit(0); |
|---|
| 178 | |
|---|
| 179 | #################procedury############################### |
|---|
| 180 | |
|---|
| 181 | sub line_format_ok{ |
|---|
| 182 | my @line = @_; |
|---|
| 183 | my $size = @line; |
|---|
| 184 | if($size<4){return 0;} |
|---|
| 185 | if($line[0]!~/[0-9]+/){return 0;} |
|---|
| 186 | if($line[1]!~/[0-9]+/){return 0;} |
|---|
| 187 | return 1; |
|---|
| 188 | } |
|---|
| 189 | |
|---|
| 190 | sub white_into_spaces{ |
|---|
| 191 | my $line_ref=shift; |
|---|
| 192 | if(@{$line_ref}[2] eq "S"){ |
|---|
| 193 | @{$line_ref}[3]=" "; |
|---|
| 194 | } |
|---|
| 195 | } |
|---|
| 196 | |
|---|
| 197 | sub symbols_into_white{ |
|---|
| 198 | my $string_ref=shift; |
|---|
| 199 | ${$string_ref} =~ s/\\n/\n/g; |
|---|
| 200 | ${$string_ref} =~ s/\\t/\t/g; |
|---|
| 201 | ${$string_ref} =~ s/_/ /g; |
|---|
| 202 | } |
|---|
| 203 | |
|---|
| 204 | sub white_into_symbols{ |
|---|
| 205 | my $string_ref=shift; |
|---|
| 206 | ${$string_ref} =~ s/\n/\\n/g; |
|---|
| 207 | ${$string_ref} =~ s/\t/\\t/g; |
|---|
| 208 | ${$string_ref} =~ s/ /_/g; |
|---|
| 209 | } |
|---|
| 210 | |
|---|
| 211 | sub input_consistent{ |
|---|
| 212 | my $seg_no_ref = shift; |
|---|
| 213 | my $seg_size_ref = shift; |
|---|
| 214 | my $line0 = shift; |
|---|
| 215 | my $line1 = shift; |
|---|
| 216 | my $ig = shift; |
|---|
| 217 | my $ok=1; |
|---|
| 218 | |
|---|
| 219 | if(${$seg_no_ref}!=0&&(!$ig)){ |
|---|
| 220 | my $distance = $line0-${$seg_size_ref}; |
|---|
| 221 | if($distance!=${$seg_no_ref}){$ok=0;} |
|---|
| 222 | } |
|---|
| 223 | ${$seg_no_ref}=$line0; |
|---|
| 224 | ${$seg_size_ref}=$line1; |
|---|
| 225 | return $ok; |
|---|
| 226 | } |
|---|
| 227 | |
|---|
| 228 | sub set_lr_types{ |
|---|
| 229 | my $left = shift; |
|---|
| 230 | my $right = shift; |
|---|
| 231 | my $left_type_ref =shift; |
|---|
| 232 | my $left_size_ref =shift; |
|---|
| 233 | my $right_type_ref =shift; |
|---|
| 234 | my $right_size_ref =shift; |
|---|
| 235 | my $do_trim=shift; |
|---|
| 236 | |
|---|
| 237 | if($left=~/[0-9]+c/){ |
|---|
| 238 | ${$left_type_ref}='c'; |
|---|
| 239 | ${$left_size_ref}=get_number($left); |
|---|
| 240 | if($do_trim){${$left_size_ref}++;} |
|---|
| 241 | } |
|---|
| 242 | else{ |
|---|
| 243 | if($left=~/[0-9]+w/){ |
|---|
| 244 | ${$left_type_ref}='w'; |
|---|
| 245 | ${$left_size_ref}=get_number($left); |
|---|
| 246 | } |
|---|
| 247 | else{ |
|---|
| 248 | if($left=~/[0-9]+s/){ |
|---|
| 249 | ${$left_type_ref}='s'; |
|---|
| 250 | ${$left_size_ref}=get_number($left); |
|---|
| 251 | } |
|---|
| 252 | else{ |
|---|
| 253 | ${$left_type_ref}=$left; |
|---|
| 254 | } |
|---|
| 255 | } |
|---|
| 256 | } |
|---|
| 257 | |
|---|
| 258 | if($right=~/[0-9]+c/){ |
|---|
| 259 | ${$right_type_ref}='c'; |
|---|
| 260 | ${$right_size_ref}=get_number($right); |
|---|
| 261 | if($do_trim){${$right_size_ref}++;} |
|---|
| 262 | } |
|---|
| 263 | else{ |
|---|
| 264 | if($right=~/[0-9]+w/){ |
|---|
| 265 | ${$right_type_ref}='w'; |
|---|
| 266 | ${$right_size_ref}=get_number($right); |
|---|
| 267 | } |
|---|
| 268 | else{ |
|---|
| 269 | if($right=~/[0-9]+s/){ |
|---|
| 270 | ${$right_type_ref}='s'; |
|---|
| 271 | ${$right_size_ref}=get_number($right); |
|---|
| 272 | } |
|---|
| 273 | else{ |
|---|
| 274 | ${$right_type_ref}=$right; |
|---|
| 275 | } |
|---|
| 276 | } |
|---|
| 277 | } |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | sub get_number{ |
|---|
| 281 | my $string = shift; |
|---|
| 282 | my @letters = split(//,$string); |
|---|
| 283 | my $i=0; |
|---|
| 284 | while($letters[$i]=~/[0-9]/){$i++;} |
|---|
| 285 | my $j; |
|---|
| 286 | my $number=0; |
|---|
| 287 | my $ten=1; |
|---|
| 288 | for($j=$i-1;$j>=0;$j--){ |
|---|
| 289 | $number+=$letters[$j]*$ten; |
|---|
| 290 | $ten*=10; |
|---|
| 291 | } |
|---|
| 292 | return $number; |
|---|
| 293 | } |
|---|
| 294 | |
|---|
| 295 | sub remember_center{ |
|---|
| 296 | my $lin = shift; |
|---|
| 297 | my $lin_ref = shift; |
|---|
| 298 | my $inn_ref = shift; |
|---|
| 299 | my $current_center_ref = shift; |
|---|
| 300 | my $white_info = shift; |
|---|
| 301 | my $CENTER_REF = shift; |
|---|
| 302 | my $current_left_ref = shift; |
|---|
| 303 | my $LEFT_REF = shift; |
|---|
| 304 | my $after_bos_ref = shift; |
|---|
| 305 | my $before_eos_ref = shift; |
|---|
| 306 | my $RIGHT_REF = shift; |
|---|
| 307 | my $current_words_right_number_ref = shift; |
|---|
| 308 | |
|---|
| 309 | if((!${$inn_ref}) && $lin=~/$bon/){ |
|---|
| 310 | ${$inn_ref}=1; |
|---|
| 311 | @{$current_center_ref}=(); |
|---|
| 312 | ${$after_bos_ref}=0; |
|---|
| 313 | |
|---|
| 314 | push(@{$LEFT_REF},join('',@{$current_left_ref})); |
|---|
| 315 | |
|---|
| 316 | } |
|---|
| 317 | if(${$inn_ref} && $lin=~/$eon/){ |
|---|
| 318 | ${$inn_ref}=0; |
|---|
| 319 | push(@{$CENTER_REF},join('',@{$current_center_ref})); |
|---|
| 320 | ${$before_eos_ref}=1; |
|---|
| 321 | my @new_table; |
|---|
| 322 | push(@{$RIGHT_REF},\@new_table); |
|---|
| 323 | push(@{$current_words_right_number_ref},0); |
|---|
| 324 | } |
|---|
| 325 | if($inn && index($lin,'*')==-1){ |
|---|
| 326 | white_into_symbols(\${$lin_ref}[3]); |
|---|
| 327 | if($white_info){push(@{$current_center_ref},${$lin_ref}[3]);} |
|---|
| 328 | else{push(@{$current_center_ref},${$lin_ref}[3]);} |
|---|
| 329 | } |
|---|
| 330 | } |
|---|
| 331 | |
|---|
| 332 | sub remember_current_left{ |
|---|
| 333 | my $type=shift; |
|---|
| 334 | my $size=shift; |
|---|
| 335 | my $ref=shift; |
|---|
| 336 | my $line_ref=shift; |
|---|
| 337 | if($type eq 'c'){ |
|---|
| 338 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 339 | push(@{$ref},split('',${$line_ref}[3])); |
|---|
| 340 | my $lsize = @{$ref}; |
|---|
| 341 | if($lsize>$size){splice(@{$ref},0,$lsize-$size);} |
|---|
| 342 | } |
|---|
| 343 | } |
|---|
| 344 | else{ |
|---|
| 345 | if($type eq 'w'){ |
|---|
| 346 | my $words_ref = shift; |
|---|
| 347 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 348 | push(@{$ref},${$line_ref}[3]); |
|---|
| 349 | if(${$line_ref}[2] eq 'W'){ |
|---|
| 350 | push(@{$words_ref},${$line_ref}[3]); |
|---|
| 351 | } |
|---|
| 352 | my $lsize = @{$words_ref}; |
|---|
| 353 | if($lsize>$size){ |
|---|
| 354 | my $word = ${$words_ref}[1]; |
|---|
| 355 | splice(@{$words_ref},0,1); |
|---|
| 356 | while(!(${$ref}[0] eq $word)){splice(@{$ref},0,1); } |
|---|
| 357 | } |
|---|
| 358 | } |
|---|
| 359 | |
|---|
| 360 | } |
|---|
| 361 | else{ |
|---|
| 362 | if($type eq 's'){ |
|---|
| 363 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 364 | push(@{$ref},${$line_ref}[3]); |
|---|
| 365 | my $lsize = @{$ref}; |
|---|
| 366 | if($lsize>$size){splice(@{$ref},0,$lsize-$size);} |
|---|
| 367 | } |
|---|
| 368 | } |
|---|
| 369 | else{#bos/eos |
|---|
| 370 | shift; |
|---|
| 371 | my $line = shift; |
|---|
| 372 | my $after_bos_ref = shift; |
|---|
| 373 | my $before_eos_ref = shift; |
|---|
| 374 | if($line=~/$type/){ |
|---|
| 375 | ${$after_bos_ref}=1; |
|---|
| 376 | @{$ref}=(); |
|---|
| 377 | } |
|---|
| 378 | if(${$after_bos_ref} && !(${$line_ref}[3] eq '*')){ |
|---|
| 379 | push(@{$ref},${$line_ref}[3]); |
|---|
| 380 | } |
|---|
| 381 | } |
|---|
| 382 | } |
|---|
| 383 | } |
|---|
| 384 | } |
|---|
| 385 | |
|---|
| 386 | sub remember_right{ |
|---|
| 387 | my $type=shift; |
|---|
| 388 | my $type_left=shift; |
|---|
| 389 | my $size=shift; |
|---|
| 390 | my $line_ref=shift; |
|---|
| 391 | my $LEFT_REF=shift; |
|---|
| 392 | my $CENTER_REF=shift; |
|---|
| 393 | my $RIGHT_REF=shift; |
|---|
| 394 | my $bod=shift; |
|---|
| 395 | my $eod=shift; |
|---|
| 396 | my $w=shift; |
|---|
| 397 | my $c=shift; |
|---|
| 398 | my $t=shift; |
|---|
| 399 | |
|---|
| 400 | if($type eq 'c'){ |
|---|
| 401 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 402 | my $right_size = @{$RIGHT_REF}; |
|---|
| 403 | for(my $i=0; $i<$right_size; $i++){ |
|---|
| 404 | push(@{${$RIGHT_REF}[$i]}, split('',${$line_ref}[3])); |
|---|
| 405 | my $lsize = @{${$RIGHT_REF}[$i]}; |
|---|
| 406 | if($lsize>=$size){ |
|---|
| 407 | splice(@{${$RIGHT_REF}[$i]},$size-1); #wypisz i usun |
|---|
| 408 | print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); |
|---|
| 409 | $right_size = @{$RIGHT_REF}; |
|---|
| 410 | $i--; |
|---|
| 411 | } |
|---|
| 412 | } |
|---|
| 413 | } |
|---|
| 414 | } |
|---|
| 415 | else{ |
|---|
| 416 | if($type eq 'w'){ |
|---|
| 417 | my $words_number_ref = shift; |
|---|
| 418 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 419 | my $right_size = @{$RIGHT_REF}; |
|---|
| 420 | for(my $i=0; $i<$right_size; $i++){ |
|---|
| 421 | push(@{${$RIGHT_REF}[$i]},${$line_ref}[3]); |
|---|
| 422 | if(${$line_ref}[2] eq 'W'){ |
|---|
| 423 | ${$words_number_ref}[$i]=${$words_number_ref}[$i]+1; |
|---|
| 424 | if(${$words_number_ref}[$i]==$size){ |
|---|
| 425 | print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); |
|---|
| 426 | $right_size = @{$RIGHT_REF}; |
|---|
| 427 | $i--; |
|---|
| 428 | splice(@{$words_number_ref},$i,1); |
|---|
| 429 | } |
|---|
| 430 | } |
|---|
| 431 | } |
|---|
| 432 | } |
|---|
| 433 | } |
|---|
| 434 | else{ |
|---|
| 435 | if($type eq 's'){ |
|---|
| 436 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 437 | my $right_s = @{$RIGHT_REF}; |
|---|
| 438 | for(my $i=0; $i<$right_s; $i++){ |
|---|
| 439 | push(@{${$RIGHT_REF}[$i]},${$line_ref}[3]); |
|---|
| 440 | my $rsize=@{${$RIGHT_REF}[$i]}; |
|---|
| 441 | if($rsize==$size){ |
|---|
| 442 | print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); |
|---|
| 443 | $right_s = @{$RIGHT_REF}; |
|---|
| 444 | $i--; |
|---|
| 445 | } |
|---|
| 446 | } |
|---|
| 447 | } |
|---|
| 448 | } |
|---|
| 449 | else{#bos/eos |
|---|
| 450 | shift; |
|---|
| 451 | my $line = shift; |
|---|
| 452 | my $before_eos_ref = shift; |
|---|
| 453 | if(${$before_eos_ref}){ |
|---|
| 454 | if(!(${$line_ref}[3] eq '*')){ |
|---|
| 455 | #tylko 1 pozycja |
|---|
| 456 | push(@{${$RIGHT_REF}[0]},${$line_ref}[3]); |
|---|
| 457 | } |
|---|
| 458 | if($line=~/$type/){ |
|---|
| 459 | ${$before_eos_ref}=0; |
|---|
| 460 | print_and_remove(0,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); |
|---|
| 461 | } |
|---|
| 462 | } |
|---|
| 463 | } |
|---|
| 464 | } |
|---|
| 465 | } |
|---|
| 466 | } |
|---|
| 467 | |
|---|
| 468 | sub print_and_remove{ |
|---|
| 469 | my $index = shift; |
|---|
| 470 | my $LEFT_REF = shift; |
|---|
| 471 | my $CENTER_REF = shift; |
|---|
| 472 | my $RIGHT_REF = shift; |
|---|
| 473 | my $bdis = shift; |
|---|
| 474 | my $edis = shift; |
|---|
| 475 | my $white = shift; |
|---|
| 476 | my $column = shift; |
|---|
| 477 | my $trim = shift; |
|---|
| 478 | my $left_type = shift; |
|---|
| 479 | my $right_type = shift; |
|---|
| 480 | |
|---|
| 481 | my $left_string = "${$LEFT_REF}[$index]"; |
|---|
| 482 | my $right_string = join('',@{${$RIGHT_REF}[$index]}); |
|---|
| 483 | |
|---|
| 484 | if($trim){ |
|---|
| 485 | if($left_type eq "c"){$left_string=trim_left($left_string);} |
|---|
| 486 | if($right_type eq "c"){$right_string=trim_right($right_string);} |
|---|
| 487 | } |
|---|
| 488 | |
|---|
| 489 | if(length($left_string)<$column){$left_string=" "x($column-length($left_string)).$left_string;} |
|---|
| 490 | |
|---|
| 491 | if($white){ |
|---|
| 492 | white_into_symbols(\$left_string); |
|---|
| 493 | white_into_symbols(\$right_string); |
|---|
| 494 | #ponizsza linijka dodana 18 listopada |
|---|
| 495 | white_into_symbols(\${$CENTER_REF}[$index]); |
|---|
| 496 | } |
|---|
| 497 | |
|---|
| 498 | print $left_string; |
|---|
| 499 | print $bdis; |
|---|
| 500 | |
|---|
| 501 | #ponizsza 3 linijki (tj. 1 blok) dodana 18 listopada |
|---|
| 502 | if(!$white){ |
|---|
| 503 | symbols_into_white(\${$CENTER_REF}[$index]); |
|---|
| 504 | } |
|---|
| 505 | |
|---|
| 506 | print "${$CENTER_REF}[$index]"; |
|---|
| 507 | print $edis; |
|---|
| 508 | print $right_string; |
|---|
| 509 | print "\n"; |
|---|
| 510 | |
|---|
| 511 | splice(@{$LEFT_REF},$index,1); |
|---|
| 512 | splice(@{$CENTER_REF},$index,1); |
|---|
| 513 | splice(@{$RIGHT_REF},$index,1); |
|---|
| 514 | } |
|---|
| 515 | |
|---|
| 516 | sub trim_left{ |
|---|
| 517 | my $string = shift; |
|---|
| 518 | if(substr($string,0,1) eq " "){return substr($string,1);} |
|---|
| 519 | my $position = index($string," "); |
|---|
| 520 | my $temp_position = index($string,"\n"); |
|---|
| 521 | if(!$temp_position==-1&&($position==-1||$temp_position<$position)){$position=$temp_position;} |
|---|
| 522 | $temp_position = index($string,"\t"); |
|---|
| 523 | if(!$temp_position==-1&&($position==-1||$temp_position<$position)){$position=$temp_position;} |
|---|
| 524 | return substr($string,$position+1); |
|---|
| 525 | } |
|---|
| 526 | |
|---|
| 527 | sub trim_right{ |
|---|
| 528 | my $string = shift; |
|---|
| 529 | my $length = length($string); |
|---|
| 530 | if(substr($string,$length-1,1) eq " "){return substr($string,0,$length-1);} |
|---|
| 531 | my $position = rindex($string," "); |
|---|
| 532 | my $temp_position = rindex($string,"\n"); |
|---|
| 533 | if($temp_position>$position){$position=$temp_position;} |
|---|
| 534 | $temp_position = rindex($string,"\t"); |
|---|
| 535 | if($temp_position>$position){$position=$temp_position;} |
|---|
| 536 | return substr($string,0,$position); |
|---|
| 537 | } |
|---|
| 538 | |
|---|
| 539 | sub eof_or_inconsistency{ |
|---|
| 540 | my $LEFT_REF = shift; |
|---|
| 541 | my $CENTER_REF = shift; |
|---|
| 542 | my $RIGHT_REF = shift; |
|---|
| 543 | my $bdis = shift; |
|---|
| 544 | my $edis = shift; |
|---|
| 545 | my $white = shift; |
|---|
| 546 | my $column = shift; |
|---|
| 547 | my $trim = shift; |
|---|
| 548 | my $left_type = shift; |
|---|
| 549 | my $right_type = shift; |
|---|
| 550 | |
|---|
| 551 | my $length = @{$CENTER_REF}; |
|---|
| 552 | for(my $i=0;$i<$length;$i++){ |
|---|
| 553 | print_and_remove(0,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bdis,$edis,$white,$column,$trim,$left_type,$right_type); |
|---|
| 554 | $length = @{$CENTER_REF}; |
|---|
| 555 | $i--; |
|---|
| 556 | } |
|---|
| 557 | } |
|---|
