| 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 |
} |
} |