Context Navigation

con @ 52bccea

help

Last change on this file since 52bccea was 52bccea, checked in by pawelk <pawelk@…>, 17 years ago

Pierwszy etap zmiany con na kon (przez windowsa).

git-svn-id: svn://atos.wmid.amu.edu.pl/utt@6 e293616e-ec6a-49c2-aa92-f4a8b91c5d16

Property mode set to 100755

File size: 14.8 KB

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

Note: See TracBrowser for help on using the repository browser.

UAM Text Tools

Context Navigation

source: app/src/kon/con @ 52bccea

Download in other formats: