#!/usr/bin/perl 
#-- -*- coding:utf-8 -*-

#use DB_File;
#use GDBM_File;
use SDBM_File;

sub lengthu8 {
    my($utfstring) = shift;
    my($i, $charcount, $byte1);

    $i = 0; $charcount = 0;
    while ($i < length($utfstring)) {
	$byte1 = substr($utfstring, $i, 1);
	if (unpack("C", $byte1) <= 0x7F) { # 1 byte long (ASCII)
	    $i++;
	    $charcount++;
	} elsif ((unpack("C", $byte1) & 0xE0) == 0xC0) { # 2 bytes long
	    $i += 2;
	    $charcount++;
	} else {  # 3 bytes long
	    $i += 3;
	    $charcount++;
	}
    }
    return $charcount;
}

sub substru8 {
    my($utfstring, $start, $span) = @_;
    my($i, $charcount, $bytestart, $bytespan, $byte1);
    #print "START $start SPAN $span\n";

    $i = 0; $charcount = 0;
    while ($i < length($utfstring)) {
	if ($charcount == $start) { $bytestart = $i; }
	if ($charcount == ($start+$span)) { $bytespan = $i - $bytestart; }
	$byte1 = substr($utfstring, $i, 1);
	if (unpack("C", $byte1) <= 0x7F) { # 1 byte long (ASCII)
	    $i++;
	    $charcount++;
	} elsif ((unpack("C", $byte1) & 0xE0) == 0xC0) { # 2 bytes long
	    $i += 2;
	    $charcount++;
	} else {  # 3 bytes long
	    $i += 3;
	    $charcount++;
	}
    }

    if ($charcount == ($start+$span)) { $bytespan = $i - $bytestart; }
    #print "bytestart $bytestart bytespan $bytespan\n";
    return substr($utfstring, $bytestart, $bytespan);

}


sub byfreq {
    my($apy) = ($a =~ m/^\[([^\]]+)\]/);
    my($bpy) = ($b =~ m/^\[([^\]]+)\]/);

    $charpy{"$sortchar:$bpy"} <=> $charpy{"$sortchar:$apy"} ||
        $apy cmp $bpy;
}


sub init_cedict {
    my $dictfile = "cedict_ts.u8";
    my $dbfile = "data/cedict_ts.u8.db";
    my($i);

    #print "In init cedict\n";
    #print "Checking db age\n";

    if (-e "$dbfile.pag") {
	my $textfiletime = -M "$dictfile";
	my $dbmfiletime = -M "$dbfile.pag";
	if ($textfiletime > $dbmfiletime) {
	    #print STDOUT "DBM file exists, use it ...\n";
	    dbmopen(%cwords,"$dbfile",0644) || die "Cannot open dbmfile $dbfile\n";
	    #print "after\n"; print $cwords{"中国"} . "\n";
	    return;
	} else {
	    print STDOUT "dbm file older than text file ...\n";
	}
	    
    }

    open(UPY, "uni8py.txt") or die "Can't open dictionary\n";
    while (<UPY>) {
        s/[\r\n]*$//;
        my($u8char, $py) = split;
        my(@pys) = split(/\s/, $py);
        my $freq = scalar(@pys); 
        for ($i = 0; $i < @pys; $i++) {
          $charpy{"$u8char:$py"} = $freq-$i;
        }
    }
    close(UPY);



    print STDOUT "Making DBM file $dbfile ...\n";
    dbmopen(%cwords,"$dbfile",0666) || print "Cannot open dbmfile $dbfile";
    %cwords = ();
    open(DICT,"$dictfile") || die "Dictionary file $dictfile not found";
    print STDOUT "Reading frequency dictionary $dictfile ...\n";
    my($count) = 0;
    while ($line = <DICT>) {
	last if $count > 10000;
	print "$count\n" if $count % 100 == 0;
	$line =~ s/[\r\n]*$//;
	next if $line =~ /^\#/; 
	$line =~ s/\s*$//;
	($trad, $simp, $rest) = split(/\s+/, $line, 3);
	#print "$line<br>";
        if ($trad eq $simp) {
            if (defined($cwords{$trad})) { $cwords{$trad} .= "\t"; }
	    $cwords{$trad} .= $rest;
            if (lengthu8($trad) == 1) { $singlechars{$trad} = 1; }         
        } else {
            if (defined($cwords{$trad})) { $cwords{$trad} .= "\t"; }
	    $cwords{$trad} .= $rest;
            if (defined($cwords{$simp})) { $cwords{$simp} .= "\t"; }
	    $cwords{$simp} .= $rest;
            if (lengthu8($trad) == 1) { $singlechars{$trad} = 1; $singlechars{$simp} = 1; }         
	}
	$count++;
    }
    close(DICT);

    foreach $singlechar (keys %singlechars) {
       $def = $cwords{$singlechar};
       if ($def =~ m/\t/) {
          @defs = split(/\t/, $def);
          $sortchar = $singlechar;
          @defs = sort byfreq @defs;
          $sorteddef = join("\t", @defs);
          if ($def ne $sorteddef) { $cwords{$singlechar} = $sorteddef; }
       }
    }
    
            
    print STDOUT "Making DBM file finished.\n";

}

