82 |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
my $file_FrontPage = "$modifier_dir_data/frontpage.txt"; |
83 |
my $file_conflict = "$modifier_dir_data/conflict.txt"; |
my $file_conflict = "$modifier_dir_data/conflict.txt"; |
84 |
my $file_format = "$modifier_dir_data/format.txt"; |
my $file_format = "$modifier_dir_data/format.txt"; |
85 |
my $url_cgi = 'wiki'; |
my $url_cgi = '/~wakaba/-temp/wiki/wiki'; ## MUST be started from '/' |
86 |
my $url_stylesheet = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle'; |
my $url_stylesheet = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle'; |
87 |
my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />'; |
my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />'; |
88 |
my $maxrecent = 50; |
my $maxrecent = 50; |
177 |
createresult => \&do_createresult, |
createresult => \&do_createresult, |
178 |
FrontPage => \&do_FrontPage, |
FrontPage => \&do_FrontPage, |
179 |
comment => \&do_comment, |
comment => \&do_comment, |
180 |
|
RandomJump => \&do_random_jump, |
181 |
rss => \&do_rss, |
rss => \&do_rss, |
182 |
diff => \&do_diff, |
diff => \&do_diff, |
183 |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
interwikibox => \&do_interwiki_box, # Walrus add (5) |
215 |
## - 'SuikaWiki/0.9' CRLF |
## - 'SuikaWiki/0.9' CRLF |
216 |
## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF |
## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF |
217 |
## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF |
## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF |
218 |
$cf = $1 if $content =~ s#^(?:/\*\s*|\#\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; |
$cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+##s; |
219 |
if ($cf =~ m#^SuikaWiki/0.9(?:$|\s)#) { |
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
220 |
&print_content($content, content_format => $cf, last_modified => $lm); |
&print_content($content, content_format => $cf, last_modified => $lm); |
221 |
print &text_to_html (q([[#comment]])); |
print &text_to_html (q([[#comment]])); |
222 |
} else { |
} else { |
391 |
my $r = ''; |
my $r = ''; |
392 |
foreach my $page (sort keys %database) { |
foreach my $page (sort keys %database) { |
393 |
next if $page eq $RecentChanges; |
next if $page eq $RecentChanges; |
394 |
if ( index ($database{$page}, $word) > 0 |
my $content = $database{$page}; |
395 |
|
$content =~ s/^\#\?[^\x0A\x0D]+//s; |
396 |
|
if ( index ($content, $word) > 0 |
397 |
|| index ($page, $word) > 0 |
|| index ($page, $word) > 0 |
398 |
|| index ($word, $page) > 0 |
|| index ($word, $page) > 0 |
399 |
) { |
) { |
420 |
&print_footer($CreatePage); |
&print_footer($CreatePage); |
421 |
} |
} |
422 |
|
|
423 |
|
sub do_random_jump { |
424 |
|
my @list = keys %database; |
425 |
|
my $name = &encode ($list[rand @list]); |
426 |
|
print "Location: $url_cgi?$name\n"; |
427 |
|
print "\n"; |
428 |
|
} |
429 |
|
|
430 |
sub do_FrontPage { |
sub do_FrontPage { |
431 |
open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); |
open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)"); |
432 |
my $content = join('', <FILE>); |
my $content = join('', <FILE>); |
460 |
Content-Language: $lang |
Content-Language: $lang |
461 |
Content-Style-Type: text/css |
Content-Style-Type: text/css |
462 |
|
|
463 |
|
<!-- |
464 |
<!DOCTYPE html |
<!DOCTYPE html |
465 |
PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" |
466 |
"http://www.w3.org/TR/html4/loose.dtd"> |
"http://www.w3.org/TR/html4/loose.dtd"> + RUBY --> |
467 |
<html lang="$lang"> |
<html lang="$lang"> |
468 |
<head> |
<head> |
469 |
<title>$escapedpage @{[&escape(&get_subjectline($page))]}</title> |
<title>$escapedpage @{[&escape(&get_subjectline($page))]}</title> |
622 |
&back_push('ol', length($1), \@saved, \@result); |
&back_push('ol', length($1), \@saved, \@result); |
623 |
push(@result, '<li>' . &inline($2) . '</li>'); |
push(@result, '<li>' . &inline($2) . '</li>'); |
624 |
} elsif (/^(-{1,6})(.*)/) { |
} elsif (/^(-{1,6})(.*)/) { |
625 |
&back_push('ul', length($1), \@saved, \@result); |
&back_push('ul', length($1), \@saved, \@result); |
626 |
push(@result, '<li>' . &inline($2) . '</li>'); |
my ($pf, $l) = ('', $2); |
627 |
|
if (!$main::_EMBEDED && $l =~ s/^\s*\[([0-9]+)\]//) { |
628 |
|
my $num = 0+$1; |
629 |
|
$pf = qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
630 |
|
} |
631 |
|
push(@result, '<li>' . $pf . &inline ($l) . '</li>'); |
632 |
} elsif (/^:([^:]+):(.*)/) { |
} elsif (/^:([^:]+):(.*)/) { |
633 |
&back_push('dl', 1, \@saved, \@result); |
&back_push('dl', 1, \@saved, \@result); |
634 |
push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>'); |
push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>'); |
667 |
push(@result, join('', '<tr>', @value, '</tr>')); |
push(@result, join('', '<tr>', @value, '</tr>')); |
668 |
# XXXXX |
# XXXXX |
669 |
####### |
####### |
670 |
} elsif (/^\[INS\[/) { |
} elsif (/^\[(INS|DEL|PRE)\[/) { |
671 |
push(@result, "<ins>"); |
push @result, splice (@saved), '<'.lc($1).'>'; |
672 |
} elsif (/^\]INS\]/) { |
unshift @saved, "</p>"; |
673 |
push(@result, "</ins>"); |
push @result, "<p>"; |
674 |
} elsif (/^\[DEL\[/) { |
} elsif (/^\](INS|DEL|PRE)\]/) { |
675 |
push(@result, "<del>"); |
push @result, splice (@saved), '</'.lc($1).'>'; |
676 |
} elsif (/^\]DEL\]/) { |
} elsif (/^\[([0-9]+)\](.*)$/ && !$main::_EMBEDED) { |
677 |
push(@result, "</del>"); |
my $num = 0+$1; |
678 |
} elsif (/^\[PRE\[/) { |
push @result, qq(<a name="anchor-$num" id="anchor-$num" class="anchor">[$num]</a>); |
679 |
push(@result, "<pre>"); |
push @result, &inline ($2); |
|
} elsif (/^\]PRE\]/) { |
|
|
push(@result, "</pre>"); |
|
680 |
} else { |
} else { |
681 |
push(@result, &inline($_)); |
push(@result, &inline($_)); |
682 |
} |
} |
718 |
sub inline { |
sub inline { |
719 |
my ($line) = @_; |
my ($line) = @_; |
720 |
$line = &escape($line); |
$line = &escape($line); |
721 |
|
$line =~ s:\[(INS|DEL|SUP|SUB)\[(.+?)\]\]:<@{[lc $1]}>$2</@{[lc $1]}>:g; |
722 |
|
$line =~ s:\[ABBR\[(.+?)\] \[(.+?)\]\]:<acronym title="$2">$1</acronym>:g; |
723 |
|
$line =~ s:\[RUBY\[(.+?)\] \[(.+?)\]\]:<ruby><rb>$1</rb><rp>(</rp><rt>$2</rt><rp>)</rp></ruby>:g; |
724 |
|
$line =~ s%\[Q\[(.+?)\](?: \[<([\x21-\x5A\x5E-\x7E]+)>\])?\]%「<q@{[$2?qq( cite="$2"):'']}>$1</q>」%g; |
725 |
$line =~ s|'''([^']+?)'''|<strong>$1</strong>|g; |
$line =~ s|'''([^']+?)'''|<strong>$1</strong>|g; |
726 |
$line =~ s|''([^']+?)''|<em>$1</em>|g; |
$line =~ s|''([^']+?)''|<em>$1</em>|g; |
727 |
$line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|<span class="date">$1</span>|g; # Date |
$line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|<span class="date">$1</span>|g; # Date |
729 |
( |
( |
730 |
(?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> |
(?:<(?:mailto|http|https|ftp|urn|news):[\x21-\x7E]*)> |
731 |
| |
| |
732 |
($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
(?:$bracket_name)) # [[likethis]], [[#comment]], [[Friend:remotelink]] |
733 |
| |
|\[\[([^[]+?)]>>([0-9]+)] |
734 |
($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]] |
|>>([0-9]+) |
735 |
#| |
! |
736 |
# ($wiki_name) |
my ($l, $page,$anchor, $anum) = ($1, $3,$4, 0+$5); |
737 |
) |
if ($l) { |
738 |
! |
&make_link($l) |
739 |
&make_link($1) |
} elsif (defined $page) { |
740 |
!gex; |
&make_wikilink ($page, anchor => 0+$anchor); |
741 |
|
} elsif ($anum) { |
742 |
|
qq(<a href="#anchor-$anum" class="wiki-anchor">>>$anum</a>); |
743 |
|
} |
744 |
|
!gex; |
745 |
return $line; |
return $line; |
746 |
} |
} |
747 |
|
|
748 |
|
sub make_wikilink ($%) { |
749 |
|
my ($ename, %option) = @_; |
750 |
|
my $name = &unescape ($ename); |
751 |
|
if ($database{$name}) { |
752 |
|
my $subject = &escape (&get_subjectline ($name, delimiter => '')); |
753 |
|
if ($option{anchor}) { |
754 |
|
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}#anchor-$option{anchor}" class="wiki">$ename>>$option{anchor}</a>); |
755 |
|
} else { |
756 |
|
return qq(<a title="$subject" href="$url_cgi?@{[&encode($name)]}" class="wiki">$ename</a>); |
757 |
|
} |
758 |
|
} else { |
759 |
|
return qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=@{[&escape($name)]}" class="wiki not-exist">$ename<span class="mark">$editchar</span></a>); |
760 |
|
} |
761 |
|
} |
762 |
|
|
763 |
sub make_link { |
sub make_link { |
764 |
my $chunk = shift; |
my $chunk = shift; |
765 |
# Walrus add (3) start |
# Walrus add (3) start |
873 |
} |
} |
874 |
|
|
875 |
sub update_recent_changes { |
sub update_recent_changes { |
876 |
my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}"; |
my $update = "- @{[&get_now]} [[@{[&escape($form{mypage})]}]] @{[&get_subjectline($form{mypage})]}"; |
877 |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
my @oldupdates = split(/\r?\n/, $database{$RecentChanges}); |
878 |
my @updates; |
my @updates; |
879 |
foreach (@oldupdates) { |
foreach (@oldupdates) { |
880 |
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d \[\[(\S+?)\]\]/; |
881 |
my $name = &unarmor_name($1); |
my $name = $1; |
882 |
if (&is_exist_page($name) and ($name ne $form{mypage})) { |
if ($name ne $form{mypage}) { |
883 |
push(@updates, $_); |
push @updates, $_; |
884 |
} |
} |
885 |
} |
} |
886 |
if (&is_exist_page($form{mypage})) { |
if (&is_exist_page($form{mypage})) { |
887 |
unshift(@updates, $update); |
unshift @updates, $update; |
888 |
} |
} |
889 |
splice(@updates, $maxrecent + 1); |
splice(@updates, $maxrecent + 1); |
890 |
$database{$RecentChanges} = join("\n", @updates); |
$database{$RecentChanges} = join("\n", @updates); |
908 |
|
|
909 |
# Get the subject of the page. |
# Get the subject of the page. |
910 |
my $subject = $database{$page}; |
my $subject = $database{$page}; |
911 |
$subject =~ s#^SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
$subject =~ s#^(?:\#\?)?SuikaWiki/0.9[^\x0D\x0A]*[\x0D\x0A]+##s; |
912 |
$subject =~ s/\r?\n.*//s; |
$subject =~ s/\r?\n.*//s; |
913 |
return "$delim$subject".$option{tail}; |
return "$delim$subject".$option{tail}; |
914 |
} |
} |
1167 |
|
|
1168 |
sub get_now { |
sub get_now { |
1169 |
my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); |
my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat); |
1170 |
|
my (@week) = qw(日 月 火 水 木 金 土); |
1171 |
my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); |
my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time); |
1172 |
$year += 1900; |
$year += 1900; |
1173 |
$mon++; |
$mon++; |
1175 |
$day = "0$day" if $day < 10; |
$day = "0$day" if $day < 10; |
1176 |
$hour = "0$hour" if $hour < 10; |
$hour = "0$hour" if $hour < 10; |
1177 |
$min = "0$min" if $min < 10; |
$min = "0$min" if $min < 10; |
1178 |
$sec = "0$sec" if $sec < 10; |
#$sec = "0$sec" if $sec < 10; |
1179 |
$weekday = $week[$weekday]; |
$weekday = $week[$weekday]; |
1180 |
return "$year-$mon-$day ($weekday) $hour:$min:$sec"; |
return "$year-$mon-$day ($weekday) $hour:$min"; |
1181 |
} |
} |
1182 |
|
|
1183 |
# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] |
# [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]] |
1268 |
sub do_comment { |
sub do_comment { |
1269 |
my ($content) = $database{$form{mypage}}; |
my ($content) = $database{$form{mypage}}; |
1270 |
my $datestr = &get_now; |
my $datestr = &get_now; |
1271 |
my $namestr = " ''[[@{[$form{myname}||$DEFAULT_embed_comment_name]}]]'' : "; |
my $namestr = " ''[[@{[$form{myname}||$DEFAULT_embed_comment_name]}]]'': "; |
1272 |
#if ($content =~ s/(\Q$embed_comment\E)/- $datestr$namestr$form{mymsg}\n$1/) { |
my $anchor = 0; |
1273 |
# ; |
$content =~ s/(?:-+\s)?\[([0-9]+)\]/$anchor = $1 if $1 > $anchor; $&/mge; |
1274 |
#} else { |
$anchor++; |
|
# $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/; |
|
|
#} |
|
1275 |
my $i = 1; my $o = 0; |
my $i = 1; my $o = 0; |
1276 |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
$content =~ s{(\Q$embed_comment\E|\Q$embed_rcomment\E)}{ |
1277 |
my $embed = $1; |
my $embed = $1; |
1278 |
if ($i == $form{comment_index}) { |
if ($i == $form{comment_index}) { |
1279 |
if ($embed eq $embed_comment) { |
if ($embed eq $embed_comment) { |
1280 |
$embed = "- $datestr$namestr$form{mymsg}\n$embed"; $o = 1; |
$embed = "- [$anchor] $datestr$namestr$form{mymsg}\n$embed"; $o = 1; |
1281 |
} else { |
} else { |
1282 |
$embed .= "\n- $datestr$namestr$form{mymsg}"; $o = 1; |
$embed .= "\n- [$anchor] $datestr$namestr$form{mymsg}"; $o = 1; |
1283 |
} |
} |
1284 |
} |
} |
1285 |
$i++; $embed; |
$i++; $embed; |
1286 |
}ge; |
}ge; |
1287 |
unless ($o) { |
unless ($o) { |
1288 |
$content .= "- $datestr$namestr$form{mymsg}\n"; |
$content .= "- [$anchor] $datestr$namestr$form{mymsg}\n"; |
1289 |
} |
} |
1290 |
if ($form{mymsg}) { |
if ($form{mymsg}) { |
1291 |
$form{mymsg} = $content; |
$form{mymsg} = $content; |
1301 |
sub embedded_to_html { |
sub embedded_to_html { |
1302 |
my ($embedded) = @_; |
my ($embedded) = @_; |
1303 |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) { |
1304 |
|
unless ($main::_EMBEDED) { |
1305 |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
my $lastmodified = &get_info($form{mypage}, $info_LastModified); |
1306 |
return <<"EOD"; |
return <<"EOD"; |
1307 |
<form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}"> |
<form action="$url_cgi" method="post" id="x-comment-@{[++$CommentIndex]}"> |
1316 |
<input type="submit" value="$resource{commentbutton}"> |
<input type="submit" value="$resource{commentbutton}"> |
1317 |
</form> |
</form> |
1318 |
EOD |
EOD |
1319 |
|
} else { |
1320 |
|
return <<"EOD"; |
1321 |
|
<del><form action="$url_cgi" method="get"> |
1322 |
|
<input type="hidden" name="mycmd" value="read"> |
1323 |
|
<input type="hidden" name="mypage" value="$form{mypage}"> |
1324 |
|
$embed_comment_Name_Prompt |
1325 |
|
<input type="text" name="myname" value="" size="10" disabled="disabled"> |
1326 |
|
<input type="text" name="mymsg" value="" size="60" disabled="disabled"> |
1327 |
|
<input type="submit" value="$resource{commentbutton}" disabled="disabled"> |
1328 |
|
</form></del> |
1329 |
|
EOD |
1330 |
|
} |
1331 |
} elsif ($embedded =~ /$embed_command{searched}/) { |
} elsif ($embedded =~ /$embed_command{searched}/) { |
1332 |
return get_search_result ($1); |
return get_search_result ($1); |
1333 |
# Walrus add (5) start |
# Walrus add (5) start |
1335 |
$_ = &make_interwiki_box($1, $2); |
$_ = &make_interwiki_box($1, $2); |
1336 |
return ($_) ? $_ : $embedded; |
return ($_) ? $_ : $embedded; |
1337 |
# Walrus add (5) end |
# Walrus add (5) end |
1338 |
} else { |
} elsif ($embedded =~ /^\[\[\#embed:(.+)\]\]$/) { |
1339 |
return $embedded; |
my ($name, $r) = ($1, ''); |
1340 |
|
if ($main::_EMBEDED != 1) { |
1341 |
|
my ($content, $cf) = ($database{$name}, 'SuikaWiki/0.9'); |
1342 |
|
$cf = $1 if $content =~ s!^(?:[\#<]\?|/\*\s*)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.][^\x0D\x0A]*)?)[\x0D\x0A]+!!s; |
1343 |
|
if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) { |
1344 |
|
$main::_EMBEDED = 1; |
1345 |
|
$r = &text_to_html ($content, content_format => $cf); |
1346 |
|
$main::_EMBEDED = 0; |
1347 |
|
} elsif (length $content) { |
1348 |
|
$r = "<pre>@{[&escape ($content)]}</pre>"; |
1349 |
|
} else { |
1350 |
|
$r = &text_to_html ("[[$name]]", content_format => 'SuikaWiki/0.9'); |
1351 |
|
} |
1352 |
|
} else { ## nested #EMBED |
1353 |
|
$r = &text_to_html ("[INS[\n[[$name]] の埋め込みは (入り組んでいるので) 解決されませんでした。\n]INS]\n", content_format => 'SuikaWiki/0.9'); |
1354 |
} |
} |
1355 |
|
return qq(<blockquote title="@{[&escape($name)]}">$r</blockquote>); |
1356 |
|
} elsif ($embedded =~ /^\[\[\#randomlink:(.+)\]\]$/) { |
1357 |
|
return qq(<a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">$1</a>); |
1358 |
|
} else { |
1359 |
|
return $embedded; |
1360 |
|
} |
1361 |
} |
} |
1362 |
|
|
1363 |
# Walrus add (5) start |
# Walrus add (5) start |
1508 |
my $count = 0; |
my $count = 0; |
1509 |
foreach (split(/\n/, $recentchanges)) { |
foreach (split(/\n/, $recentchanges)) { |
1510 |
last if ($count >= 15); |
last if ($count >= 15); |
1511 |
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format. |
/^\- \d\d\d\d\-\d\d\-\d\d \([^)]+\) \d\d:\d\d:\d\d (\S+)/; # date format. |
1512 |
my $title = &unarmor_name($1); |
my $title = &unarmor_name($1); |
1513 |
my $escaped_title = &escape($title); |
my $escaped_title = &escape($title); |
1514 |
my $link = $modifier_rss_link . '?' . &encode($title); |
my $link = $modifier_rss_link . '?' . &encode($title); |
1576 |
} |
} |
1577 |
sub get_site_name () { |
sub get_site_name () { |
1578 |
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); |
my @lines = grep /[^#]/, split /[\x0D\x0A]+/, &main::__get_database('RefererSiteName'); |
1579 |
my %item; |
my @item; |
1580 |
for (@lines) { |
for (@lines) { |
1581 |
next if /^#/; |
next if /^#/; |
1582 |
my ($uri, $name) = split /\s+/, $_, 2; |
my ($uri, $name) = split /\s+/, $_, 2; |
1583 |
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
$uri =~ s/\$/\\\$/g; $uri =~ s/\@/\\\@/g; $uri =~ s/\//\\\//g; |
1584 |
$name =~ s![()/\\]!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
$name =~ s!([()/\\])!\\$1!g; $name =~ s/\$([0-9]+)/).__decode (\${$1}).q(/g; |
1585 |
$item{$uri} = qq(q($name)); |
push @item, [$uri, qq(q($name))]; |
1586 |
} |
} |
1587 |
%item; |
@item; |
1588 |
} |
} |
1589 |
|
|
1590 |
sub list_html ($) { |
sub list_html ($) { |
1591 |
my $page = shift; |
my $page = shift; |
1592 |
my %list = get ($page); |
my %list = get ($page); |
1593 |
my $r = ''; |
my $r = ''; |
1594 |
my %name = get_site_name; |
my @name = get_site_name; |
1595 |
for my $uri (sort keys %list) { |
for my $uri (sort keys %list) { |
1596 |
my $title; |
my $title; |
1597 |
for my $regex (keys %name) { |
for my $item (@name) { |
1598 |
if ($uri =~ /$regex/) { |
if ($uri =~ /$item->[0]/) { |
1599 |
$title = $uri; |
$title = $uri; |
1600 |
eval qq{\$title =~ s/^.*$regex.*\$/$name{$regex}/e} or die $@; |
eval qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e} |
1601 |
|
or die $@ ;#. qq{\$title =~ s/^.*$item->[0].*\$/$item->[1]/e}; |
1602 |
last; |
last; |
1603 |
} |
} |
1604 |
} |
} |