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