
#
# 2ch index compiler lib
#

# 板圧縮モジュールは、ロックされていれば待つ
# インデックスマネージャは、ロックし、ログを待避し、速やかにロックを解く
# assert: ロックをしたり外したりするインスタンスは1つ 
local $fnlock_read='idxc-lock-r';
local $fnlock_write='idxc-lock-w';
local $fnlog='idxc-log';
local $fnlogwork='idxc-log-work';
local $fnlogsub='idxc-log-sub';		# failsafe. ロックされたままなら、ここに流しておく 


# URL 形式は:
# http://qb5.2ch.net/operate/kako/1121/11211/subject.txt
# http://ex11.2ch.net/news4vip/kako/o1126/subject.txt
# この、11211, 1126 を、index_id と称することにする 
# 2階層式にするなら、↓は1 
local $dir_split_is_double=0;

#local $kakobase='/operate/kako/';
local $kakobase='./kako/';

local %indexes;
#local %indextime; #reserved

sub check_lock {
	my $i;
	for($i=0;$i<100;$i++){
		last if(!-e $_[0]);
		select(undef, undef, undef, 0.01);	# wait 10ms
	}
	# print $i*0.01; print "sec waited\n";
	return $i;
}

sub on_thread_retire {
	my $dat_filename=$_[0];		# xxxxxxxx.dat
	my $thread_desc=$_[1];		# yyyyyyyy (zzz)

	my $i=check_lock($fnlock_read);

	open FF,'>'.$fnlock_write;
	close FF;
	open F,'>>'.($i<100? $fnlog:$fnlogsub);
	print F $dat_filename;	print F "\n";
	print F $thread_desc;	print F "\n";
	close F;
	unlink $fnlock_write;
}

# dat_filename から、index_id を生成 
sub make_index_id {
	my $datid=$_[0];
	$datid=~s/^(\d+).*$/$1/o;	# string +0; でもよさそうなもんだが、わんさか警告が出るため 
	use integer;
	if($dir_split_is_double){
		return $datid / 100000;
	} else {
		return $datid / 1000000;
	}
}

# 上記 index_id から、index_path を生成 
sub make_index_path {
	my $index_id=$_[0];

	if($dir_split_is_double){
		use integer;
		my $index_id_upper=$index_id / 10;
		#for debug environment
		mkdir "$kakobase";
		mkdir "$kakobase/$index_id_upper";
		mkdir "$kakobase/$index_id_upper/$index_id";
		return "$kakobase/$index_id_upper/$index_id/subject.txt";
	} else {
		#for debug environment
		mkdir "$kakobase";
		mkdir "$kakobase/o$index_id";
		return "$kakobase/o$index_id/subject.txt";
	}
}


sub compile_index_cycle {

	if(check_lock($fnlock_write) >=100){return;}	#todo ここで引っかかるのはerror 

	open F,'>'.$fnlock_read;
	close F;
	my $b=rename $fnlog, $fnlogwork;
	unlink $fnlock_read;
	return unless($b) ;		#todo たまたま $fnlogwork がなんらかの事故で残っていたら?

	local $_; # failsafe
	use strict 'refs';
	my %touched_indexes;

	open F,$fnlogwork;
	while(my $dat_filename=<F>){
		my $thread_desc=<F>;
		chomp $dat_filename;
		chomp $thread_desc;
		#todo need check sanity

		my $index_id=make_index_id($dat_filename);
		my $index_path=make_index_path($index_id);

		my $ref_idx=$indexes[$index_id];

		if(ref($ref_idx) ne 'HASH'){	# 命令により忘れているか、未ロード 
			$ref_idx={};
			$indexes[$index_id]=$ref_idx;
			# メモリにキャッシュされていなければ、読み込む 
			if(open FI,$index_path){
				while(<FI>){
					if(/^(\d+\.dat)<>(.+)$/o){
						$$ref_idx{$1}=$2;
					}
				}
				close FI;
			}
			printf("%d loaded\n",(keys %$ref_idx) +0);
		}
		$$ref_idx{$dat_filename}=$thread_desc;
		$touched_indexes{$index_id}=1;
	} # end of readloop
	unlink $fnlogwork;

	# todo 他プロセスが、subject.txt にアクセスすることに配慮しなくていいか? 
	for my $k1 (keys %touched_indexes){
		print "writing...";
		open FI,'>'.make_index_path($k1);
		my $v0;
		my $ref_idx=$indexes[$k1];
		for my $k0 (reverse sort keys %$ref_idx){
			$v0=$$ref_idx{$k0};
			print FI "$k0<>$v0\n";
		}
		close FI;
		printf("%d\n",(keys %$ref_idx) +0);
	}

}

# main

if($ARGV[0] eq 'cvt'){
	# 実験用に、問題の、13000 件ある既存のsubject.txt を、$fnlog 形式にする
	while(<STDIN>){
		/^(\d+\.dat)<>(.+)$/o;
		print "$1\n$2\n";
	}
	exit;
}

if($ARGV[0] eq 'svr'){
	# 常駐モジュール。 
	unlink $fnlock_read;
	unlink $fnlock_write;
	unlink $fnlog;
	unlink $fnlogwork;
	while(1){
		compile_index_cycle();
		sleep(5);
	}
}

if($ARGV[0] eq 'cli'){
	# テストモジュール。既存のsubject.txt を読ませる 
	unlink $fnlogsub;
	while(<STDIN>){
		/^(\d+\.dat)<>(.+)$/o;
		on_thread_retire($1,$2);
		print "$1:$2\n";
		select(undef, undef, undef, rand(3)/10);	# wait 0-300msec 
	}
	exit;
}

# sig: Kj5CBppMtU