# Numbers
$numbers  = "零○一二三四五六七八九十百千萬万亿億０１２３４５６７８９．点第";
$numbers .= "多半数几俩卅两壹贰叁肆伍陆柒捌玖拾伯仟";
for ($n = 0; $n < lengthu8($numbers); $n++) {
    $cnumbers{substru8($numbers, $n, 1)} = 1;
}

# Wide ASCII words
$wascii  = "ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ．";
$wascii .= "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ－";
$wascii .= "";
for ($n = 0; $n < lengthu8($wascii); $n++) {
    $cascii{substru8($wascii, $n, 1)} = 1;
}

# Foreign name transliteration characters
$foreign  = "阿埃艾爱安奥澳巴贝本比宾波博伯卜布茨达大戴德登迪蒂丁都多俄厄尔法菲费芬";
$foreign .= "夫福弗佛盖冈哥戈格根古哈海合赫胡华霍基吉及加伽贾杰金喀卡凯柯科可克库拉";
$foreign .= "莱来赖兰劳勒雷累黎里利烈林卢鲁伦罗洛马麦迈曼蒙米摩莫墨姆穆那纳乃";
$foreign .= "内尼努诺帕佩蓬皮匹普奇齐乔切冉萨塞桑森沙舍什史士斯索塔泰坦特图土托瓦万";
$foreign .= "维温沃乌伍西希谢辛休逊雅亚延耶伊印尤泽扎詹诸兹腓胥";
for ($n = 0; $n < lengthu8($foreign); $n++) {
    $cforeign{substru8($foreign, $n, 1)} = 1;
}

#Chinese surnames
$surname  = "艾安敖白班包宝保鲍贝毕边卞柏卜蔡曹岑柴昌常陈程迟池褚楚";
$surname .= "储淳崔戴刀邓狄刁丁董窦杜端段樊范方房斐费丰封冯凤伏福傅盖甘";
$surname .= "高戈耿龚宫勾苟辜谷古顾官关管桂郭杭郝禾何贺赫衡洪侯胡花";
$surname .= "华黄霍稽姬吉纪季贾简翦姜江蒋焦晋金靳荆居康柯空孔匡邝况蓝";
$surname .= "郎朗劳乐雷冷黎李理厉利励廉练良梁廖林凌刘柳隆龙楼娄卢吕鲁";
$surname .= "陆伦罗洛骆麻马麦满茅毛梅孟米苗缪闵莫牟穆倪聂钮农潘庞";
$surname .= "裴彭皮朴平蒲溥浦戚祁齐钱强乔秦丘邱仇裘屈瞿冉饶任荣容阮";
$surname .= "瑞芮萨赛沙单商邵佘申沈盛石史寿舒斯宋苏孙邰谭谈汤唐陶滕";
$surname .= "田佟仝屠涂万汪王危韦魏卫蔚温闻翁巫邬伍武吴奚习夏鲜冼";
$surname .= "项萧解谢辛邢幸熊徐许宣薛荀颜阎言严彦晏燕杨阳姚叶蚁易殷银尹";
$surname .= "游尤於鱼虞俞余禹喻郁尉元袁岳云臧曾查翟詹湛张章招赵甄";
$surname .= "郑钟周诸朱竺祝庄卓宗邹祖左";
$uncommonsurname = "车成全韩赖连路明牛权时水文席应英于";  # 和同
for ($n = 0; $n < lengthu8($surname); $n++) {
    $csurname{substru8($surname, $n, 1)} = 1;
}
for ($n = 0; $n < lengthu8($uncommonsurname); $n++) {
    $uncommoncsurname{substru8($uncommonsurname, $n, 1)} = 1;
}

