• R/O
  • SSH
  • HTTPS

zerochplus: Commit


Commit MetaInfo

Revision522 (tree)
Time2014-07-02 23:23:46
Authoriroiro

Log Message

modified varda.pl 20140702

Change Summary

Incremental Difference

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