OSDN -- オープンソース・ソフトウェアの開発とダウンロード
日本語の翻訳状況 translation status for ja
  • R/O
  • SSH
  • HTTPS

zerochplus: コミット


コミットメタ情報

リビジョン523 (tree)
日時2014-07-07 20:25:08
作者iroiro

ログメッセージ

20140707_varda.pl

変更サマリ

差分

--- codes/20140707_varda.pl (nonexistent)
+++ codes/20140707_varda.pl (revision 523)
@@ -0,0 +1,740 @@
1+#============================================================================================================
2+#
3+# bbs.cgi支援モジュール
4+#
5+#============================================================================================================
6+package VARDA;
7+
8+use strict;
9+use warnings;
10+
11+#------------------------------------------------------------------------------------------------------------
12+#
13+# コンストラクタ
14+# -------------------------------------------------------------------------------------
15+# @param なし
16+# @return モジュールオブジェクト
17+#
18+#------------------------------------------------------------------------------------------------------------
19+sub new
20+{
21+ my $class = shift;
22+
23+ my $obj = {
24+ 'SYS' => undef,
25+ 'SET' => undef,
26+ 'THREADS' => undef,
27+ 'CONV' => undef,
28+ 'BANNER' => undef,
29+ 'CODE' => undef,
30+ };
31+ bless $obj, $class;
32+
33+ return $obj;
34+}
35+
36+#------------------------------------------------------------------------------------------------------------
37+#
38+# 初期化
39+# -------------------------------------------------------------------------------------
40+# @param $Sys MELKOR
41+# @param $Setting ISILDUR
42+# @return なし
43+#
44+#------------------------------------------------------------------------------------------------------------
45+sub Init
46+{
47+ my $this = shift;
48+ my ($Sys, $Setting) = @_;
49+
50+ require './module/baggins.pl';
51+ require './module/galadriel.pl';
52+ require './module/denethor.pl';
53+
54+ # 使用モジュールを設定
55+ $this->{'SYS'} = $Sys;
56+ $this->{'THREADS'} = BILBO->new;
57+ $this->{'CONV'} = GALADRIEL->new;
58+ $this->{'BANNER'} = DENETHOR->new;
59+ $this->{'CODE'} = 'sjis';
60+
61+ if (!defined $Setting) {
62+ require './module/isildur.pl';
63+ $this->{'SET'} = ISILDUR->new;
64+ $this->{'SET'}->Load($Sys);
65+ }
66+ else {
67+ $this->{'SET'} = $Setting;
68+ }
69+
70+ # 情報の読み込み
71+ $this->{'THREADS'}->Load($Sys);
72+ $this->{'BANNER'}->Load($Sys);
73+}
74+
75+#------------------------------------------------------------------------------------------------------------
76+#
77+# index.html生成
78+# -------------------------------------------------------------------------------------
79+# @param なし
80+# @return 生成されたら1を返す
81+#
82+#------------------------------------------------------------------------------------------------------------
83+sub CreateIndex
84+{
85+ my $this = shift;
86+
87+ my $Sys = $this->{'SYS'};
88+ my $Threads = $this->{'THREADS'};
89+ my $bbsSetting = $this->{'SET'};
90+
91+ # CREATEモード、またはスレッドがindex表示範囲内の場合のみindexを更新する
92+ if ($Sys->Equal('MODE', 'CREATE')
93+ || ($Threads->GetPosition($Sys->Get('KEY')) < $bbsSetting->Get('BBS_MAX_MENU_THREAD'))) {
94+
95+ require './module/thorin.pl';
96+ require './module/legolas.pl';
97+ my $Index = THORIN->new;
98+ my $Caption = LEGOLAS->new;
99+
100+ PrintIndexHead($this, $Index, $Caption);
101+ PrintIndexMenu($this, $Index);
102+ PrintIndexPreview($this, $Index);
103+ PrintIndexFoot($this, $Index, $Caption);
104+
105+ my $path = $Sys->Get('BBSPATH') . '/' . $Sys->Get('BBS') . '/index.html';
106+ $Index->Flush(1, $Sys->Get('PM-TXT'), $path);
107+
108+ return 1;
109+ }
110+ return 0;
111+}
112+
113+#------------------------------------------------------------------------------------------------------------
114+#
115+# i/index.html生成
116+# -------------------------------------------------------------------------------------
117+# @param なし
118+# @return なし
119+#
120+#------------------------------------------------------------------------------------------------------------
121+sub CreateIIndex
122+{
123+ my $this = shift;
124+
125+ require './module/thorin.pl';
126+ my $Page = THORIN->new;
127+
128+ # 前準備
129+ my $Sys = $this->{'SYS'};
130+ my $Threads = $this->{'THREADS'};
131+ my $Set = $this->{'SET'};
132+ my $Conv = $this->{'CONV'};
133+ my $bbs = $Sys->Get('BBS');
134+
135+ # HTMLヘッダの出力
136+ my $title = $Set->Get('BBS_TITLE');
137+ my $code = $this->{'CODE'};
138+ $Page->Print("<html><!--nobanner--><head><title>$title</title>");
139+ $Page->Print("<meta http-equiv=Content-Type content=\"text/html;charset=$code\">");
140+ $Page->Print("</head><body><center>$title</center>");
141+
142+ # バナー表示
143+ $this->{'BANNER'}->Print($Page, 100, 3, 1) if ($Sys->Get('BANNER') & 3);
144+
145+ # 全スレッドを取得
146+ my @threadSet = ();
147+ $Threads->GetKeySet('ALL', '', \@threadSet);
148+
149+ # スレッド分だけループをまわす
150+ my $menuNum = $Set->Get('BBS_MAX_MENU_THREAD');
151+ my $resmax = $Sys->Get('RESMAX');
152+ my $i = 0;
153+ my $p = 0;
154+ foreach my $key (@threadSet) {
155+ $i++;
156+ last if ($p >= $menuNum);
157+
158+ my $res = $Threads->Get('RES', $key);
159+ next if ($res >= $resmax);
160+ $p++;
161+
162+ my $name = $Threads->Get('SUBJECT', $key);
163+ my $path = $Conv->CreatePath($Sys, 'O', $bbs, $key, 'l10');
164+
165+ $Page->Print("<a href=\"$path\">$i: $name($res)</a><br> \n");
166+ }
167+
168+ # フッタ部分の出力
169+ my $cgiPath = $Sys->Get('CGIPATH');
170+ my $pathf = "$cgiPath/p.cgi" . ($Sys->Get('PATHKIND') ? "?bbs=$bbs&st=1" : "/$bbs/1");
171+ $Page->Print("<hr>");
172+ $Page->Print("<a href=\"$pathf\">全スレ</a>\n");
173+ $Page->Print("<form action=\"$cgiPath/bbs.cgi?guid=ON\" method=\"POST\">");
174+ $Page->Print("<input type=hidden name=bbs value=$bbs>");
175+ $Page->Print("<input type=hidden name=mb value=on>");
176+ $Page->Print("<input type=hidden name=thread value=on>");
177+ $Page->Print("<input type=submit value=\"スレッド作成\">");
178+ $Page->Print("</form><hr></body></html>\n");
179+
180+ # i/index.htmlに書き込み
181+ my $pathi = $Sys->Get('BBSPATH') . "/$bbs";
182+ $Page->Flush(1, $Sys->Get('PM-TXT'), "$pathi/i/index.html");
183+}
184+
185+#------------------------------------------------------------------------------------------------------------
186+#
187+# subback.html生成
188+# -------------------------------------------------------------------------------------
189+# @param なし
190+# @return なし
191+#
192+#------------------------------------------------------------------------------------------------------------
193+sub CreateSubback
194+{
195+ my $this = shift;
196+
197+ require './module/thorin.pl';
198+ my $Page = THORIN->new;
199+
200+ my $Sys = $this->{'SYS'};
201+ my $Threads = $this->{'THREADS'};
202+ my $Set = $this->{'SET'};
203+ my $Conv = $this->{'CONV'};
204+
205+ require './module/legolas.pl';
206+ my $Caption = LEGOLAS->new;
207+ $Caption->Load($Sys, 'META');
208+
209+ # HTMLヘッダの出力
210+ my $title = $Set->Get('BBS_TITLE');
211+ my $code = $this->{'CODE'};
212+ $Page->Print(<<HTML);
213+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
214+<html lang="ja">
215+<head>
216+
217+ <meta http-equiv="Content-Type" content="text/html;charset=Shift_JIS">
218+
219+HTML
220+
221+ $Caption->Print($Page, undef);
222+
223+ $Page->Print(" <title>$title - スレッド一覧</title>\n\n");
224+ $Page->Print("</head>\n<body>\n\n");
225+
226+ # バナー表示
227+ if ($Sys->Get('BANNER') & 5) {
228+ $this->{'BANNER'}->Print($Page, 100, 2, 0);
229+ }
230+
231+ $Page->Print("<div class=\"threads\">");
232+ $Page->Print("<small>\n");
233+
234+ # 全スレッドを取得
235+ my @threadSet = ();
236+ $Threads->GetKeySet('ALL', '', \@threadSet);
237+
238+ # スレッド分だけループをまわす
239+ my $bbs = $Sys->Get('BBS');
240+ my $max = $Sys->Get('SUBMAX');
241+ my $i = 0;
242+ foreach my $key (@threadSet) {
243+ last if (++$i > $max);
244+
245+ my $name = $Threads->Get('SUBJECT', $key);
246+ my $res = $Threads->Get('RES', $key);
247+ my $path = $Conv->CreatePath($Sys, 0, $bbs, $key, 'l50');
248+
249+ $Page->Print("<a href=\"$path\" target=\"_blank\">$i: $name($res)</a>&nbsp;&nbsp;\n");
250+ }
251+
252+ # フッタ部分の出力
253+ my $cgipath = $Sys->Get('CGIPATH');
254+ my $version = $Sys->Get('VERSION');
255+ $Page->Print(<<HTML);
256+</small>
257+</div>
258+
259+<div align="right" style="margin-top:1em;">
260+<small><a href="./kako/" target="_blank"><b>過去ログ倉庫はこちら</b></a></small>
261+</div>
262+
263+<hr>
264+
265+<div align="right">
266+$version
267+</div>
268+
269+</body>
270+</html>
271+HTML
272+
273+ # subback.htmlに書き込み
274+ my $paths = $Sys->Get('BBSPATH') . "/$bbs";
275+ $Page->Flush(1, $Sys->Get('PM-TXT'), "$paths/subback.html");
276+}
277+
278+#------------------------------------------------------------------------------------------------------------
279+#
280+# index.html生成(ヘッダ部分)
281+# -------------------------------------------------------------------------------------
282+# @param $Page
283+# @param $Caption
284+# @return なし
285+#
286+#------------------------------------------------------------------------------------------------------------
287+sub PrintIndexHead
288+{
289+ my $this = shift;
290+ my ($Page, $Caption) = @_;
291+
292+ $Caption->Load($this->{'SYS'}, 'META');
293+ my $title = $this->{'SET'}->Get('BBS_TITLE');
294+ my $link = $this->{'SET'}->Get('BBS_TITLE_LINK');
295+ my $image = $this->{'SET'}->Get('BBS_TITLE_PICTURE');
296+# my $code = $this->{'CODE'};
297+
298+ # HTMLヘッダの出力
299+ $Page->Print(<<HEAD);
300+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
301+<html lang="ja">
302+<head>
303+
304+ <meta http-equiv="Content-Type" content="text/html;charset=Shift_JIS">
305+ <meta http-equiv="Content-Script-Type" content="text/javascript">
306+
307+HEAD
308+
309+ $Caption->Print($Page, undef);
310+
311+ $Page->Print(" <title>$title</title>\n\n");
312+
313+ # cookie用scriptの出力
314+ if ($this->{'SET'}->Equal('SUBBBS_CGI_ON', 1)) {
315+ require './module/radagast.pl';
316+ RADAGAST::Print(undef, $Page);
317+ }
318+ $Page->Print("</head>\n<!--nobanner-->\n");
319+
320+ # <body>タグ出力
321+ {
322+ my @work = ();
323+ $work[0] = $this->{'SET'}->Get('BBS_BG_COLOR');
324+ $work[1] = $this->{'SET'}->Get('BBS_TEXT_COLOR');
325+ $work[2] = $this->{'SET'}->Get('BBS_LINK_COLOR');
326+ $work[3] = $this->{'SET'}->Get('BBS_ALINK_COLOR');
327+ $work[4] = $this->{'SET'}->Get('BBS_VLINK_COLOR');
328+ $work[5] = $this->{'SET'}->Get('BBS_BG_PICTURE');
329+
330+ $Page->Print("<body bgcolor=\"$work[0]\" text=\"$work[1]\" link=\"$work[2]\" ");
331+ $Page->Print("alink=\"$work[3]\" vlink=\"$work[4]\" background=\"$work[5]\">\n");
332+
333+ }
334+ $Page->Print("<a name=\"top\"></a>\n");
335+
336+ # 看板画像表示あり
337+ if ($image ne '') {
338+ $Page->Print("<div align=\"center\">");
339+ # 看板画像からのリンクあり
340+ if ($link ne '') {
341+ $Page->Print("<a href=\"$link\"><img src=\"$image\" border=\"0\" alt=\"$link\"></a>");
342+ }
343+ # 看板画像にリンクはなし
344+ else {
345+ $Page->Print("<img src=\"$image\" border=\"0\" alt=\"$link\">");
346+ }
347+ $Page->Print("</div>\n");
348+ }
349+
350+ # ヘッダテーブルの表示
351+ $Caption->Load($this->{'SYS'}, 'HEAD');
352+ $Caption->Print($Page, $this->{'SET'});
353+}
354+
355+#------------------------------------------------------------------------------------------------------------
356+#
357+# index.html生成(スレッドメニュー部分)
358+# -------------------------------------------------------------------------------------
359+# @param $Page
360+# @return なし
361+#
362+#------------------------------------------------------------------------------------------------------------
363+sub PrintIndexMenu
364+{
365+ my $this = shift;
366+ my ($Page) = @_;
367+
368+ my $Conv = $this->{'CONV'};
369+ my $menuCol = $this->{'SET'}->Get('BBS_MENU_COLOR');
370+
371+ # バナーの表示
372+ $this->{'BANNER'}->Print($Page, 95, 0, 0) if ($this->{'SYS'}->Get('BANNER') & 3);
373+
374+ $Page->Print(<<MENU);
375+
376+<a name="menu"></a>
377+<table border="1" cellspacing="7" cellpadding="3" width="95%" bgcolor="$menuCol" style="margin:1.2em auto;" align="center">
378+ <tr>
379+ <td>
380+ <small>
381+MENU
382+
383+ my @threadSet = ();
384+ $this->{'THREADS'}->GetKeySet('ALL', '', \@threadSet);
385+
386+ # スレッド分だけループをまわす
387+ my $prevNum = $this->{'SET'}->Get('BBS_THREAD_NUMBER');
388+ my $menuNum = $this->{'SET'}->Get('BBS_MAX_MENU_THREAD');
389+ my $max = $this->{'SYS'}->Get('SUBMAX');
390+ my $resmax = $this->{'SYS'}->Get('RESMAX');
391+ my $i = 0;
392+ my $p = 0;
393+ foreach my $key (@threadSet) {
394+ last if ((++$i > $menuNum) || ($i > $max));
395+
396+ my $name = $this->{'THREADS'}->Get('SUBJECT', $key);
397+ my $res = $this->{'THREADS'}->Get('RES', $key);
398+ my $path = $Conv->CreatePath($this->{'SYS'}, 0, $this->{'SYS'}->Get('BBS'), $key, 'l50');
399+
400+ # プレビュースレッドの場合はプレビューへのリンクを貼る
401+ if ($p < $prevNum && $res < $resmax) {
402+ $p++;
403+ $Page->Print(" <a href=\"$path\" target=\"body\">$i:</a> ");
404+ $Page->Print("<a href=\"#$p\">$name($res)</a>　\n");
405+ }
406+ else {
407+ $Page->Print(" <a href=\"$path\" target=\"body\">$i: $name($res)</a>　\n");
408+ }
409+ }
410+ $Page->Print(<<MENU);
411+ </small>
412+ <div align="right"><small><b><a href="./subback.html">スレッド一覧はこちら</a></b></small></div>
413+ </td>
414+ </tr>
415+</table>
416+
417+MENU
418+
419+ # サブバナーの表示(表示したら空行をひとつ挿入)
420+ if ($this->{'BANNER'}->PrintSub($Page)) {
421+ $Page->Print("\n");
422+ }
423+}
424+
425+#------------------------------------------------------------------------------------------------------------
426+#
427+# index.html生成(スレッドプレビュー部分)
428+# -------------------------------------------------------------------------------------
429+# @param $Page
430+# @return なし
431+#
432+#------------------------------------------------------------------------------------------------------------
433+sub PrintIndexPreview
434+{
435+ my $this = shift;
436+ my ($Page) = @_;
437+
438+ # 拡張機能ロード
439+ require './module/athelas.pl';
440+ my $Plugin = ATHELAS->new;
441+ $Plugin->Load($this->{'SYS'});
442+
443+ # 有効な拡張機能一覧を取得
444+ my @commands = ();
445+ my @pluginSet = ();
446+ $Plugin->GetKeySet('VALID', 1, \@pluginSet);
447+ my $count = 0;
448+ foreach my $id (@pluginSet) {
449+ # タイプがread.cgiの場合はロードして実行
450+ if ($Plugin->Get('TYPE', $id) & 8) {
451+ my $file = $Plugin->Get('FILE', $id);
452+ my $className = $Plugin->Get('CLASS', $id);
453+ if (-e "./plugin/$file") {
454+ require "./plugin/$file";
455+ my $Config = PLUGINCONF->new($Plugin, $id);
456+ $commands[$count++] = $className->new($Config);
457+ }
458+ }
459+ }
460+
461+ require './module/gondor.pl';
462+ my $Dat = ARAGORN->new;
463+
464+ my @threadSet = ();
465+ $this->{'THREADS'}->GetKeySet('ALL', '', \@threadSet);
466+
467+ # 前準備
468+ my $prevNum = $this->{'SET'}->Get('BBS_THREAD_NUMBER');
469+ my $threadNum = (scalar(@threadSet) > $prevNum ? $prevNum : scalar(@threadSet));
470+ my $tblCol = $this->{'SET'}->Get('BBS_THREAD_COLOR');
471+ my $ttlCol = $this->{'SET'}->Get('BBS_SUBJECT_COLOR');
472+ my $Conv = $this->{'CONV'};
473+ my $basePath = $this->{'SYS'}->Get('BBSPATH') . '/' . $this->{'SYS'}->Get('BBS');
474+ my $max = $this->{'SYS'}->Get('SUBMAX');
475+ my $resmax = $this->{'SYS'}->Get('RESMAX');
476+
477+ my $cnt = 0;
478+ my $p = 0;
479+ foreach my $key (@threadSet) {
480+ last if ($p >= $prevNum || $cnt >= $max);
481+ $cnt++;
482+
483+ my $res = $this->{'THREADS'}->Get('RES', $key);
484+ next if ($res >= $resmax);
485+
486+ $p++;
487+
488+ my $prevT = 1 + ($p - 1 + $prevNum - 1) % $prevNum;
489+ my $nextT = 1 + ($p - 1 + 1) % $prevNum;
490+
491+ my $subject = $this->{'THREADS'}->Get('SUBJECT', $key);
492+
493+ # ヘッダ部分の表示
494+ $Page->Print(<<THREAD);
495+<table border="1" cellspacing="7" cellpadding="3" width="95%" bgcolor="$tblCol" style="margin-bottom:1.2em;" align="center">
496+ <tr>
497+ <td>
498+ <a name="$p"></a>
499+ <div align="right"><a href="#menu">■</a><a href="#$prevT">▲</a><a href="#$nextT">▼</a></div>
500+ <div style="font-weight:bold;margin-bottom:0.2em;">【$cnt:$res】<font size="+2" color="$ttlCol">$subject</font></div>
501+ <dl style="margin-top:0px;">
502+THREAD
503+
504+ # プレビューの表示
505+ my $datPath = "$basePath/dat/$key.dat";
506+ $Dat->Load($this->{'SYS'}, $datPath, 1);
507+ $this->{'SYS'}->Set('_KEY', $key);
508+ PrintThreadPreviewOne($this, $Page, $Dat, \@commands);
509+ $Dat->Close();
510+
511+ # フッタ部分の表示
512+ my $allPath = $Conv->CreatePath($this->{'SYS'}, 0, $this->{'SYS'}->Get('BBS'), $key, '');
513+ my $lastPath = $Conv->CreatePath($this->{'SYS'}, 0, $this->{'SYS'}->Get('BBS'), $key, 'l50');
514+ my $numPath = $Conv->CreatePath($this->{'SYS'}, 0, $this->{'SYS'}->Get('BBS'), $key, '1-100');
515+ $Page->Print(<<KAKIKO);
516+ <div style="font-weight:bold;">
517+ <a href="$allPath">全部読む</a>
518+ <a href="$lastPath">最新50</a>
519+ <a href="$numPath">1-100</a>
520+ <a href="#top">板のトップ</a>
521+ <a href="./">リロード</a>
522+ </div>
523+ </blockquote>
524+ </blockquote>
525+ </form>
526+ </td>
527+ </tr>
528+</table>
529+
530+KAKIKO
531+
532+ }
533+}
534+
535+#------------------------------------------------------------------------------------------------------------
536+#
537+# index.html生成(フッタ部分)
538+# -------------------------------------------------------------------------------------
539+# @param $Page
540+# @param $Caption
541+# @return なし
542+#
543+#------------------------------------------------------------------------------------------------------------
544+sub PrintIndexFoot
545+{
546+ my $this = shift;
547+ my ($Page, $Caption) = @_;
548+
549+ my $Sys = $this->{'SYS'};
550+ my $Set = $this->{'SET'};
551+ my $tblCol = $Set->Get('BBS_MAKETHREAD_COLOR');
552+ my $cgipath = $Sys->Get('CGIPATH');
553+ my $bbs = $Sys->Get('BBS');
554+ my $ver = $Sys->Get('VERSION');
555+ my $samba = int ($Set->Get('BBS_SAMBATIME', '') eq ''
556+ ? $Sys->Get('DEFSAMBA') : $Set->Get('BBS_SAMBATIME'));
557+ my $tm = time;
558+
559+ # スレッド作成画面を別画面で表示
560+ if ($Set->Equal('BBS_PASSWORD_CHECK', 'checked')) {
561+ $Page->Print(<<FORM);
562+<table border="1" cellspacing="7" cellpadding="3" width="95%" bgcolor="$tblCol" align="center">
563+ <tr>
564+ <td>
565+ <form method="POST" action="$cgipath/bbs.cgi?guid=ON" style="margin:1.2em 0;">
566+ <input type="submit" value="新規スレッド作成画面へ"><br>
567+ <input type="hidden" name="bbs" value="$bbs">
568+ <input type="hidden" name="time" value="$tm">
569+ </form>
570+ </td>
571+ </tr>
572+</table>
573+FORM
574+ }
575+ # スレッド作成フォームはindexと同じ画面に表示
576+ else {
577+ $Page->Print(<<FORM);
578+<form method="POST" action="$cgipath/bbs.cgi?guid=ON">
579+<table border="1" cellspacing="7" cellpadding="3" width="95%" bgcolor="#CCFFCC" style="margin-bottom:1.2em;" align="center">
580+ <tr>
581+ <td>&lrm;</td>
582+ <td nowrap>
583+ タイトル：<input type="text" name="subject" size="40"><input type="submit" value="新規スレッド作成"><br>
584+ 名前：<input type="text" name="FROM" size="19"> E-mail：<input type="text" name="mail" size="19"><br>
585+ 内容：<textarea rows="5" cols="60" name="MESSAGE"></textarea>
586+ <input type="hidden" name="bbs" value="$bbs">
587+ <input type="hidden" name="time" value="$tm">
588+ </td>
589+ </tr>
590+</table>
591+</form>
592+FORM
593+ }
594+
595+ # footの表示
596+ $Caption->Load($Sys, 'FOOT');
597+ $Caption->Print($Page, $Set);
598+
599+ $Page->Print(<<FOOT);
600+<div style="margin-top:1.2em;">
601+<a href="http://zerochplus.sourceforge.jp/">ぜろちゃんねるプラス</a>
602+BBS.CGI - $ver (Perl)
603+@{[ $Sys->Get('BBQ') ? '+<a href="http://bbq.uso800.net/" target="_blank">BBQ</a>' : '' ]}
604+@{[ $Sys->Get('BBX') ? '+BBX' : '' ]}
605++Samba24=$samba<br>
606+ページのおしまいだよ。。と</div>
607+
608+FOOT
609+
610+ $Page->Print("</body>\n</html>\n");
611+}
612+
613+#------------------------------------------------------------------------------------------------------------
614+#
615+# index.html生成(スレッドプレビュー部分)
616+# -------------------------------------------------------------------------------------
617+# @param $Page
618+# @param $Dat
619+# @param $commands
620+# @return なし
621+#
622+#------------------------------------------------------------------------------------------------------------
623+sub PrintThreadPreviewOne
624+{
625+ my $this = shift;
626+ my ($Page, $Dat, $commands) = @_;
627+
628+ my $Sys = $this->{'SYS'};
629+
630+ # 前準備
631+ my $contNum = $this->{'SET'}->Get('BBS_CONTENTS_NUMBER');
632+ my $cgiPath = $Sys->Get('SERVER') . $Sys->Get('CGIPATH');
633+ my $bbs = $Sys->Get('BBS');
634+ my $key = $Sys->Get('_KEY');
635+ my $tm = time;
636+
637+ # 表示数の正規化
638+ my ($start, $end) = $this->{'CONV'}->RegularDispNum($Sys, $Dat, 1, $contNum, $contNum);
639+ $start++ if ($start == 1);
640+
641+ # 1の表示
642+ PrintResponse($this, $Page, $Dat, $commands, 1);
643+ # 残りの表示
644+ for (my $i = $start; $i <= $end; $i++) {
645+ PrintResponse($this, $Page, $Dat, $commands, $i);
646+ }
647+
648+ # 書き込みフォームの表示
649+ $Page->Print(<<KAKIKO);
650+ </dl>
651+ <form method="POST" action="$cgiPath/bbs.cgi?guid=ON">
652+ <blockquote>
653+ <input type="hidden" name="bbs" value="$bbs">
654+ <input type="hidden" name="key" value="$key">
655+ <input type="hidden" name="time" value="$tm">
656+ <input type="submit" value="書き込む" name="submit">
657+ 名前：<input type="text" name="FROM" size="19">
658+ E-mail：<input type="text" name="mail" size="19"><br>
659+ <blockquote style="margin-top:0px;">
660+ <textarea rows="5" cols="64" name="MESSAGE"></textarea>
661+KAKIKO
662+
663+}
664+
665+#------------------------------------------------------------------------------------------------------------
666+#
667+# index.html生成(レス表示部分)
668+# -------------------------------------------------------------------------------------
669+# @param $Page
670+# @param $Dat
671+# @param $commands
672+# @param $n
673+# @return なし
674+#
675+#------------------------------------------------------------------------------------------------------------
676+sub PrintResponse
677+{
678+ my $this = shift;
679+ my ($Page, $Dat, $commands, $n) = @_;
680+
681+ my $Sys = $this->{'SYS'};
682+ my $Conv = $this->{'CONV'};
683+
684+ my $pdat = $Dat->Get($n - 1);
685+ return if (!defined $pdat);
686+
687+ my @elem = split(/<>/, $$pdat, -1);
688+ my $contLen = length $elem[3];
689+ my $contLine = $Conv->GetTextLine(\$elem[3]);
690+ my $nameCol = $this->{'SET'}->Get('BBS_NAME_COLOR');
691+ my $dispLine = $this->{'SET'}->Get('BBS_INDEX_LINE_NUMBER');
692+
693+ # URLと引用個所の適応
694+ my $oldkey = $Sys->Get('KEY');
695+ $Sys->Set('KEY', $Sys->Get('_KEY'));
696+ $Conv->ConvertURL($Sys, $this->{'SET'}, 0, \$elem[3]);
697+ $Conv->ConvertQuotation($Sys, \$elem[3], 0);
698+ $Sys->Set('KEY', $oldkey);
699+
700+ # 拡張機能を実行
701+ $Sys->Set('_DAT_', \@elem);
702+ $Sys->Set('_NUM_', $n);
703+ foreach my $command (@$commands) {
704+ $command->execute($this->{'SYS'}, undef, 8);
705+ }
706+
707+ $Page->Print(" <dt>$n 名前：");
708+
709+ # メール欄有り
710+ if ($elem[1] eq '') {
711+ $Page->Print("<font color=\"$nameCol\"><b>$elem[0]</b></font>");
712+ }
713+ # メール欄無し
714+ else {
715+ $Page->Print("<a href=\"mailto:$elem[1]\"><b>$elem[0]</b></a>");
716+ }
717+
718+ # 表示行数内ならすべて表示する
719+ if ($contLine <= $dispLine || $n == 1) {
720+ $Page->Print("：$elem[2]</dt>\n <dd>$elem[3]<br><br></dd>\n");
721+ }
722+ # 表示行数を超えたら省略表示を付加する
723+ else {
724+ my @dispBuff = split(/<br>/i, $elem[3]);
725+ my $path = $Conv->CreatePath($Sys, 0, $Sys->Get('BBS'), $Sys->Get('_KEY'), "${n}n");
726+
727+ $Page->Print("：$elem[2]</dt>\n <dd>");
728+ for (my $k = 0; $k < $dispLine; $k++) {
729+ $Page->Print("$dispBuff[$k]<br>");
730+ }
731+ $Page->Print("<font color=\"green\">（省略されました・・全てを読むには");
732+ $Page->Print("<a href=\"$path\" target=\"_blank\">ここ</a>");
733+ $Page->Print("を押してください）</font><br><br></dd>\n");
734+ }
735+}
736+
737+#============================================================================================================
738+# Module END
739+#============================================================================================================
740+1;
旧リポジトリブラウザで表示