# Add in 2 character surnames; also add to lexicon so they'll be segmented as one unit
$csurname{"东郭"} = 1; $cwords{"东郭"} = 1;
$csurname{"公孙"} = 1; $cwords{"公孙"} = 1;
$csurname{"皇甫"} = 1; $cwords{"皇甫"} = 1;
$csurname{"慕容"} = 1; $cwords{"慕容"} = 1;
$csurname{"欧阳"} = 1; $cwords{"欧阳"} = 1;
$csurname{"单于"} = 1; $cwords{"单于"} = 1;
$csurname{"司空"} = 1; $cwords{"司空"} = 1;
$csurname{"司马"} = 1; $cwords{"司马"} = 1;
$csurname{"司徒"} = 1; $cwords{"司徒"} = 1;
$csurname{"澹台"} = 1; $cwords{"澹台"} = 1;
$csurname{"诸葛"} = 1; $cwords{"诸葛"} = 1;

$punctuation .= "、：，。★〖〗（）⊙～【】「」―・？！“”　";

#Not in name
$notname  = "的说对在和是被最所那这有将会与於他为镇";
$notname .= $punctuation;
for ($n = 0; $n < lengthu8($notname); $n++) {
    $cnotname{substru8($notname, $n, 1)} = 1;
}




sub isChinese {
    my($cchar) = shift;
    my($b);
    for ($b = 0; $b < length($cchar); $b++) {
	if (unpack("C", substr($cchar, $b, 1)) < 128) {
	    return 0;
	} 
    }
    return 1;
}



sub isNumber {
    my($localnum) = shift;
    my($k);
    if ($localnum =~ m/^[0-9][0-9]*(\.[0-9]+)?$/) {
	return 1;
    }
    for ($k = 0; $k < lengthu8($localnum); $k++) {
	if (!defined($cnumbers{substru8($localnum, $k, 1)})) {
	    return 0;
	}
    }
    return 1;
}


sub isAllWideASCII {
    my($localstr) = shift;
    my($k);
    for ($k = 0; $k < lengthu8($localstr); $k++) {
	if (!defined($cascii{substru8($localstr, $k, 1)})) {
	    return 0;
	}
    }
    return 1;
}

sub isAllForeign {
    my($localstr) = shift;
    my($k);
    for ($k = 0; $k < lengthu8($localstr); $k++) {
	if (!defined($cforeign{substru8($localstr, $k, 1)})) {
	    return 0;
	}
    }
    return 1;
}


 # Takes a Chinese string, returns string with separator inserted between each Chinese word
sub segmentLine {
   my($cline) = shift;
   my($separator) = " "; 
   my($segline); # = $cline;

   &segmentLineOffsets($cline);
   my($i);
   my($seplen) = length($separator);

#    for ($i = 0; $i < @offsets; $i++) {
#        if ($offsets[$i] > 0) {
#           print "$i " . substru8($cline, $i, $offsets[$i]) . "\n";
#        }
#    }

   for ($i = 0; $i < @offsets; $i++) {
       if ($offsets[$i] > 0) {
	   $segline .= substru8($cline, $i, $offsets[$i]);
	   if ($i+$offsets[$i] != lengthu8($cline) &&
	       substru8($cline, $i, $seplen) ne $separator &&
	       substru8($cline, $i+$offsets[$i], $seplen) ne $separator) {
	       $segline .= $separator;
	   }
       }
   }
   return $segline;
}



