lib/Wiki/InterWiki.pm

   1 ###############################################################################
   2 #
   3 # InterWikiName¤Î¥Ñ¡¼¥µ
   4 #
   5 ###############################################################################
   6 package Wiki::InterWiki;
   7 use strict;
   8
   9 #==============================================================================
  10 # ¥³¥ó¥¹¥È¥é¥¯¥¿
  11 #==============================================================================
  12 sub new {
  13         my $class = shift;
  14         my $wiki  = shift;
  15         my $self  = {};
  16
  17         $self->{wiki} = $wiki;
  18         $self->{interwiki} = [];
  19         bless $self,$class;
  20
  21         $self->_parse();
  22         $self->_add_children($wiki);
  23
  24         return bless $self;
  25 }
  26
  27 #==============================================================================
  28 # »ÒWiki¤òInterWiki¤ËÄÉ²Ã
  29 #==============================================================================
  30 sub _add_children {
  31         my $self = shift;
  32         my $wiki = shift;
  33
  34         eval {
  35                 my @children = $wiki->get_wiki_list();
  36                 $self->_add_child($wiki,"",@children);
  37         }
  38 }
  39 #==============================================================================
  40 # »ÒWiki¤òInterWiki¤ËÄÉ²Ã¡ÊºÆµ¢Åª¤Ëcall¤µ¤ì¤ë¥á¥½¥Ã¥É¡Ë
  41 #==============================================================================
  42 sub _add_child {
  43         my $self   = shift;
  44         my $wiki   = shift;
  45         my $parent = shift;
  46         my @items  = @_;
  47         my $prev   = "";
  48
  49         foreach my $item (@items){
  50                 if(ref($item) eq "ARRAY"){
  51                         if($parent eq ""){
  52                                 $self->_add_child($wiki,"$prev",@$item);
  53                         } else {
  54                                 $self->_add_child($wiki,"$parent/$prev",@$item);
  55                         }
  56                 } else {
  57                         if($parent eq ""){
  58                                 $self->add_inter_wiki($wiki->config('script_name')."/$item?page=","$item");
  59                         } else {
  60                                 $self->add_inter_wiki($wiki->config('script_name')."/$parent/$item?page=","$parent/$item");
  61                         }
  62                         $prev = $item;
  63                 }
  64         }
  65 }
  66
  67 #==============================================================================
  68 # ¥Ñ¡¼¥¹¡Ê¥³¥ó¥¹¥È¥é¥¯¥¿¤«¤é¸Æ¤Ð¤ì¤Þ¤¹¡Ë
  69 #==============================================================================
  70 sub _parse {
  71         my $self = shift;
  72         my $wiki = $self->{wiki};
  73         if($wiki->page_exists("InterWikiName")){
  74                 my $source = $wiki->get_page("InterWikiName");
  75                 $source =~ s/\r//g;
  76                 my @lines = split(/\n/,$source);
  77                 foreach my $line (@lines){
  78                         if(index($line,"*")==0){
  79                                 $self->_parse_line($line);
  80                         }
  81                 }
  82         }
  83 }
  84
  85 #==============================================================================
  86 # £±¹Ô¤ò¥Ñ¡¼¥¹
  87 #==============================================================================
  88 sub _parse_line {
  89         my $self   = shift;
  90         my $source = shift;
  91         # ÊÌÌ¾¥ê¥ó¥¯
  92         if ($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[\w\.,%~^+\-%\/\?\(\)!\$&=:;\*#\@']*)\]\s*([\w\-]+)/
  93          || $source =~ /\[([^\[]+?)\|((file:[^\[\]]*))\]\s*([\w\-]+)/
  94          || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[\w\.,%~^+\-%\/\?\(\)!\$&=:;\*#\@']*)\]\s*([\w\-]+)/) {
  95                 my $label = $1;
  96                 my $url   = $2;
  97                 my $enc   = $4;
  98                 $self->add_inter_wiki($url,$label,$enc);
  99         }
 100         # Ê¸»ú¥³¡¼¥É¤Î»ØÄê¤Ê¤·
 101         elsif ($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/
 102             || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/
 103             || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/) {
 104                 my $label = $1;
 105                 my $url   = $2;
 106                 my $enc   = "euc";
 107                 $self->add_inter_wiki($url,$label,$enc);
 108         }
 109         # Ç¤°Õ¤ÎURL¥ê¥ó¥¯
 110         elsif ($source =~ /\[([^\[]+?)\|(.+?)\]\s*([\w\-]+)/) {
 111                 my $label = $1;
 112                 my $url   = $2;
 113                 my $enc   = $3;
 114                 $self->add_inter_wiki($url,$label,$enc);
 115         }
 116         # Ç¤°Õ¤ÎURL¥ê¥ó¥¯(Ê¸»ú¥³¡¼¥É¤Î»ØÄê¤Ê¤·)
 117         elsif ($source =~ /\[([^\[]+?)\|(.+?)\]/) {
 118                 my $label = $1;
 119                 my $url   = $2;
 120                 my $enc   = "euc";
 121                 $self->add_inter_wiki($url,$label,$enc);
 122
 123         }
 124 }
 125
 126 #==============================================================================
 127 # InterWikiName¤òÄÉ²Ã
 128 #==============================================================================
 129 sub add_inter_wiki {
 130         my $self  = shift;
 131         my $url   = shift;
 132         my $label = shift;
 133         my $enc   = shift;
 134
 135         push(@{$self->{interwiki}},{label=>$label,quote=>quotemeta($label),url=>$url,enc=>$enc});
 136 }
 137
 138 #==============================================================================
 139 # InterWikiName¤¬´Þ¤Þ¤ì¤ë¤«¤É¤¦¤«¥Á¥§¥Ã¥¯
 140 #==============================================================================
 141 sub exists_interwiki {
 142         my $self = shift;
 143         my $str  = shift;
 144
 145         return 0 if (not defined $str);
 146
 147         # $str ¤ÎÀèÆ¬¤Ë InterWikiName ¤Ë¤Ê¤ê¤¦¤ë½ñ¼°¤¬¤Ê¤±¤ì¤Ð¡¢µ¶¤òÊÖ¤·¤Æ½ªÎ»
 148         return 0 if (not $str =~ /^\[\[/);
 149
 150         my @keywords = @{ $self->{interwiki} };
 151
 152         # ÄêµÁ¤µ¤ì¤¿Á´¤Æ¤Î InterWikiName ¤Ë¤Ä¤¤¤Æ·«¤êÊÖ¤¹¡£
 153         foreach my $keyword (@keywords) {
 154                 my $label = $keyword->{quote};
 155
 156                 # ÊÌÌ¾¤Ê¤·¤Î InterWikiName
 157                 if ($str =~ /^\[\[$label:(.+?)\]\]/) {
 158                         $self->{g_post} = $';
 159                         my $enc   = $keyword->{enc};
 160                         my $param = $1;
 161                         $self->{g_label} = $keyword->{label}.':'.$param;
 162                         &Jcode::convert(\$param, $enc);
 163                         $self->{g_url} = $keyword->{url}._url_encode($param);
 164                         return 1;
 165                 }
 166
 167                 # ÊÌÌ¾¤¢¤ê¤Î InterWikiName
 168                 elsif ($str =~ /^\[\[([^\[]+?)\|$label:(.+?)\]\]/) {
 169                         $self->{g_post} = $';
 170                         $self->{g_label} = $1;
 171                         my $enc   = $keyword->{enc};
 172                         my $param = $2;
 173                         &Jcode::convert(\$param, $enc);
 174                         $self->{g_url} = $keyword->{url}._url_encode($param);
 175                         return 1;
 176                 }
 177         }
 178         return 0;
 179 }
 180
 181 sub _url_encode {
 182         my $retstr = shift;
 183         $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;
 184         $retstr =~ tr/ /+/;
 185         return $retstr;
 186 }
 187
 188
 189 1;