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

Rev	Line
[25ae32e]	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: