1###############################################################################
2#
3# ������ɥѡ���
4#
5###############################################################################
6package Wiki::Keyword;
7use strict;
8
9#==============================================================================
10# �����ȥ饯��
11#==============================================================================
12sub new {
13	my $class     = shift;
14	my $wiki      = shift;
15	my $interwiki = shift;
16	my $self      = {};
17
18	$self->{wiki}      = $wiki;
19	$self->{keywords}  = [];
20	$self->{interwiki} = $interwiki;
21
22#	$self->{eucpre}  = qr{(?<!\x8F)};
23#	$self->{eucpost} = qr{(?=
24#		(?:[\xA1-\xFE][\xA1-\xFE])* # JIS X 0208 �� 0ʸ���ʾ�³����
25#		(?:[\x00-\x7F\x8E\x8F]|\z)  # ASCII, SS2, SS3 �ޤ��Ͻ�ü
26#	)}x;
27
28	$self = bless($self,$class);
29	$self->load_keywords();
30
31	return $self;
32}
33
34#==============================================================================
35# ������ɤ��ޤޤ�뤫�ɤ��������å�
36#==============================================================================
37sub exists_keyword {
38	my $self  = shift;
39	my $str   = shift;
40	my $regex = $self->{regex};
41	if($regex eq ""){
42		return 0;
43	}
44	if($str =~ /$regex/){
45		$self->{g_pre}   = $`;
46		$self->{g_post}  = $';
47		$self->{g_label} = $&;
48		$self->{g_url}   = $self->{info_url}->{$&};
49		$self->{g_page}  = $self->{info_page}->{$&};
50		return 1;
51	}
52	return 0;
53}
54
55#==============================================================================
56# ������ɤ���å���ե����뤫���ɤ߹���
57#==============================================================================
58sub load_keywords {
59	my $self = shift;
60	my $wiki = $self->{wiki};
61	$self->{keywords}  = [];
62
63	my $cachefile = $wiki->config('log_dir')."/keywords.cache";
64
65	if (-e $cachefile) {
66		my $buf = &Util::load_config_text(undef, $cachefile);
67		my @lines = split(/\n/,$buf);
68		foreach my $line (@lines) {
69			my @keys = split(/\t/,$line);
70			if ($keys[0] eq "url") {
71				$self->url_anchor($keys[2], $keys[1]);
72			} elsif($wiki->can_show($keys[2])){
73				$self->wiki_anchor($keys[2], $keys[1]);
74			}
75		}
76	} else {
77		$self->parse();
78		$self->save_keywords();
79	}
80
81	# ��®���Τ���ޥå��Ѥξ����ͽ��������Ƥ���
82	my $regex = '';
83	my $url   = {};
84	my $page  = {};
85	foreach my $keyword (@{$self->{keywords}}){
86		if($regex ne ''){
87			$regex = $regex."|";
88		}
89		$regex = $regex.quotemeta($keyword->{word});
90		$url->{$keyword->{word}}  = $keyword->{url};
91		$page->{$keyword->{word}} = $keyword->{page};
92	}
93	$self->{regex}     = $regex;
94	$self->{info_url}  = $url;
95	$self->{info_page} = $page;
96}
97
98#==============================================================================
99# ������ɤΥ���å���ե��������
100#==============================================================================
101sub save_keywords {
102	my $self = shift;
103	my $wiki = $self->{wiki};
104
105	my $cachefile = $wiki->config('log_dir')."/keywords.cache";
106	my $buf = "";
107
108	my @keywords = @{$self->{keywords}};
109
110	foreach my $keyword (@keywords){
111		my $label = $keyword->{word};
112		my $url   = $keyword->{url};
113		my $page  = $keyword->{page};
114		if ($url eq "") {
115			$buf .= "wiki\t$label\t$page\n";
116		} else {
117			$buf .= "url\t$label\t$url\n";
118		}
119	}
120	&Util::save_config_text(undef, $cachefile, $buf);
121}
122
123#==============================================================================
124# �ѡ����ʥ����ȥ饯������ƤФ�ޤ���
125#==============================================================================
126sub parse {
127	my $self = shift;
128	my $wiki = $self->{wiki};
129	$self->{keywords}  = [];
130
131	if($wiki->page_exists("Keyword")){
132		my $source = $wiki->get_page("Keyword");
133		$source =~ s/\r//g;
134		my @lines = split(/\n/,$source);
135		foreach my $line (@lines){
136			if(index($line,"*")==0){
137				$self->parse_line($line);
138			}
139		}
140	}
141
142	# �ڡ����Υ����ȥ����ͭ���ʾ�硢�ڡ���̾�⥭����ɤ˴ޤ�
143	if($self->{wiki}->config('auto_keyword_page')==1){
144		my @pages = $wiki->get_page_list();
145		foreach my $page (@pages){
146			if($self->{wiki}->config('keyword_slash_page') eq "1" || index($page,"/")==-1){
147				$self->parse_line("[[$page|$page]]");
148			}
149		}
150	}
151	# ��Ĺ�ޥå��ˤʤ�褦�˥�����
152	@{$self->{keywords}} = sort {
153		my $len_a = length($a->{word});
154		my $len_b = length($b->{word});
155		return $len_b <=> $len_a;
156	} @{$self->{keywords}};
157}
158
159sub parse_line {
160	my $self   = shift;
161	my $source = shift;
162
163	# ��̾���
164	if($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/
165	|| $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/
166	|| $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/){
167
168		my $label = $1;
169		my $url   = $2;
170		$self->url_anchor($url,$label);
171
172	# InterWiki
173	} elsif($self->{interwiki}->exists_interwiki($source)){
174		my $pre   = $self->{interwiki}->{g_pre};
175		my $post  = $self->{interwiki}->{g_post};
176		my $label = $self->{interwiki}->{g_label};
177		my $url   = $self->{interwiki}->{g_url};
178		$self->url_anchor($url,$label);
179
180	# �ڡ�����̾���
181	} elsif($source =~ /\[\[([^\[]+?)\|(.+?)\]\]/){
182		my $label = $1;
183		my $page  = $2;
184		$self->wiki_anchor($page,$label);
185
186	# Ǥ�դ�URL���
187	} elsif($source =~ /\[([^\[]+?)\|(.+?)\]/){
188		my $label = $1;
189		my $url   = $2;
190		$self->url_anchor($url,$label);
191	}
192}
193
194#==============================================================================
195# URL����
196#==============================================================================
197sub url_anchor {
198	my $self = shift;
199	my $url  = shift;
200	my $name = shift;
201
202	if($name eq ""){
203		$name = $url;
204	}
205	my $keyword = {};
206	$keyword->{word} = $name;
207	$keyword->{url}  = $url;
208	push(@{$self->{keywords}},$keyword);
209}
210
211#==============================================================================
212# Wiki����
213#==============================================================================
214sub wiki_anchor {
215	my $self = shift;
216	my $page = shift;
217	my $name = shift;
218
219	if($name eq ""){
220		$name = $page;
221	}
222	my $keyword = {};
223	$keyword->{word} = $name;
224	$keyword->{page} = $page;
225	push(@{$self->{keywords}},$keyword);
226}
227
2281;
229