Index: src/fla.c =================================================================== --- src/fla.c (revision 9e0afb505e266b0a64e2c91b685b3361c9c3bfb3) +++ (revision ) @@ -1,68 +1,0 @@ -#include -#include -#include -#include - -char buf[5000]; - -int main(int argc, char **argv) -{ - - char *pattern; - char eoln; - regex_t re; - - int firstline = 1; - - if( argc < 2 ) - { -/* pattern="[ \t]*([0-9]+[ \t]+){2}EOS([ \t].*)?"; */ - pattern = "[ \t]*BOS([ \t].*)?"; - } - else - { - pattern = argv[1]; - } - - if( argc < 3 ) - { - eoln = '\f'; - } - else - { - eoln = atoi(argv[2]); - } - - if( 0 != regcomp(&re, pattern, REG_EXTENDED|REG_NOSUB) ) - { - fprintf(stderr, "Invalid pattern.\n"); - return 1; - } - - while( fgets(buf, 5000, stdin) ) - { - buf[strlen(buf)-1] = '\0'; - if( firstline ) - { - firstline = 0; - } - else - { - if( 0 == regexec(&re, buf, (size_t)0, NULL, 0) ) - { - putchar('\n'); - } - else - { - putchar(eoln); - } - } - fputs(buf, stdout); - } - - putchar('\n'); - - return 0; - -} - Index: src/gph.pl =================================================================== --- src/gph.pl (revision e4cec26b9f4157c18cc9809b9570c3f2eb14cc03) +++ (revision ) @@ -1,162 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component: gph -#version: 1.0 -#author: Tomasz Obrebski - -use strict; -use Getopt::Long; -use File::HomeDir; - - - - - -my $systemconfigfile='/usr/local/etc/utt/gph.conf'; -my $userconfigfile=home()."/.utt/gph.conf"; - -Getopt::Long::Configure('no_ignore_case_always'); - -my $help=0; -my $inputfile=0; -my $outputfile=0; -my @process=(); -my $reset; -my $interactive=0; - -#read configuration files########################### -my $file; -my @process_conf=(); -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "inputfile")or($name eq "f")){ - $inputfile=$value; - } - elsif(($name eq "outputfile")or($name eq "o")){ - $outputfile=$value; - } - elsif(($name eq "process")or($name eq "p")){ - push @process_conf, $value; - } - elsif(($name eq "reset")or($name eq "r")){ - $reset=$value; - } - elsif(($name eq "interactive")or($name eq "i")){ - $interactive=1; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - - - -GetOptions("process|p=s" => \@process, - "inputfile|f=s" => \$inputfile, - "outputfile|o=s" => \$outputfile, - "help|h" => \$help, - "reset|r=s" => \$reset, - "interactive|i" => \$interactive); - -@process = @process_conf if @process<1; - -if($help) -{ - print <<'END' -Usage: gph [OPTIONS] - -Options: - --process=TYPE -p TYPE Process segments of type TYPE. - --reset=TYPE -r TYPE Start new graph at tags of type TYPE. - --inputfile=FILE -f FILE Input file. - --outputfile=FILE -o FILE Output file. - --interactive -i Toggle interactive mode (default=off). -END -; - exit 0; -} - - -$|=1 if $interactive; - - -if(!$inputfile or $inputfile eq "-") { - *INPUT = *STDIN; -} -else { - open(INPUT, "$inputfile") or die("Can't open input file: $inputfile!"); -} - -if(!$outputfile or $outputfile eq "-") { - *OUTPUT = *STDOUT; -} -else { - open(OUTPUT, "$outputfile") or die("Can't open output file: $outputfile!"); -} - -my @prev; -my $n=0; - -while() -{ - chomp; - my $do=0; - - my @line = split /\s+/; - - if($line[2] eq $reset) - { - $n=0; - @prev = (); - } - - for my $p (@process) - { - $do=1 if $line[2] eq $p; - } - - my $gph = ''; - if($do) - { - my @preds = (); - shift @prev while @prev+0 && $prev[0]->[1] + $prev[0]->[2] < $line[0]; - for my $p (@prev) - { - push(@preds, $p->[0]) if $p->[1] + $p->[2] == $line[0]; - } - push @prev, [$n, $line[0], $line[1]]; - - $gph=' gph:'.$n.':'.join(',',@preds); - - $n++; - } - else - { - for my $p (@prev) - { - if($p->[1]+$p->[2] == $line[0]) - { - $p->[2] += $line[1]; - } - } - - $gph=''; - - } - - print OUTPUT $_.$gph."\n"; -} - Index: src/grp.pl =================================================================== --- src/grp.pl (revision ac9a049dc70613b4b6ef600978b199a291eed2f0) +++ (revision ) @@ -1,170 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component name: grp -#version: 1.0 -#author: Tomasz Obrebski - -use strict; -use Getopt::Long; -use File::HomeDir; - -# katalog zawierajacy terms.m4 -my $LIB_DIR="/usr/local/lib/utt"; - -my $systemconfigfile="/usr/local/etc/utt/grp.conf"; -my $userconfigfile=home()."/.utt/grp.conf"; - -Getopt::Long::Configure('no_ignore_case_always'); - -my $help=0; -my $pattern=0; -my $matches_only=0; -my $macrofile=0; -my $define=0; -my $show_command=0; -my $action="pgP"; -my $eos="seg(EOS)"; -my $morfield='lem'; -my $tags=0; - -#read configuration files########################### -my $file; -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "pattern")or($name eq "e")){ - $pattern=$value; - } - elsif(($name eq "eos")or($name eq "E")){ - $eos=$value; - } - elsif($name eq "morph"){ - $morfield=$value; - } - elsif($name eq "macros"){ - $macrofile=$value; - } - elsif($name eq "define"){ - $define=$value; - } - elsif($name eq "command"){ - $show_command=1; - } - elsif($name eq "action"){ - $action; - } - elsif($name eq "tags"){ - $tags=$value; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - -GetOptions("pattern|e=s" => \$pattern, - "eos|E=s" => \$eos, - "morph=s" => \$morfield, - "macros=s" => \$macrofile, - "define=s" => \$macrofile, - "command" => \$show_command, - "action=s" => \$action, - "tags=s" => \$tags, - "help|h" => \$help); - -if($help) -{ - print <<'END' -Usage: gre [OPTIONS] [file ..] - -Options: - --pattern -e PATTERN Pattern. - --eos -E PATTERN Segment serving as sentence delimiter. - --morph=STRING Field containing morphological information (default 'lem'). - --macros=FILE Read macrodefinitions from FILE. - --define=FILE Add macrodefinitions from FILE. - --action -a [u][p][g][P] Perform only indicated actions. - u - uncompress with 'lzop -cd' - p - preprocess - g - grep - P - postprocess - (default pgP) - --tags=STRING Morphosyntactic tag format. - --command Print the shell command to be executed and exit. - --help -h Help. -END -; - exit 0; -} - -die("$0: no pattern given.\n") unless $pattern || $action !~ /g/; - -die("$0: macro file not found") unless - $macrofile or - -e "$LIB_DIR/terms.m4" and $macrofile="$LIB_DIR/terms.m4"; - -die("$0: undefined tagset format (tags option missing)") unless - $tags; - -die("$0: $tags.tag2re program not found") unless - 1; #JAK NAPISAC WARUNEK??? - - -my $uncompress = ($action =~ /u/) ? ' lzop -cd | ' : ''; -my $preproc = ($action =~ /p/) ? ' fla | ' : ''; - -my $postproc = ($action =~ /P/) ? ' | unfla ' : ''; - - -# discarding spaces -$pattern =~ s/\s+/\\`'/g; #` -# quoting escaped commas -$pattern =~ s/\\,/\\`\\`\\,''/g; -# quoting commas in {m,n} r.e. operator -$pattern =~ s/(\{\d*),(\d*\})/\1\\`\\`,''\2/g; - -my $grepre = `echo \"$pattern\" | m4 --define=ENDOFSEGMENT='[[:cntrl:]]' --define=MORFIELD=$morfield $macrofile - 2>/dev/null`; - -die("Incorrect pattern (m4).") if $? >> 8; - - -chomp $grepre; - -# <> expansion - -$grepre =~ s/<([^>]+)>/`echo $1 | $tags.tag2re`/ge; - -$grepre =~ s/\./[^ [:cntrl:]]/g; - -$grepre =~ s/\\s/[ ]/g; -$grepre =~ s/\\S/[^ [:cntrl:]]/g; -$grepre =~ s/\\d/[0-9]/g; -$grepre =~ s/\\D/[^0-9 [:cntrl:]]/g; -$grepre =~ s/\\w/[a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_]/g; -$grepre =~ s/\\W/[^a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_ [:cntrl:]]/g; -# extensions -$grepre =~ s/\\l/[a-z±æê³ñ󶌿]/g; #lowercase letter -$grepre =~ s/\\L/[A-Z¡ÆÊ£ÑÓŠ¬¯]/g; #upercase letter - -my $grep_command = ($action =~ /g/) ? "egrep '$grepre'" : " cat "; - -if($show_command) -{ - print $grep_command."\n"; - exit 0; -} - -#print $preproc.$grep_command.$postproc."\n"; - -exec $preproc.$grep_command.$postproc; Index: src/kon.pl =================================================================== --- src/kon.pl (revision 8e1730ce813e73fcd85ac2bc9142259b49434f09) +++ (revision ) @@ -1,557 +1,0 @@ -#!/usr/bin/perl -w - -#package: UAM Text Tools -#component: kon (search context) -#version: 1.0 -#author: Justyna Walkowska - -use strict; -use Getopt::Long; -use locale; -use File::HomeDir; - -Getopt::Long::Configure('no_ignore_case_always'); - -my $l='30c'; -my $r='30c'; -my $trim=0; -my $white=0; -my $bon='[0-9]+ [0-9]+ BOM .*'; -my $eon='[0-9]+ [0-9]+ EOM .*'; -my $bod='['; -my $eod=']'; -my $column=0; -my $ignore=0; -my $help=0; - -my $systemconfigfile='/usr/local/etc/utt/kon.conf'; -#my $userconfigfile="$ENV{'HOME'}/.utt/kon.conf"; -my $userconfigfile=home()."/.utt/kon.conf"; - -#read configuration files########################### -my $file; -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "left")or($name eq "l")){ - $l=$value; - } - elsif(($name eq "right")or($name eq "r")){ - $r=$value; - } - elsif(($name eq "trim")or($name eq "t")){ - $trim=1; - } - elsif(($name eq "white")or($name eq "w")){ - $white=1; - } - elsif($name eq "bom"){ - $bon=$value; - } - elsif($name eq "eom"){ - $eon=$value; - } - elsif($name eq "bod"){ - $bod=$value; - } - elsif($name eq "eod"){ - $eod=$value; - } - elsif(($name eq "column")or($name eq "c")){ - $column=$value; - } - elsif(($name eq "ignore")or($name eq "i")){ - $ignore=1; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - -GetOptions("left|l=s" => \$l, - "right|r=s" => \$r, - "trim|t" => \$trim, - "white|w" => \$white, - "bom=s" => \$bon, - "eom=s" => \$eon, - "bod=s" => \$bod, - "eod=s" => \$eod, - "column|c=s" => \$column, - "ignore|i" => \$ignore, - "help|h" => \$help); - -if(!($column=~/^[0-9]+$/)){$column=0;} - -if($help) -{ - print <<'END' -Options: - --help -h Help. - --left -l Left context info (default='30c') - Examples: - -l=5c: left context is 5 characters - -l=5w: left context is 5 words - -l=5s: left context is 5 non-empty input lines - -l='\s*\S+\sr\S+BOS': left context starts with the given regex - --right -r Right context info (default='30c') - --trim -t Clear incomplete words from output - --white -w DO NOT change all white characters into spaces - --column -c Left column minimal width in characters (default = 0) - --ignore -i Ignore input inconsistency - --bon Beginning of selected segment - (regex, default='[0-9]+ [0-9]+ BOM .*') - --eon End of selected segment - (regex, default='[0-9]+ [0-9]+ EOM .*') - --bod Selected segment beginning display (default='[') - --eod Selected segment end display (default=']') - -END -; - exit 0; -} - - -my $seg_no=0; -my $seg_size=0; - -my $left_type; -my $left_size; -my $right_type; -my $right_size; - -set_lr_types($l, $r, \$left_type,\$left_size,\$right_type,\$right_size, $trim); - - -my $inn=0; -my $after_bos=0; -my $before_eos=0; - -my @LEFT; #tablica skalarów -my @CENTER; #tablica skalarów -my @RIGHT; - -my @current_center; -my @current_left; #skalar dla c, w pp. tablica -my @current_left_words; -my @current_right_words_number; - - -while(<>){ - my $line = $_; - chomp $line; - my @line = split / /, $line; - my $line_s=@line; - - if(!line_format_ok(@line)){next;} - - if(!$white){white_into_spaces(\@line);} - else{if($line[2] eq "S"){symbols_into_white(\$line[3]);}} - - if(!input_consistent(\$seg_no,\$seg_size,$line[0],$line[1],$ignore)){ - eof_or_inconsistency(\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,$left_type,$right_type); - @current_center=(); - @current_left=(); - @current_left_words=(); - @current_right_words_number=(); - $after_bos=0; - $before_eos=0; - } - - remember_current_left($left_type,$left_size,\@current_left,\@line, \@current_left_words, $line, \$after_bos, \$before_eos); - remember_center($line,\@line,\$inn,\@current_center,$white,\@CENTER,\@current_left,\@LEFT, \$after_bos, \$before_eos, \@RIGHT, \@current_right_words_number); - remember_right($right_type,$left_type,$right_size,\@line,\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,\@current_right_words_number, $line, \$before_eos); -} - -eof_or_inconsistency(\@LEFT,\@CENTER,\@RIGHT,$bod,$eod,$white,$column,$trim,$left_type,$right_type); -exit(0); - -#################procedury############################### - -sub line_format_ok{ - my @line = @_; - my $size = @line; - if($size<4){return 0;} - if($line[0]!~/[0-9]+/){return 0;} - if($line[1]!~/[0-9]+/){return 0;} - return 1; - } - -sub white_into_spaces{ - my $line_ref=shift; - if(@{$line_ref}[2] eq "S"){ - @{$line_ref}[3]=" "; - } - } - -sub symbols_into_white{ - my $string_ref=shift; - ${$string_ref} =~ s/\\n/\n/g; - ${$string_ref} =~ s/\\t/\t/g; - ${$string_ref} =~ s/_/ /g; - } - -sub white_into_symbols{ - my $string_ref=shift; - ${$string_ref} =~ s/\n/\\n/g; - ${$string_ref} =~ s/\t/\\t/g; - ${$string_ref} =~ s/ /_/g; - } - -sub input_consistent{ - my $seg_no_ref = shift; - my $seg_size_ref = shift; - my $line0 = shift; - my $line1 = shift; - my $ig = shift; - my $ok=1; - - if(${$seg_no_ref}!=0&&(!$ig)){ - my $distance = $line0-${$seg_size_ref}; - if($distance!=${$seg_no_ref}){$ok=0;} - } - ${$seg_no_ref}=$line0; - ${$seg_size_ref}=$line1; - return $ok; - } - -sub set_lr_types{ - my $left = shift; - my $right = shift; - my $left_type_ref =shift; - my $left_size_ref =shift; - my $right_type_ref =shift; - my $right_size_ref =shift; - my $do_trim=shift; - - if($left=~/[0-9]+c/){ - ${$left_type_ref}='c'; - ${$left_size_ref}=get_number($left); - if($do_trim){${$left_size_ref}++;} - } - else{ - if($left=~/[0-9]+w/){ - ${$left_type_ref}='w'; - ${$left_size_ref}=get_number($left); - } - else{ - if($left=~/[0-9]+s/){ - ${$left_type_ref}='s'; - ${$left_size_ref}=get_number($left); - } - else{ - ${$left_type_ref}=$left; - } - } - } - -if($right=~/[0-9]+c/){ - ${$right_type_ref}='c'; - ${$right_size_ref}=get_number($right); - if($do_trim){${$right_size_ref}++;} - } - else{ - if($right=~/[0-9]+w/){ - ${$right_type_ref}='w'; - ${$right_size_ref}=get_number($right); - } - else{ - if($right=~/[0-9]+s/){ - ${$right_type_ref}='s'; - ${$right_size_ref}=get_number($right); - } - else{ - ${$right_type_ref}=$right; - } - } - } - } - -sub get_number{ - my $string = shift; - my @letters = split(//,$string); - my $i=0; - while($letters[$i]=~/[0-9]/){$i++;} - my $j; - my $number=0; - my $ten=1; - for($j=$i-1;$j>=0;$j--){ - $number+=$letters[$j]*$ten; - $ten*=10; - } - return $number; - } - -sub remember_center{ - my $lin = shift; - my $lin_ref = shift; - my $inn_ref = shift; - my $current_center_ref = shift; - my $white_info = shift; - my $CENTER_REF = shift; - my $current_left_ref = shift; - my $LEFT_REF = shift; - my $after_bos_ref = shift; - my $before_eos_ref = shift; - my $RIGHT_REF = shift; - my $current_words_right_number_ref = shift; - - if((!${$inn_ref}) && $lin=~/$bon/){ - ${$inn_ref}=1; - @{$current_center_ref}=(); - ${$after_bos_ref}=0; - - push(@{$LEFT_REF},join('',@{$current_left_ref})); - - } - if(${$inn_ref} && $lin=~/$eon/){ - ${$inn_ref}=0; - push(@{$CENTER_REF},join('',@{$current_center_ref})); - ${$before_eos_ref}=1; - my @new_table; - push(@{$RIGHT_REF},\@new_table); - push(@{$current_words_right_number_ref},0); - } - if($inn && index($lin,'*')==-1){ - white_into_symbols(\${$lin_ref}[3]); - if($white_info){push(@{$current_center_ref},${$lin_ref}[3]);} - else{push(@{$current_center_ref},${$lin_ref}[3]);} - } - } - -sub remember_current_left{ -my $type=shift; -my $size=shift; -my $ref=shift; -my $line_ref=shift; - if($type eq 'c'){ - if(!(${$line_ref}[3] eq '*')){ - push(@{$ref},split('',${$line_ref}[3])); - my $lsize = @{$ref}; - if($lsize>$size){splice(@{$ref},0,$lsize-$size);} - } - } - else{ - if($type eq 'w'){ - my $words_ref = shift; - if(!(${$line_ref}[3] eq '*')){ - push(@{$ref},${$line_ref}[3]); - if(${$line_ref}[2] eq 'W'){ - push(@{$words_ref},${$line_ref}[3]); - } - my $lsize = @{$words_ref}; - if($lsize>$size){ - my $word = ${$words_ref}[1]; - splice(@{$words_ref},0,1); - while(!(${$ref}[0] eq $word)){splice(@{$ref},0,1); } - } - } - - } - else{ - if($type eq 's'){ - if(!(${$line_ref}[3] eq '*')){ - push(@{$ref},${$line_ref}[3]); - my $lsize = @{$ref}; - if($lsize>$size){splice(@{$ref},0,$lsize-$size);} - } - } - else{#bos/eos - shift; - my $line = shift; - my $after_bos_ref = shift; - my $before_eos_ref = shift; - if($line=~/$type/){ - ${$after_bos_ref}=1; - @{$ref}=(); - } - if(${$after_bos_ref} && !(${$line_ref}[3] eq '*')){ - push(@{$ref},${$line_ref}[3]); - } - } - } - } - } - -sub remember_right{ -my $type=shift; -my $type_left=shift; -my $size=shift; -my $line_ref=shift; -my $LEFT_REF=shift; -my $CENTER_REF=shift; -my $RIGHT_REF=shift; -my $bod=shift; -my $eod=shift; -my $w=shift; -my $c=shift; -my $t=shift; - - if($type eq 'c'){ - if(!(${$line_ref}[3] eq '*')){ - my $right_size = @{$RIGHT_REF}; - for(my $i=0; $i<$right_size; $i++){ - push(@{${$RIGHT_REF}[$i]}, split('',${$line_ref}[3])); - my $lsize = @{${$RIGHT_REF}[$i]}; - if($lsize>=$size){ - splice(@{${$RIGHT_REF}[$i]},$size-1); #wypisz i usun - print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); - $right_size = @{$RIGHT_REF}; - $i--; - } - } - } - } - else{ - if($type eq 'w'){ - my $words_number_ref = shift; - if(!(${$line_ref}[3] eq '*')){ - my $right_size = @{$RIGHT_REF}; - for(my $i=0; $i<$right_size; $i++){ - push(@{${$RIGHT_REF}[$i]},${$line_ref}[3]); - if(${$line_ref}[2] eq 'W'){ - ${$words_number_ref}[$i]=${$words_number_ref}[$i]+1; - if(${$words_number_ref}[$i]==$size){ - print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); - $right_size = @{$RIGHT_REF}; - $i--; - splice(@{$words_number_ref},$i,1); - } - } - } - } - } - else{ - if($type eq 's'){ - if(!(${$line_ref}[3] eq '*')){ - my $right_s = @{$RIGHT_REF}; - for(my $i=0; $i<$right_s; $i++){ - push(@{${$RIGHT_REF}[$i]},${$line_ref}[3]); - my $rsize=@{${$RIGHT_REF}[$i]}; - if($rsize==$size){ - print_and_remove($i,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); - $right_s = @{$RIGHT_REF}; - $i--; - } - } - } - } - else{#bos/eos - shift; - my $line = shift; - my $before_eos_ref = shift; - if(${$before_eos_ref}){ - if(!(${$line_ref}[3] eq '*')){ - #tylko 1 pozycja - push(@{${$RIGHT_REF}[0]},${$line_ref}[3]); - } - if($line=~/$type/){ - ${$before_eos_ref}=0; - print_and_remove(0,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bod,$eod,$w,$c,$t,$type_left,$type); - } - } - } - } - } -} - -sub print_and_remove{ - my $index = shift; - my $LEFT_REF = shift; - my $CENTER_REF = shift; - my $RIGHT_REF = shift; - my $bdis = shift; - my $edis = shift; - my $white = shift; - my $column = shift; - my $trim = shift; - my $left_type = shift; - my $right_type = shift; - - my $left_string = "${$LEFT_REF}[$index]"; - my $right_string = join('',@{${$RIGHT_REF}[$index]}); - - if($trim){ - if($left_type eq "c"){$left_string=trim_left($left_string);} - if($right_type eq "c"){$right_string=trim_right($right_string);} - } - - if(length($left_string)<$column){$left_string=" "x($column-length($left_string)).$left_string;} - - if($white){ - white_into_symbols(\$left_string); - white_into_symbols(\$right_string); -#ponizsza linijka dodana 18 listopada - white_into_symbols(\${$CENTER_REF}[$index]); - } - - print $left_string; - print $bdis; - -#ponizsza 3 linijki (tj. 1 blok) dodana 18 listopada - if(!$white){ - symbols_into_white(\${$CENTER_REF}[$index]); - } - - print "${$CENTER_REF}[$index]"; - print $edis; - print $right_string; - print "\n"; - - splice(@{$LEFT_REF},$index,1); - splice(@{$CENTER_REF},$index,1); - splice(@{$RIGHT_REF},$index,1); - } - -sub trim_left{ - my $string = shift; - if(substr($string,0,1) eq " "){return substr($string,1);} - my $position = index($string," "); - my $temp_position = index($string,"\n"); - if(!$temp_position==-1&&($position==-1||$temp_position<$position)){$position=$temp_position;} - $temp_position = index($string,"\t"); - if(!$temp_position==-1&&($position==-1||$temp_position<$position)){$position=$temp_position;} - return substr($string,$position+1); - } - -sub trim_right{ - my $string = shift; - my $length = length($string); - if(substr($string,$length-1,1) eq " "){return substr($string,0,$length-1);} - my $position = rindex($string," "); - my $temp_position = rindex($string,"\n"); - if($temp_position>$position){$position=$temp_position;} - $temp_position = rindex($string,"\t"); - if($temp_position>$position){$position=$temp_position;} - return substr($string,0,$position); - } - -sub eof_or_inconsistency{ - my $LEFT_REF = shift; - my $CENTER_REF = shift; - my $RIGHT_REF = shift; - my $bdis = shift; - my $edis = shift; - my $white = shift; - my $column = shift; - my $trim = shift; - my $left_type = shift; - my $right_type = shift; - - my $length = @{$CENTER_REF}; - for(my $i=0;$i<$length;$i++){ - print_and_remove(0,$LEFT_REF,$CENTER_REF,$RIGHT_REF,$bdis,$edis,$white,$column,$trim,$left_type,$right_type); - $length = @{$CENTER_REF}; - $i--; - } - } Index: src/kot.pl =================================================================== --- src/kot.pl (revision 3a2ae91d9423fabcf92fcfb2b04614a3c5a3696a) +++ (revision ) @@ -1,102 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component: kot -#version: 1.0 -#author: Tomasz Obrebski - -use strict; -use Getopt::Long; -use File::HomeDir; - -my $help=0; -my $gap_fill="\n-----\n"; -my $spaces=0; - -my $systemconfigfile='/usr/local/etc/utt/kot.conf'; -#my $userconfigfile="$ENV{'HOME'}/.utt/kot.conf"; -my $userconfigfile=home()."/.utt/kot.conf"; - -#read configuration files########################### -my $file; -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "gap-fill")or($name eq "g")){ - $gap_fill=$value; - } - elsif(($name eq "spaces")or($name eq "s")){ - $spaces=1; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - -GetOptions("gap-fill|g=s" => \$gap_fill, - "spaces|r" => \$spaces, - "help|h" => \$help); - -if($help) -{ - print <<'END' -Usage: ser [OPTIONS] [file ..] - -Options: - --gap-fill -g Help. - --spaces -r - --define=FILE Read macrodefinitions from FILE. - --flex-template=FILE Read flex code template from FILE. - --only-matching -m Print only fragments matching PATTERN. - --flex Print only the generated flex code and exit. -END -; - exit 0; -} - - -$gap_fill =~ s/\\t/\t/g; -$gap_fill =~ s/\\n/\n/g; -$gap_fill =~ s/\\r/\r/g; -$gap_fill =~ s/\\f/\f/g; - -my $prevend=-1; -my $count=0; - -while(<>) -{ - my ($start,$len,$type,$form) = /^\s*(\d+)\s+(\d+)\s+(\S+)\s+(\S+)/; - - if($start > $prevend) - { - print $gap_fill unless $count++ == 0; - } - - $prevend=$start+$len; - - next if $len==0;# || $form eq "*"; - - $form =~ s/\\\*/*/g; - - if($type eq 'S' && ! $spaces) - { - $form =~ s/_/ /g; - $form =~ s/\\t/\t/g; - $form =~ s/\\n/\n/g; - $form =~ s/\\r/\r/g; - $form =~ s/\\f/\f/g; - } - - print $form; -} Index: src/mar.pl =================================================================== --- src/mar.pl (revision dc2176950fd43bdb6684b7730f37aaa88239b818) +++ (revision ) @@ -1,336 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component: mar -#version: 1.0 -#author: Marcin Walas - -#this program tags the tokenized file with given tags -#tags can be given in any order and configuration through the expression -#which is one of the parametres of the script -#contact: d287572@atos.wmid.amu.edu.pl, walasiek@gmail.com - -my $version = '1.0'; - -use lib "/usr/local/lib/utt"; -use lib "$ENV{'HOME'}/.local/lib/utt"; - -use strict; -use Getopt::Long; -use File::HomeDir; - -use attr; - - -my $LIB_DIR="/usr/local/lib/utt"; -my $systemconfigfile='/usr/local/etc/utt/mar.conf'; -my $userconfigfile=home()."/.utt/mar.conf"; - -Getopt::Long::Configure('no_ignore_case_always'); - -my $help=0; -my $pattern=0; -my $macrofile=0; -my $define=0; -my $command=0; -my $action="pgP"; -my $eos="seg(EOS)"; -my $explicit_space=0; -my $morfield='lem'; -my $tags=0; -my $show_version = 0; - -#read configuration files########################### -my $file; -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "pattern")or($name eq "e")){ - $pattern=$value; - } - elsif($name eq "eos"){ - $eos=$value; - } - elsif($name eq "macros"){ - $macrofile=$value; - } - elsif($name eq "tags"){ - $tags=$value; - } - elsif($name eq "morph"){ - $morfield=$value; - } - elsif($name eq "command"){ - $command=1; - } - elsif($name eq "action"){ - $action=$value; - } - elsif($name eq "space"){ - $explicit_space=1; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - -GetOptions("pattern|e=s" => \$pattern, - "eos|E=s" => \$eos, - "macros=s" => \$macrofile, - "define=s" => \$macrofile, - "command" => \$command, - "action=s" => \$action, - "help|h" => \$help, - "space|s" => \$explicit_space, - "version|v" => \$show_version, - ); - - - -if($show_version){ - print "Version: $version\n"; - exit 0; -} - -if($help) -{ - print <<'END' -Usage: mar [OPTIONS] [file ..] - -Options: - --pattern -e PATTERN Pattern. - --eos -E PATTERN Segment serving as sentence beginning marker. [TODO] - --macros=FILE Read macrodefinitions from FILE. [TODO] - --define=FILE Add macrodefinitions from FILE. [TODO] - --action -a [p][s][P] Perform only indicated actions. - p - preprocess - s - search - P - postprocess - (default psP) - --command Print generated shell command and exit. - --help -h Print help. - --version -v Script version - -In patern you can put any tag. Tags should begin with the @ character. -They don't have to be closed. -They can't contain white spaces! - -Note: If you don't define any custom tags, whole pattern will be taged with - default tags (begining of match and end of match) - -Tags examples: - -mar -e '@BEG cat() @END' - it will find any adjectives in the text and tag them with surrounding tags -mar -e 'cat() @MYTAG cat()' - this will find two neighbouring adjectives and parcel them with tag MYTAG - -Some example patterns: -'word(domu)' - form of the word domu -'lexeme(dom)' - any form of lexeme dom -'space' - space -'cat()' - adjective - -You can use * in patterns to make zero or more counts of word. - -END -; - exit 0; -} - -die("$0: no pattern given. Run with -h to get help.\n") unless $pattern || $action !~ /g/; - -die("$0: macro file not found") unless - $macrofile or - -e "$LIB_DIR/terms.m4" and $macrofile="$LIB_DIR/terms.m4"; - -my $preproc = ($action =~ /p/) ? ' fla | ' : ''; - -my $postproc = ($action =~ /P/) ? ' | unfla ' : ''; - - -#this is our help function to cut the re to get another tag -#it takes only one argument which is our patern (after m4 processing) -#returns: the first root-level brace with content -sub cutRe -{ - my $i = 0; - my $level = 0; - my $text = $_[0]; - my $temp; - for( $i =0; $i < (length $text);$i++) - { - $temp = substr($text, $i,1); - if( $temp eq "(") - {#we have an opening - $level++; - } - elsif ( $temp eq ")") - {#we close - $level--; - } - if ( $level == 0) - { - $temp = substr($text,0,$i+1); - last; - } - } - $temp; -} - -#the same function as above althought it returns everything after the -#first root level brace -sub restRe -{ - my $i = 0; - my $level = 0; - my $text = $_[0]; - my $temp; - for( $i =0; $i < (length $text);$i++) - { - $temp = substr($text, $i,1); - if( $temp eq "(") - {#we have an opening - $level++; - } - elsif ( $temp eq ")") - {#we close - $level--; - } - if ( $level == 0) - { #we cut everything in the begining - $temp = substr($text,$i+1); - last; - } - } - $temp; -} - - -#here we are preparing re for extended matching -my @tags; - -#we must find what our the tags -#some pattern adjustment -my $end = 0; -my $temp = " ".$pattern." "; -$temp =~ s/(\@[^ ]*) (\@[^ ]* )/\1 \2/g; -$pattern = $temp; - -while ($end != 1) -{ - #we seek for the first tag in pattern - if ($temp =~ /^.*?\@(.*?) /) - { - #we add this to tags array - push (@tags, $1); - #and cut the pattern - $temp =~ s/^.*?\@(.*?) / /; - #print $temp."\n"; - } - else - { - #if we dont find any tags we end - $end = 1; - } -} - -#here we have our patern with tags removed (we set sections of ()) between tags -my $patternmod = "( ".$pattern." )"; -$patternmod =~ s/\s@.*?\s/\)\(/g; - -#discarding spaces -$patternmod =~ s/\s+/\\`'/g; #` -# quoting escaped commas -$patternmod =~ s/\\,/\\`\\`\\,''/g; -# quoting commas in {m,n} r.e. operator -$patternmod =~ s/(\{\d*),(\d*\})/\1\\`\\`,''\2/g; -#print "After m4:".$re."\n"; - -my $re = `echo \"$patternmod\" | m4 --define=ENDOFSEGMENT='[[:cntrl:]]' --define=MORFIELD=$morfield $macrofile - 2>/dev/null`; - -die("Incorrect pattern (m4).") if $? >> 8; - - -chomp $re; - -# <> expansion - -$re =~ s/<([^>]+)>/`echo $1 | $tags.tag2re`/ge; - -# Perl-like special sequences -$re =~ s/\./[^ [:cntrl:]]/g; -$re =~ s/\\s/[ ]/g; -$re =~ s/\\S/[^ [:cntrl:]]/g; -$re =~ s/\\d/[0-9]/g; -$re =~ s/\\D/[^0-9 [:cntrl:]]/g; -$re =~ s/\\w/[a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_]/g; -$re =~ s/\\W/[^a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_ [:cntrl:]]/g; -# extensions -$re =~ s/\\l/[a-z±æê³ñ󶌿]/g; #lowercase letter -$re =~ s/\\L/[A-Z¡ÆÊ£ÑÓŠ¬¯]/g; #upercase letter - -my $sedcommand; -my $grepcommand; - -#now we must built a sed script from our re -#we do this by cuting our re each tag until we cut them all -#if an user dint input any tags we do our default -my $defBOM = "BOM"; -my $defEOM = "EOM"; -my $defTempTagBeg = "####TempTAGBEG####"; -my $defTempTagEnd = "####TempTAGEND####"; - -if (@tags == 0) -{ - $sedcommand = "sed -r 's/($re)/\\500 $defBOM *\\f\\1###EOM###/g; s/###EOM###([0-9]+)/\\1 00 $defEOM *\\f\\1/g'"; -} -else #we have custom tags -{ - #first tag is easy to tag :) - my $sedscript="sed -r 's/($re)/\\600 $defTempTagBeg *\\f\\1###EOM###/g;s/###EOM###([0-9]+)/\\1 00 $defTempTagEnd *\\f\\1/g;"; - #after first step we have temp tagged parts of input matching re - #now we need to insert our custom tags - #we will find temp tags and process our input - - my $i = 0; - #copy of re which will be cut - my $rec = $re; - my $restre = $re; - - for ($i = 0 ; $i < @tags ; $i++) - { - #re cutting - $rec = cutRe($restre); - $restre = restRe($restre); - if ($rec =~ / *\( *\) */) - { - $sedscript = $sedscript."s/([0-9]+) 00 $defTempTagBeg \\*\\f([0-9]+)/\\2 00 $tags[$i] *\\f\\2 00 $defTempTagBeg *\\f\\2/g;"; - } - else - { - $sedscript = $sedscript."s/[0-9]+ 00 $defTempTagBeg \\*\\f($rec)/\\1###EOM###/g;s/###EOM###([0-9]+)/\\1 00 $tags[$i] *\\f\\1 00 $defTempTagBeg *\\f\\1/g;"; - } - - } - - $sedcommand = $sedscript."s/[0-9]+ 00 $defTempTagBeg \\*\\f//g;s/[0-9]+ 00 $defTempTagEnd \\*\\f//g'"; -} - -if($command) -{ - print $sedcommand."\n"; - exit 0; -} -exec $preproc.$sedcommand.$postproc; Index: src/rm12.sed =================================================================== --- src/rm12.sed (revision 4518a0b7b6b78168b5b4cc330fc97d43cb5c9183) +++ (revision ) @@ -1,10 +1,0 @@ -#!/bin/sed -rf - -#package: UAM Text Tools -#component: rm12 -#version: 1.0 -#author: Tomasz Obrebski - - -/[0-9]+[ \t]+[0-9]+[ \t]+BOS/! -s/[0-9]+[ \t]+[0-9]+[ \t]// Index: src/rs12.c =================================================================== --- src/rs12.c (revision b5884b3fd633a968051fc3f1574733eea13b0230) +++ (revision ) @@ -1,66 +1,0 @@ -#include -#include -#include - -#define MAXLINE 1000 - -int main() -{ - char buf[MAXLINE]; - char outbuf[MAXLINE]; - char form[MAXLINE]; - int len; - int curpos; - int nextpos=0; - int a; - int b; - - while( fgets(buf, MAXLINE, stdin) ) - { - int n = sscanf(buf, "%d %d", &a, &b); - if( 2 == n ) - { - nextpos = a + b; - fputs(buf, stdout); - } - else - { - if( 1 == n ) - { - curpos = a; - sscanf(buf, "%*d %*s %s", form); - } - else - { - curpos = nextpos; - sscanf(buf, "%*s %s", form); - } - - if( '*' == *form ) - { - len = 0; - } - else - { - char *f = form; - for( len = 0; *f; ++f ) - { - if( '\\' != *f) - { - ++len; - } - } - } - - char *buf1 = buf; - while( !isalpha(*buf1) ) - { - ++buf1; - } - sprintf(outbuf, "%04i %02i %s", curpos, len, buf1); - fputs(outbuf, stdout); - nextpos = curpos + len; - } - } - return 0; -} Index: src/sen-nl.sed =================================================================== --- src/sen-nl.sed (revision 743cc4f1c9fc321b759aedbaf8f52e759740d371) +++ (revision ) @@ -1,6 +1,0 @@ -#!/bin/sed -rf - -1 s/^(([0-9]+)[ \t][0-9]+[ \t].*)$/\2 00 BOS \*\n\1/ -t -$! s/(([0-9]+)[ \t][0-9]+[ \t][[:alpha:]]+[ \t]+[[:print:]]*\\n.*)$/\2 00 EOS *\n\2 00 BOS *\n\1/ -$ s/^(([0-9]+) .*)$/\1\n\2 00 EOS */' Index: src/sen.l =================================================================== --- src/sen.l (revision 1e551bdd1bf6aaf003fd1ba34eca63b8fcc7b5ba) +++ (revision ) @@ -1,95 +1,0 @@ -%{ - - void print_EOS(void); - void set_position(void); - - int pos=0; - int len=0; - -%} - -ul [A-Z¡ÆÊ£ÑÓŠ¯¬] -ll [a-z±æê³ñ󶿌] -l ul|ll -n [0-9]+ -s [ \t]+ - - -ab1 (mgr|in¿|prof|hab|doc|dyr|kier|zast) -ab2 (ul|pl|al) - -abrv (ab1|ab2) - -SEG .*\n -N {n}{s}{n}{s}N{s}.*\n -S {n}{s}{n}{s}S{s}.*\n -P {n}{s}{n}{s}P{s}.*\n -W {n}{s}{n}{s}W{s}.*\n -UL {n}{s}{n}{s}W{s}{ul}.*\n -Cap {n}{s}{n}{s}W{s}{ul}{ll}*.*\n -POINT {n}{s}{n}{s}P{s}\.({s}.*)?\n -QMARK {n}{s}{n}{s}P{s}\?({s}.*)?\n -EXCL {n}{s}{n}{s}P{s}\!({s}.*)?\n -DASH {n}{s}{n}{s}P{s}\-({s}.*)?\n -POINTS {POINT}+ - -ABRV {n}{s}{n}{s}W{s}{abrv}({s}.*)?\n - -EOS {POINT}|{POINTS}|{QMARK}|{EXCL} - - -%% - - -{N}({POINT}{N})+ { ECHO; set_position(); } -({UL}{POINT}{S}?)+{Cap} { ECHO; set_position(); } -{ABRV}{POINT} { ECHO; set_position(); } - - -{P}/{S}{DASH} { ECHO; set_position(); print_EOS(); } -{EOS}/{S}({Cap}|{P}|{N}) { ECHO; set_position(); print_EOS(); } - -.* { ECHO; set_position(); } - -<> { printf("%04d 00 EOS *\n",pos+len); exit(1); } - -%% - -int main() -{ - printf("0000 00 BOS *\n"); - yylex(); - return 0; -} - -int yywrap() -{ - return 1; -} - -void set_position() -{ - char *lastseg; - char *tmp; - - yytext[yyleng-1] = '\0'; - - tmp = strrchr(yytext, '\n'); - if( tmp ) - { - lastseg = tmp + 1; - } - else - { - lastseg = yytext; - } - - sscanf(lastseg, "%d %d", &pos, &len); - yytext[yyleng-1] = '\n'; - -} - -void print_EOS() -{ - printf("%04d 00 EOS *\n%04d 00 BOS *\n", pos+len, pos+len); -} Index: src/ser.pl =================================================================== --- src/ser.pl (revision 8c8a2529e10decc5c52225e87ea7fb8ce9bf37bb) +++ (revision ) @@ -1,198 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component: ser (pattern search tool) -#version: 1.0 -#author: Tomasz Obrebski - -use strict; -use Getopt::Long; -use File::Temp; -use File::HomeDir; - -my $LIB_DIR="/usr/local/lib/utt"; -my $systemconfigfile='/usr/local/etc/utt/ser.conf'; -my $userconfigfile=home()."/.utt/ser.conf"; - -Getopt::Long::Configure('no_ignore_case_always'); - -my $help=0; -my $pattern=0; -my $only_matching=0; -my $no_markers=0; -my $macros=0; -my $flextemplate=0; -my $flex=0; -my $morfield='lem'; -my $tags=0; - -#read configuration files########################### -my $file; -foreach $file ($systemconfigfile, $userconfigfile){ - if(open(CONFIG, $file)){ - while () { - chomp; - s/#.*//; - s/^\s+//; - s/\s+$//; - next unless length; - my ($name, $value) = split(/\s*=\s*/, $_, 2); - if(($name eq "pattern")or($name eq "e")){ - $pattern=$value; - } - elsif($name eq "morph"){ - $morfield=$value; - } - elsif(($name eq "only-matching")or($name eq "m")){ - $only_matching=1; - } - elsif(($name eq "no-markers")or($name eq "M")){ - $no_markers=1; - } - elsif($name eq "macros"){ - $macros=$value; - } - elsif($name eq "flex-template"){ - $flextemplate=$value; - } - elsif($name eq "tags"){ - $tags=$value; - } - elsif($name eq "flex"){ - $flex=1; - } - elsif(($name eq "help")or($name eq "h")){ - $help=1; - } - - } - close CONFIG; - } -} -######################################################### - -GetOptions("pattern|e=s" => \$pattern, - "morph=s" => \$morfield, - "only-matching|m" => \$only_matching, - "no-markers|M" => \$no_markers, - "macros=s" => \$macros, - "flex-template=s" => \$flextemplate, - "tags=s" => \$tags, - "flex" => \$flex, - "help|h" => \$help); - -if($help) -{ - print <<'END' -Usage: ser [OPTIONS] [file ..] - -Options: - --help -h Help. - --pattern=PATTERN -e PATTERN Search pattern. - --morph=STRING Field containing morphological information (default 'lem'). - --macros=FILE Read macrodefinitions from FILE. - --flex-template=FILE Read flex code template from FILE. - --tags=STRING Morphosyntactic tag format. - --only-matching -m Print only fragments matching PATTERN. - --no-markers -M Do not print BOM and EOM markers [TODO]. - --flex Print only the generated flex code and exit. -END -; - exit 0; -} - - -die("$0: no pattern given.\n") unless $pattern; - -die("$0: flex template file not found") unless - $flextemplate or - -e "$LIB_DIR/ser.l.template" and $flextemplate="$LIB_DIR/ser.l.template"; - -die("$0: macro file not found") unless - $macros or - -e "$LIB_DIR/terms.m4" and $macros="$LIB_DIR/terms.m4"; - -die("$0: $tags.tag2re program not found") unless - 1; #JAK NAPISAC WARUNEK??? - -die("$0: undefined tagset format (tags option missing)") unless - $tags; - - -#$pattern =~ s/cat\(([^)]+)\)/'cat('.pre($1).')'/ge; -# quoting escaped commas /NIE DZIA£A/ -$pattern =~ s/\\,/\\`\\`\\,''/g; - -# protecting backslash -$pattern =~ s/\\/\\\\\\/g; - -# discarding spaces -$pattern =~ s/\s+/\\`'/g; #` - - -my $flexpattern = `echo \"$pattern\" | m4 --define=ENDOFSEGMENT=\\\\n --define=MORFIELD=$morfield $macros - 2>/dev/null`; - -die("Incorrect pattern (m4).") if $? >> 8; - - -chomp $flexpattern; - -# <> expansion -$flexpattern =~ s/<([^>]+)>/`echo $1 | $tags.tag2re`/ge; - -# restricting the value of the . special symbol -$flexpattern =~ s/\./[^ \\t\\n\\r\\f]/g; - -# perl-like shortcuts for character classes -# perl exact -$flexpattern =~ s/\\s/[ \\t]/g; -$flexpattern =~ s/\\S/[^ \\t\\n\\r\\f]/g; -$flexpattern =~ s/\\d/[0-9]/g; -$flexpattern =~ s/\\D/[^0-9 \\t\\n\\r\\f]/g; -$flexpattern =~ s/\\w/[a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_]/g; -$flexpattern =~ s/\\W/[^a-z±æê³ñ󶌿A-Z¡ÆÊ£ÑÓŠ¬¯0-9_ \\t\\n\\r\\f]/g; -# extensions -$flexpattern =~ s/\\l/[a-z±æê³ñ󶌿]/g; #lowercase letter -$flexpattern =~ s/\\L/[A-Z¡ÆÊ£ÑÓŠ¬¯]/g; #upercase letter - -# protecting slash -$flexpattern =~ s/\//\\\//g; - -my $defaultaction = ($only_matching) ? '' : 'ECHO'; - -# docelowo posrednie pliki powinny byc w jakims tempie !!! - -(undef, my $tmpfile_l) = File::Temp::tempfile(SUFFIX=>'.l'); -(undef, my $tmpfile_c) = File::Temp::tempfile(SUFFIX=>'.c'); -(undef, my $tmpfile_x) = File::Temp::tempfile(); - -# w tych `` nie dziala -#`m4 "--define=PATTERN=$flexpattern" "--define=DEFAULTACTION=$defaultaction" $flextemplate > $tmpfile_l`; - -system "m4 \"--define=PATTERN=$flexpattern\" \"--define=DEFAULTACTION=$defaultaction\" $flextemplate > $tmpfile_l"; - -if($flex) -{ - # w tych `` nie dziala - system "cat $tmpfile_l"; -# if(open(FLEX, $tmpfile_l)) { -# while() { -# print @_; -# } -# close FLEX; -# } -# else { -# print "Unable to open file $tmpfile_l\n"; -# } - exit(0); -} - -`flex -o$tmpfile_c $tmpfile_l`; -`cc -O3 -o $tmpfile_x $tmpfile_c -lfl`; -#`$tmpfile_x`; - -system "$tmpfile_x"; - -unlink $tmpfile_l; -unlink $tmpfile_c; -unlink $tmpfile_x; Index: src/tok_cmdline.ggo =================================================================== --- src/tok_cmdline.ggo (revision 12743b9e8ce96f3f0d743ab0459dacbc0fe2690c) +++ (revision ) @@ -1,4 +1,0 @@ -package "tok" -version "0.1" - -option "interactive" i "Interactive mode." flag off Index: src/uam.tag2re.pl =================================================================== --- src/uam.tag2re.pl (revision a26cf421b204b6586fa67d9ae592df09abca8cc3) +++ (revision ) @@ -1,89 +1,0 @@ -#!/usr/bin/perl - -#package: UAM Text Tools -#component: tags for utt -#version: 1.0 -#author: Tomasz Obrebski - -use strict; -use locale; - -my $input = <>; -chomp $input; - -our $pos_re = qr/(?:[[:upper:]]+)/; -our $attr_re = qr/(?:[[:upper:]]+)/; -our $val_re = qr/(?:[[:lower:][:digit:]+?!*-]|<[^>\n]+>)/; -our $av_re = qr/(?:$attr_re$val_re+)/; -our $avlist_re = qr/(?:$av_re+)/; -our $cat_re = qr/(?:$pos_re(?:\/$avlist_re)?)/; - -print pre($input); - -sub parse ($) -{ - my ($dstr)=@_; - my $avs={}; - my ($cat,$attrlist) = split '/', $dstr; - ATTR: - while( $attrlist =~ /($attr_re)($val_re+)/g ) - { - my ($attrstr,$valstr)=($1,$2); - my %vals; - while($valstr =~ /$val_re/g) - { - my $val = $&; - next ATTR if $val eq '*'; - $val =~ s/^<([[:lower:]])>$/$1/; - $vals{$val}=1; - } - - $avs->{$attrstr} = \%vals; # dlaczego to dziala? %vals jest lokalne - } - [$cat, $avs]; -} - -sub unparse (\@) -{ - my ($cat,$avs)= @{shift @_}; - my $dstr=$cat; - my @attrs = keys %$avs; - if(@attrs) - { - $dstr .= '/'; - for my $attr ( sort @attrs ) - { - $dstr .= $attr . (join '', sort keys %{$avs->{$attr}}); - } - } - $dstr; -} - -sub canonize ($) -{ - unparse @{parse shift} ; -} - -sub pre -{ - my $pos_res = '[[:upper:]]+'; - my $attr_res = '[[:upper:]]+'; - my $val_res = '[[:lower:][:digit:]+?!*-]|<[^>\n[:cntrl:]]+>'; - my $av_res = "$attr_res($val_res)+"; - my $avlist_res = "($av_res)+"; - - my $pat = canonize(shift); - my $ret; - my ($pos,$avlist) = split /\//, $pat; - $ret = $pos.'(\/'; - while ($avlist =~ /($attr_res)(${val_res}+)/g) - { - my $attr = $1; - my $vals = $2; - my $vals = "($val_res)*(".join('|',($vals =~ /$val_res/g)).")($val_res)*"; - $ret .= "($av_res)*$attr$vals"; - } - $ret .= "($av_res)*)?"; - return $ret; -} - Index: src/unfla.sh =================================================================== --- src/unfla.sh (revision 1e572e12c518a2f97f350cb98dcfe5c90e673e48) +++ (revision ) @@ -1,8 +1,0 @@ -#!/bin/sh - -#package: UAM Text Tools -#component: unfla -#version: 1.0 -#author: Tomasz Obrebski - -exec tr '\014' '\012'