granicus.if.org Git - postgresql/blob - contrib/tsearch/makedict/makedict.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use Getopt::Std;
   4 use locale;
   5
   6 my %opt;
   7 getopts('l:he:s:ap:o:m:f', \%opt);
   8
   9 if ( $opt{h} || ! ($opt{e}||$opt{s}) || !$opt{l} ) {
  10         print<<EOT;
  11 Generator of variant of the Lovin's stemmer which
  12 uses a longest match algorithm.
  13
  14 Author Teodor Sigaev <teodor\@stack.net>
  15 Usage:
  16 $0 -l LOCALENAME [ -e FILENAME ] [ -s FILENAME ] [ -p PREFIX ] [ -o FILENAME ] [ -a ] [ -m NUMBER ]
  17 -e FILENAME     - file with endings of word
  18 -s FILENAME     - file with list of stop-word
  19 -o FILENAME     - out file, default STDOUT
  20 -a              - stop-word are strimmed
  21 -p PREFIX       - prefix of function and etc, default strimmed locale
  22 -m NUMBER       - minimal length of rest after semming, default 3
  23 -l LOCALENAME   - name of locale
  24 -f              - do not call tolower for each char
  25 At least one of -e or -s must be defined
  26 EOT
  27 exit;
  28 }
  29
  30 if ( ! defined $opt{p} ) {
  31         $opt{p} = $opt{l};
  32         $opt{p}=~s/[^a-zA-Z0-9_]+//g;
  33 }
  34 $opt{m}=3 if ! defined $opt{m};
  35
  36 my ($enddata,$stopdata) = ('','');
  37 my $maxchild = 0;
  38
  39 if ( $opt{e} ) {
  40         my @tree;
  41         buildtree(\@tree,  $opt{e}, 1);
  42         printstruct( \@tree,  0, \$enddata);
  43         undef @tree;
  44 }
  45
  46 if ( $opt{s} ) {
  47         my @tree;
  48         buildtree(\@tree,  $opt{s}, 0);
  49         printstruct( \@tree,  0, \$stopdata);
  50         undef @tree;
  51 }
  52
  53
  54 die "No data\n" if ( ! (length $enddata || length $stopdata) );
  55
  56 $enddata = "\t{0,0,0,0}" if ( ! length $enddata );
  57 $stopdata = "\t{0,0,0,0}" if ( ! length $stopdata );
  58
  59 my $fh=\*STDOUT;
  60 if ( $opt{o} ) {
  61         open(OUT,">$opt{o}") || die "Can;t open file '$opt{o}' for writing\n";
  62         $fh = \*OUT;
  63 }
  64
  65 my $linktype = 'uint32';
  66 if ( $maxchild <= 0xff ) {
  67         $linktype='uint8';
  68 } elsif (  $maxchild <= 0xffff ) {
  69         $linktype='uint16';
  70 }
  71
  72 my $wherecheck = ( $opt{a} ) ?
  73                 "NULL,\n\t$opt{p}_is_stopword"
  74         :
  75                 "$opt{p}_is_stopword,\n\tNULL";
  76
  77 my ($tolower, $resttolower) = ('','');
  78 if ( ! $opt{f} ) {
  79         $tolower = '*cur = tolower( *cur );';
  80         $resttolower=<<EOT;
  81         while( cur - buf >= 0 ) {
  82                 *cur = tolower(*cur);
  83                 cur--;
  84         }
  85 EOT
  86 }
  87
  88 print {$fh} <<EOT;
  89 /*
  90  * Autogenerated file
  91  *
  92  * Variant of the Lovin's stemmer which uses a longest match algorithm.
  93  * Endings are stored in a suffix tree.
  94  */
  95
  96 #ifdef DICT_BODY
  97 #include <ctype.h>
  98
  99 typedef struct {
 100         uint8   val;
 101         uint8   flag;
 102         uint8   right;
 103         $linktype       child;
 104 } $opt{p}_NODE;
 105
 106 /* is exists left tree ? */
 107 #define L       0x01
 108 /* finish word flag */
 109 #define F       0x02
 110 #define ISLEFT(x)       ((($opt{p}_NODE*)x)->flag & L)
 111 #define ISFINISH(x)     ((($opt{p}_NODE*)x)->flag & F)
 112
 113 #define MINLENREST      $opt{m}
 114
 115 static $opt{p}_NODE $opt{p}_endstree[]={
 116 $enddata
 117 };
 118
 119 static $opt{p}_NODE $opt{p}_stoptree[]={
 120 $stopdata
 121 };
 122
 123 static char*
 124 $opt{p}_stem( void* obj, char *in, int *len ) {
 125         $opt{p}_NODE    *ptr = $opt{p}_endstree;
 126         int     result = 0;
 127         uint8 *buf = (uint8 *)in;
 128         uint8 *cur = buf + (*len) - 1;
 129
 130         while( cur - buf >= MINLENREST ) {
 131                 $tolower
 132                 if ( ptr->val == *cur ) {
 133                         if ( ISFINISH(ptr) ) result = buf + (*len) - cur;
 134                         cur--;
 135                         if ( ! ptr->child ) break;
 136                         ptr += ptr->child;
 137                 } else if ( ptr->val > *cur ) {
 138                         if ( ISLEFT(ptr) )
 139                                 ptr++;
 140                         else
 141                                 break;
 142                 } else {
 143                         if ( ptr->right )
 144                                 ptr += ptr->right;
 145                         else
 146                                 break;
 147                 }
 148         }
 149         $resttolower
 150         *len -= result;
 151         return in;
 152 }
 153
 154 static int
 155 $opt{p}_is_stopword( void *obj, char *in, int len ) {
 156         $opt{p}_NODE    *ptr = $opt{p}_stoptree;
 157         int     result = 0;
 158         uint8 *buf = (uint8 *)in;
 159         uint8 *cur = buf;
 160
 161         while( cur - buf < len ) {
 162                 $tolower
 163                 if ( ptr->val == *cur ) {
 164                         cur++;
 165                         if ( ISFINISH(ptr) ) result = cur - buf;
 166                         if ( ! ptr->child ) break;
 167                         ptr += ptr->child;
 168                 } else if ( ptr->val > *cur ) {
 169                         if ( ISLEFT(ptr) )
 170                                 ptr++;
 171                         else
 172                                 break;
 173                 } else {
 174                         if ( ptr->right )
 175                                 ptr += ptr->right;
 176                         else
 177                                 break;
 178                 }
 179         }
 180         return (result==len) ? 1 : 0;
 181 }
 182
 183 #undef L
 184 #undef F
 185 #undef ISLEFT
 186 #undef ISFINISH
 187 #undef MINLENREST
 188 #endif /* DICT_BODY */
 189
 190 #ifdef DICT_TABLE
 191 TABLE_DICT_START
 192         \"$opt{l}\",
 193         NULL,
 194         NULL,
 195         $opt{p}_stem,
 196         $wherecheck
 197 TABLE_DICT_END
 198 #endif
 199
 200 EOT
 201
 202 close($fh) if ( $fh != \*STDOUT );
 203
 204
 205 sub buildtree {
 206         my ($reftree,$file, $needreverse) = @_;
 207         open(DATA,$file) || die "Can't open file '$file'\n";
 208         while(<DATA>) {
 209                 chomp;
 210                 next if ! length $_;
 211                 $_ = lc($_) if ! $opt{f};
 212                 addtostruct( $reftree, ( $needreverse ) ? scalar(reverse($_)) : $_ );
 213         }
 214         close DATA;
 215 }
 216
 217 sub mkbintree {
 218         my ( $start, $stop, $rprop, $rres) = @_;
 219
 220         my $middle = $start + int( ($stop-$start)/2 );
 221
 222         push( @$rres, $rprop->[$middle] );
 223         my $idx = $#$rres;
 224         $rres->[$idx]{right}=0;
 225         $rres->[$idx]{left}=0;
 226         return 1 if ( $start == $stop );
 227
 228         my $leftsize = 0;
 229         if ( $middle!=$start ) {
 230                 $rres->[$idx]{left}=1;
 231                 $leftsize = mkbintree( $start, $middle-1, $rprop, $rres );
 232                 $rres->[$idx]{right}=$leftsize+1;
 233         } else {
 234                 $rres->[$idx]{right} = 1;
 235         }
 236         return 1 + $leftsize + mkbintree( $middle+1, $stop, $rprop, $rres );
 237 }
 238
 239 sub addtostruct {
 240         my $node = shift;
 241         my ($char, $subval) = split('', shift, 2);
 242         $char = ord( $char );
 243         if ( ! defined $node->[$char] ) {
 244                 $node->[$char] = {};
 245                 $node->[$char]{finish} = length $subval;
 246                 $node->[$char]{child} = [];
 247         } elsif ( ! length $subval ) {
 248                 $node->[$char]{finish} = 0;
 249         }
 250
 251         addtostruct( $node->[$char]{child}, $subval ) if ( length $subval );
 252 }
 253
 254 sub printstruct {
 255         my ($node, $pre, $refout) = @_;
 256         my $add = 0;
 257         my @prop;
 258         my $outchild;
 259         my $current = 0;
 260         my $poschild=0;
 261         my @tmp;
 262
 263         foreach my $i ( 0..255 ) {
 264                 next if ( !defined $node->[ $i ] );
 265                 push @prop , { val=>$i,
 266                         nchild=>printstruct( $node->[ $i ]{child}, 1, \$outchild ),
 267                         poschild=>$poschild };
 268                 $poschild += $prop[$#prop]{nchild};
 269         }
 270
 271         return 0 if $#prop < 0;
 272         if ($pre) {
 273                 $$refout .= ",\n\n";
 274         }
 275         mkbintree(0,$#prop,\@prop,\@tmp);
 276         @prop = @tmp;
 277
 278         $current=$#prop+1;
 279         foreach my $i ( 0..$#prop ) {
 280                 my $flag = ($prop[$i]{left}) ? 'L' : undef;
 281                 if ( $node->[ $prop[$i]{val} ]{finish}==0 ) {
 282                         $flag .= '|' if defined $flag;
 283                         $flag .= 'F';
 284                 } elsif ( ! defined $flag ) {
 285                         $flag='0';
 286                 }
 287                 $$refout .= "\t{'".chr( $prop[$i]{val} )."',".
 288                                 $flag.','.
 289                                 $prop[$i]{right}.','.
 290                                 (($prop[$i]{nchild}==0)?0:($prop[$i]{poschild}+$current)).'}'.
 291                                 (($i==$#prop)? '' : ",\n");
 292
 293                 $maxchild = $prop[$i]{poschild}+$current if
 294                         ( $prop[$i]{nchild} && $prop[$i]{poschild}+$current > $maxchild );
 295                 $current--;
 296                 $add += $prop[$i]{nchild};
 297         }
 298         $$refout .= $outchild;
 299         return $#prop+1 + $add;
 300 }
 301
 302
 303