sub segmentLineOffsets {
   my($cline) = shift;
   #my(@offsets);
   @offsets = ();

   my($clength) = &lengthu8($cline);
   my($i) = 0;
   my($j, $tmpoffset);
   while ($i < $clength) {
       #print STDERR "$i\n";
       if (isChinese(substru8($cline, $i, 1))) { # Group defined words
	   $j = 8;
	   if ($i+$j > $clength) { $j = $clength - $i; }
	   for (; $i+$j <= $clength && $j > 1; $j--) {
	       if (defined($cwords{substru8($cline, $i, $j)})) { 
		   last;
	       }
	   }
	   $offsets[$i] = $j;
	   $i += $j;
       } elsif (isAllWideASCII(substru8($cline, $i, 1))) { # Group wide ASCII 
	   $j=1;
	   while ($i+$j < $clength && isAllWideASCII(substru8($cline, $i+$j, 1))) {
	       $j++;
	   }
	   $offsets[$i] = $j;
	   $i += $j;
       } elsif (substru8($cline, $i, 1) =~ m/^\s$/) { # Group spaces
	   $j=1;
	   while ($i+$j < $clength && substru8($cline, $i+$j, 1) =~ m/^\s$/) {
	       $j++;
	   }
	   $offsets[$i] = $j;
	   $i += $j;
       } elsif (substru8($cline, $i, 1) =~ m/^[a-zA-Z]$/) { # Group letters
	   $j=1;
	   while ($i+$j < $clength && substru8($cline, $i+$j, 1) =~ m/^[a-zA-Z]$/) {
	       $j++;
	   }
	   $offsets[$i] = $j;
	   $i += $j;
       } elsif (substru8($cline, $i, 1) =~ m/^\d$/) { # Group digits
	   $j=1;
	   while ($i+$j < $clength && substru8($cline, $i+$j, 1) =~ m/^\d$/) {
	       $j++;
	   }
	   $offsets[$i] = $j;
	   $i += $j;
       } else {
	   $offsets[$i] = 1;
	   $i++;
       }
   }

   # Add in foreign transliterations
   $i = 0;
   while ($i < $clength) {
       #print STDERR "FOR $i\n";
       if ($offsets[$i] > 0 ) {
	   # Possibly a transliteration of a foreign name
	   while ($i+$offsets[$i] < $clength &&
		  $i+$offsets[$i]+$offsets[$i+$offsets[$i]] < $clength &&
		  $offsets[$i+$offsets[$i]] == 1 &&
		  &isAllForeign(substru8($cline, $i, $offsets[$i]+$offsets[$i+$offsets[$i]]))) {
	       $tmpoffset = $offsets[$i+$offsets[$i]];
	       $offsets[$i+$offsets[$i]] = 0;
	       $offsets[$i] = $offsets[$i] + $tmpoffset;
	   }
       }
       $i++;
   }
 
   #return;

   #if (debug) System.out.println("Grouping numbers");
   # Concatenate numbers
   $i = 0;
   while ($i < $clength) {
       #print STDERR "NUM $i\n";
       if ($offsets[$i] > 0)   {
	   # Add in numbers
	   while ($i+$offsets[$i] < $clength &&
		  $i+$offsets[$i]+$offsets[$i+$offsets[$i]] < $clength &&
		  &isNumber(substru8($cline, $i, $offsets[$i]+$offsets[$i+$offsets[$i]]))) {
	       $tmpoffset = $offsets[$i+$offsets[$i]];
	       $offsets[$i+$offsets[$i]] = 0;
	       $offsets[$i] = $offsets[$i] + $tmpoffset;
	       #print STDERR "NUM $i $tmpoffset $offsets[$i]\n";
	   }
       }
       $i++;
   }
   
   #return offsets;
}


1;