From 2a2078146f1e079732cd1a471e064d34a4399890 Mon Sep 17 00:00:00 2001
From: piaip <piaip@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>
Date: Wed, 26 Mar 2008 05:47:01 +0000
Subject: - (internal) directory layout structure finetune

git-svn-id: http://opensvn.csie.org/pttbbs/trunk/pttbbs@4022 63ad8ddf-47c3-0310-b6dd-a9e9d9715204
---
 web/blog/INSTALL    |  79 +++++++++
 web/blog/blog.pl    | 483 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 web/blog/builddb.pl | 247 +++++++++++++++++++++++++++
 web/blog/index.pl   |  17 ++
 4 files changed, 826 insertions(+)
 create mode 100644 web/blog/INSTALL
 create mode 100755 web/blog/blog.pl
 create mode 100755 web/blog/builddb.pl
 create mode 100755 web/blog/index.pl

(limited to 'web/blog')

diff --git a/web/blog/INSTALL b/web/blog/INSTALL
new file mode 100644
index 00000000..1f216292
--- /dev/null
+++ b/web/blog/INSTALL
@@ -0,0 +1,79 @@
+這篇文章在描述怎麼架設 PttBlog, 最後的編修及版號是:
+$Id$
+
+請注意,  PttBlog本來主要是設計給 Ptt2 站台使用, 目前正在開發階段,
+並未接受嚴密的測試, 可能還缺少很多功能, 以及可能有許多的 bug.
+
+您可以按照下列的步驟安裝好 PttBlog.
+1.安裝好下列的東西, 我們並同時列上 FreeBSD ports內的目錄:
+	apache		/usr/ports/www/apache13/
+	perl		/usr/ports/lang/perl5.8/
+	mod_perl	/usr/ports/www/mod_perl/
+	mysql		/usr/ports/databases/mysql323-server/
+
+  以及下列的 module
+	Template	/usr/ports/www/p5-Template-Toolkit/
+	Date::Calc	/usr/ports/devel/p5-Date-Calc/
+	DBI		/usr/ports/databases/p5-DBI/
+	DBD::mysql	/usr/ports/databases/p5-DBD-mysql/
+	MD5		/usr/ports/security/p5-MD5/
+	Mail::Sender	/usr/ports/mail/p5-Mail-Sender/
+	OurNet::FuzzyIndex (還沒有進 ports, 請用 cpan 裝)
+
+2.設定 apache 可以直接透過 mod_perl 來跑 perl script .
+  在您的 apache.conf (or httpd.conf)中, 應該會有:
+	LoadModule perl_module        libexec/apache/libperl.so
+	AddModule mod_perl.c
+  在<IfModule mod_mime.c></IfModule>中間, 加上這兩行:
+	AddHandler perl-script .pl
+	PerlHandler Apache::Registry
+
+3.設定好 blog 的 web目錄. 裡面至少要有 index.pl, blog.pl, LocalVars.pm
+   (其中 LocalVars.pm 建議用 symbolic link 到 /home/bbs/bin/的那一份)
+  其中 *.pl 的權限要是可以執行的 (ex: chmod 755 *.pl)
+
+4.設定 apache 指到 blog 的目錄. 並將該目錄開始 ExecCGI的 option.
+  例如使用 Virtual Host :
+	NameVirtualHost *
+	<VirtualHost *>
+		ServerName	blog.ptt2.cc
+		DocumentRoot	/home/bbs/blog/web
+		<Directory "/home/bbs/blog/web">
+			Options ExecCGI
+		</Directory>
+	</VirtualHost>
+
+5.將 builddb.pl, BBSFileHeader.pm 拷貝進 ~bbs/bin
+  您可以嘗試用 perl -c ~bbs/bin/builddb.pl  測試看看能不能過.
+  若不行的話, 通常是 LocalVars.pm 裡面少東西,
+  請參考 pttbbs/sample/LocalVars.pm 的 blog 區.
+
+6.參考 pttbbs/sample/pttbbs.conf中, 在您的 pttbbs.conf中加入
+  BLOGDB_HOST, BLOGDB_USER, BLOGDB_PASSWD, BLOGDB_DB, BLOGDB_PORT, BLOGDB_SOCK
+  並且重新 compile mbbsd, 在 make 時加入 WITH_BLOG=yes .
+  然後 install 並且 restart
+
+7.關於 Mysql共須要下面兩個 table (可以直接複製過去跑)
+	CREATE TABLE `comment` (
+	  `brdname` varchar(13) NOT NULL default '',
+	  `artid` int(11) NOT NULL default '0',
+	  `name` varchar(32) NOT NULL default '',
+	  `mail` varchar(64) NOT NULL default '',
+	  `content` text NOT NULL,
+	  `mtime` int(11) NOT NULL default '0',
+	  `hash` varchar(32) NOT NULL default ''
+	) TYPE=MyISAM;
+
+	CREATE TABLE `counter` (
+	  `k` char(32) NOT NULL default '',
+	  `v` int(11) NOT NULL default '0',
+	  `mtime` int(11) NOT NULL default '0',
+	  PRIMARY KEY  (`k`)
+	) TYPE=MyISAM;
+
+	CREATE TABLE `wcounter` (
+	  `k` char(32) NOT NULL default '',
+	  `v` int(11) NOT NULL default '0',
+	  `mtime` int(11) NOT NULL default '0',
+	  PRIMARY KEY  (`k`)
+	) TYPE=MyISAM;
diff --git a/web/blog/blog.pl b/web/blog/blog.pl
new file mode 100755
index 00000000..5362f4b5
--- /dev/null
+++ b/web/blog/blog.pl
@@ -0,0 +1,483 @@
+#!/usr/bin/perl
+# $Id$
+use CGI qw/:standard/;
+use lib qw/./;
+use LocalVars;
+use DB_File;
+use strict;
+use Data::Dumper;
+use Date::Calc qw(:all);
+use Template;
+use OurNet::FuzzyIndex;
+use DBI;
+use DBD::mysql;
+use POSIX;
+use MD5;
+use Mail::Sender;
+use Data::Serializer;
+use Encode;
+
+use vars qw/@emonth @cnumber %config %attr %article %th $dbh $brdname/;
+
+sub main
+{
+    my($fn, $y, $m, $d, $ofn);
+    my($tmpl);
+
+    $dbh = undef;
+    @emonth = ('', 'January', 'February', 'March', 'April', 'May',
+	       'June', 'July', 'August', 'September', 'October',
+	       'November', 'December');
+    @cnumber = ('零', '一', '二', '三', '四', '五', '六',
+		'七', '八', '九', '十', '十一', '十二');
+    
+    if( $brdname = param('searchboard') ){
+        dodbi(sub {
+            my($dbh) = @_;
+            my($sth);
+            $sth = $dbh->prepare("select k from counter where k='$brdname'");
+            $sth->execute();
+	    $brdname = (($sth = $sth->fetchrow_hashref()) ?
+			$sth->{k} : 'Blog');
+        });
+        return redirect("/blog.pl/$brdname/");
+    }
+    
+    if( !$ENV{PATH_INFO} ){
+        print header(-status => 400);
+        return;
+    }
+    if( !(($brdname, $ofn) = $ENV{PATH_INFO} =~ m|^/([\w\-]+?)/([\.,\w]*)$|) ||
+	!( ($fn, $y, $m, $d) = parsefn($ofn) )                            ||
+	!(-e "$BLOGDATA/$brdname/$fn")                                    ||
+	!(tie %config, 'DB_File',
+	  "$BLOGDATA/$brdname/config.db", O_RDONLY, 0666, $DB_HASH)       ||
+	!(tie %attr, 'DB_File',
+	  "$BLOGDATA/$brdname/attr.db", O_RDONLY, 0666, $DB_HASH)      ){
+	return redirect("/blog.pl/$1/")
+	    if( $ENV{PATH_INFO} =~ m|^/([\w\-]+?)$| );
+	print header(-status => 404);
+	return;
+    }
+
+    charset('');
+    print header(-type => GetType($fn));
+    $fn ||= 'index.html';
+
+    # first, import all settings in %config
+    %th = %config;
+    $th{BOARDNAME} = $brdname;
+    $th{key} = $y * 10000 + $m * 100 + $d;
+
+    # loadBlog ---------------------------------------------------------------
+    tie %article, 'DB_File', "$BLOGDATA/$brdname.db", O_RDONLY, 0666, $DB_HASH;
+    if( $attr{"$fn.loadBlog"} =~ /article/i ){
+	AddArticle('blog', $attr{"$fn.loadBlogFields"}, packdate($y, $m, $d));
+    }
+    elsif( $attr{"$fn.loadBlog"} =~ /monthly/i ){
+	my($s, $y1, $m1, $d1);
+	for( ($y1, $m1, $d1) = ($y, $m, 32) ; $d1 > 0 ; --$d1 ){
+	    AddArticle('blog', $attr{"$fn.loadBlogFields"},
+		       packdate($y1, $m1, $d1));
+	}
+    }
+    elsif( $attr{"$fn.loadBlog"} =~ /^last(\d+)/i ){
+	my($ptr, $i);
+	for( $ptr = $article{last}, $i = 0 ;
+	     $ptr && $i < $1               ;
+	     $ptr = $article{"$ptr.prev"}, ++$i    ){
+	    AddArticle('blog', $attr{"$fn.loadBlogFields"},
+		       $ptr);
+	}
+    }
+    elsif( $attr{"$fn.loadBlog"} =~ /FuzzySearch/i ){
+	my $idx = OurNet::FuzzyIndex->new("$BLOGDATA/$brdname.idx");
+	my %result = $idx->query($th{SearchKey} = param('SearchKey'),
+				 MATCH_FUZZY);
+	foreach my $t (sort { $result{$b} <=> $result{$a} } keys(%result)) {
+	    AddArticle('blog', $attr{"$fn.loadBlogFields"},
+		       $idx->getkey($t), sprintf("%5.1f", $result{$t} / 10));
+	}
+    }
+
+    if( $attr{"$fn.loadBlogPrevNext"} ){
+	my $s = packdate($y, $m, $d);
+	AddArticle('next', $attr{"$fn.loadBlogPrevNext"},
+		   $article{"$s.next"});
+	AddArticle('prev', $attr{"$fn.loadBlogPrevNext"},
+		   $article{"$s.prev"});
+    }
+
+    # loadArchives -----------------------------------------------------------
+    if( $attr{"$fn.loadArchives"} =~ /^monthly/i ){
+	# 找尋 +-1 year 內有資料的月份
+	my($c, $y1, $m1);
+	for( $c = 0, ($y1, $m1) = ($y + 1, $m) ;
+	     $c < 48                           ;
+	     ++$c, --$m1                         ) {
+
+	    if( $m1 == 0 ){ $m1 = 12; --$y1; }
+	    if( $article{ sprintf('%04d%02d', $y1, $m1) } ){
+		push @{$th{Archives}}, {year   => $y1, month  => $m1,
+					emonth => $emonth[$m1],
+					cmonth => $cnumber[$m1],
+					key    => packdate($y1, $m1, 1)};
+	    }
+	}
+    }
+
+    # loadRecentEntries ------------------------------------------------------
+    if( $attr{"$fn.loadRecentEntries"} ){
+	my($i, $ptr, $y, $m, $d);
+	print $attr{"$fn.loadRecentEntries:"};
+	for( $i = 0, $ptr = $article{'last'}             ;
+	     $ptr && $i < $attr{"$fn.loadRecentEntries"} ;
+	     ++$i, $ptr = $article{"$ptr.prev"}            ){
+	    ($y, $m, $d) = unpackdate($ptr);
+	    push @{$th{RecentEntries}}, {year => $y, month => $m,
+					 emonth => $emonth[$m],
+					 cmonth => $cnumber[$m],
+					 title  => $article{"$ptr.title"},
+					 key => $ptr};
+	}
+    }
+
+    # topBlogs
+    my($t);
+    foreach $t ( ['loadTopBlogs', 'v', 'topBlogs', 'counter'],
+		 ['loadTopWeekBlogs', 'v', 'topWeekBlogs', 'wcounter'],
+		 ['loadRandomBlogs', 'RAND()', 'randomBlogs', 'counter'],
+		 ){
+	if( $attr{"$fn.$t->[0]"} ){
+	    dodbi(sub {
+		my($dbh) = @_;
+		my($sth);
+		$sth = $dbh->prepare("select k, v from $t->[3] ".
+				     "order by $t->[1] desc ".
+				     ($attr{"$fn.$t->[0]"} eq 'all' ? '' :
+				      'limit 0,'. $attr{"$fn.$t->[0]"}));
+		$sth->execute();
+		while( $_  = $sth->fetchrow_hashref() ){
+		    push @{$th{$t->[2]}}, {brdname => $_->{k},
+					   counter => $_->{v}};
+		}
+	    });
+	}
+    }
+
+    # Counter ----------------------------------------------------------------
+    if( $attr{"$fn.loadCounter"} ){
+	$th{counter} = dodbi(sub {
+	    my($dbh) = @_;
+	    my($sth, $t, $time);
+	    $time = time();
+	    $dbh->do("update counter set v = v + 1, mtime = $time ".
+		     "where k = '$brdname' && mtime < ". ($time - 2));
+	    $dbh->do("update wcounter set v = v + 1, mtime = $time ".
+		     "where k = '$brdname' && mtime < ". ($time - 2));
+	    $sth = $dbh->prepare("select v from counter where k='$brdname'");
+	    $sth->execute();
+	    $t = $sth->fetchrow_hashref();
+	    return $t->{v} if( $t->{v} );
+
+	    $dbh->do("insert into counter (k, v) values ('$brdname', 1)");
+	    $dbh->do("insert into wcounter (k, v) values ('$brdname', 1)");
+	    return 1;
+	});
+    }
+
+    # Calendar ---------------------------------------------------------------
+    if( $attr{"$fn.loadCalendar"} ){
+	# 沒有合適的 module , 自己寫一個 |||b
+	my($c, $week, $day, $t, $link, $newtr);
+	$c = ("<table border=\"0\" cellspacing=\"4\" cellpadding=\"0\">\n".
+	      "<caption class=\"calendarhead\">$emonth[$m] $y</caption>\n".
+	      "<tr>\n");
+	$c .= ("<th abbr=\"$_->[0]\" align=\"center\">".
+	       "<span class=\"calendar\">$_->[1]</span></th>\n")
+	    foreach( ['Sunday', 'Sun'], ['Monday', 'Mon'],
+		     ['Tuesday', 'Tue'], ['Wednesday', 'Wed'],
+		     ['Thursday', 'Thu'], ['Friday', 'Fri'],
+		     ['Saturday', 'Sat'] );
+
+	$week = Day_of_Week($y, $m, 1);
+	$c .= "</tr>\n<tr>\n";
+
+	if( $week == 7 ){
+	    $week = 0;
+	}
+	else{
+	    $c .= ("<th abbr=\"null\" align=\"center\"><span class=\"calendar\">".
+		   "&nbsp;</span></th>\n")
+		foreach( 1..$week );
+	}
+	foreach( 1..31 ){
+	    last if( !check_date($y, $m, $_) );
+	    $c .= "<tr>\n" if( $newtr );
+	    $c .= "<th abbr=\"$_\" align=\"center\"><span class=\"calendar\">";
+
+	    $t = packdate($y, $m, $_);
+	    if( !$article{"$t.title"} ){
+		$c .= "$_";
+	    }
+	    else{
+		my $link = $attr{"$fn.loadCalendar"};
+		$link =~ s/\[\% key \%\]/$t/g;
+		$c .= "<a href=\"$link\">$_</a>";
+	    }
+		   
+	    $c .= "</span></th>\n";
+	    if( ++$week == 7 ){
+		$c .= "</tr>\n\n";
+		$week = 0;
+		$newtr = 1;
+	    }
+	    else{
+		$newtr = 0;
+	    }
+	}
+
+	$c .= "</tr>\n" if( !$newtr );
+	$c .= "</table>\n";
+	$th{calendar} = $c;
+    }
+
+    # Comments ---------------------------------------------------------------
+    if( $attr{"$fn.loadRecentComments"} ){
+	dodbi(sub {
+	    my($dbh) = @_;
+	    my($sth, $t);
+	    $sth = $dbh->prepare("select artid,name,mail,mtime ".
+				 "from comment ".
+				 "where brdname='$brdname' ".
+				 "order by mtime desc ".
+				 "LIMIT 0,". $attr{"$fn.loadRecentComments"});
+	    $sth->execute();
+	    while( $t = $sth->fetchrow_hashref() ){
+		$t->{title} = $article{"$t->{artid}.title"};
+		$t->{key} = $t->{artid};
+		$t->{time} = POSIX::strftime('%D', localtime($t->{mtime}));
+		push @{$th{RecentComments}}, $t;
+	    }
+	});
+    }
+
+    if( $attr{"$fn.loadComments"} ){
+	my($name, $mail, $comment) = (param('name'),
+				      param('mail'), param('comment'));
+
+	if( $name && $comment ){
+	    if( $attr{"$fn.loadComments"} =~ /\@/ ){
+		my $sr = new Mail::Sender{smtp => 'localhost'};
+		$sr->MailMsg({from    => '批踢踢部落格 <blog@ptt.cc>',
+			      to      => $attr{"$fn.loadComments"},
+			      subject => "您的部落格收到 $name 給您的迴響",
+			      charset => 'big5',
+			      msg     =>  "
+您的部落格 http://blog.ptt2.cc/blog.pl/$brdname/$ofn
+剛才收到來自 $name <$mail> 給您的迴響
+--------------------------------------------------------------------
+$comment
+--------------------------------------------------------------------
+ (這封信件是由程式自動發出, 請不要直接回複這封信^^)
+",
+			  });
+	    }
+	    dodbi(sub {
+		my($dbh) = @_;
+		my($t, $hash);
+		$t = time();
+		$name = $dbh->quote($name);
+		$mail = $dbh->quote($mail);
+		$comment = $dbh->quote($comment);
+		$hash = MD5->hexhash("$t$th{key}$name$mail$comment");
+		$dbh->do('insert into comment '.
+			 '(brdname, artid, name, mail, content, mtime, hash) '.
+			 "values ('$brdname', '$th{key}', $name, $mail, ".
+			 "$comment, '$t', '$hash')");
+	    });
+	}
+
+	dodbi(sub {
+	    my($dbh) = @_;
+	    my($sth, $t);
+	    $sth = $dbh->prepare("select mtime,name,mail,content,hash ".
+				 "from comment ".
+				 "where brdname='$brdname'&&artid='$th{key}' ".
+				 "order by mtime desc");
+	    $sth->execute();
+	    while( $t = $sth->fetchrow_hashref() ){
+		$t->{time} = POSIX::ctime($t->{mtime});
+		$t->{content} = applyfilter($t->{content},
+					    $config{outputfilter});
+		push @{$th{comment}}, $t;
+	    }
+	});
+    }
+
+    # serialized -------------------------------------------------------------
+    if( $attr{"$fn.loadSerialized"} ){
+	my($obj, %h, $str);
+	$obj = Data::Serializer->new(serializer => 'Storable',
+				     digester   => 'MD5',
+				     compress   => 0,
+				     );
+	open FH, '<'.$attr{"$fn.loadSerialized"};
+	FH->read($str, -s $attr{"$fn.loadSerialized"});
+	close FH;
+	%h = %{$obj->deserialize($str)};
+	$th{$_} = $h{$_} foreach( keys %h );
+    }
+
+    # 用 Template Toolkit 輸出
+    $th{LANG} =~ s/zh_TW/zh-TW/;
+    mkdir "$BLOGCACHE/$brdname";
+    $tmpl = Template->new({INCLUDE_PATH => '.',
+			   ABSOLUTE => 0,
+			   RELATIVE => 0,
+			   RECURSION => 0,
+			   EVAL_PERL => 0,
+			   COMPILE_EXT => '.pl',
+			   COMPILE_DIR => "$BLOGCACHE/$brdname/",
+		       });
+    chdir "$BLOGDATA/$brdname/";
+    $tmpl->process($fn, \%th) ||
+	print "<pre>template error: ". $tmpl->error();
+    $dbh->disconnect() if( $dbh );
+
+    untie %attr if( %attr );
+    untie %config if( %config );
+    untie %article if( %article );
+    undef $tmpl;
+}
+
+sub utf8dump($;$)
+{
+    my($str, $prefix) = @_;
+    my $ret = $prefix || '';
+    my $ostr = $str;
+    Encode::from_to($str, 'big5', 'utf-8');
+    $ret .= '%'. sprintf('%x', ord($_))
+	foreach( split(//, $str) );
+    return "<a href=\"$ret\">$ostr</a>";
+}
+
+sub AddArticle($$$;$)
+{
+    my($cl, $fields, $s, $score) = @_;
+    my($content, $short, $nComments) = ();
+    $content = applyfilter($article{"$s.content"}, $config{outputfilter})
+	if( $fields =~ /content/i );
+
+    $short = applyfilter($article{"$s.short"}, $config{outputfilter})
+	if( $fields =~ /short/i );
+
+    if( $fields =~ /nComments/i ){
+	$nComments = dodbi(sub {
+	    my($dbh) = @_;
+	    my $sth = $dbh->prepare("select count(*) from comment ".
+				    "where brdname='$brdname'&&artid='$s'");
+	    $sth->execute();
+	    return $sth->fetchrow_hashref()->{'count(*)'};
+	}) || 0;
+    }
+
+    my($y, $m, $d) = unpackdate($s);
+    push @{$th{$cl}}, {year   => $y,
+		       month  => $m,
+		       emonth => $emonth[$m],
+		       cmonth => $cnumber[$m],
+		       day    => $d,
+		       key    => $s,
+		       title  => (($fields !~ /title/i) ? '' :
+				  $article{"$s.title"}),
+		       content=> $content,
+		       author => (($fields !~ /author/i) ? '' :
+				  $article{"$s.author"}),
+		       short  => $short,
+		       score  => $score,
+		       nComments => $nComments,
+		   }
+        if( $article{"$s.title"} );
+}
+
+sub applyfilter($$)
+{
+    my($c, $filter) = @_;
+    foreach( split(',', $filter) ){
+	if( /^generic$/i ){
+	    $c =~ s/\n/<br \/>\n/gs;
+	}
+	elsif( /^strict$/i ){
+	    $c =~ s/\</&lt;/gs;
+	    $c =~ s/\>/&gt;/gs;
+	    $c =~ s/\"/&quot;/gs;
+	    $c =~ s/\'/&apos;/gs;
+#	    $c =~ s/ /&nbsp;/gs;
+	}
+	elsif( /^ubb$/i ){
+	    $c =~ s|\[url\](.*?)\[/url\]|<a href="$1">$1</a>|gsi;
+	    $c =~ s|\[url=(.*?)\](.*?)\[/url\]|<a href="$1">$2</a>|gsi;
+	    $c =~ s|\[email\](.*?)\[/email\]|<a href="mailto:$1">$1</a>|gsi;
+	    $c =~ s|\[b\](.*?)\[/b\]|<b>$1</b>|gsi;
+	    $c =~ s|\[i\](.*?)\[/i\]|<i>$1</i>|gsi;
+	    $c =~ s|\[img\](.*?)\[/img\]|<img src="$1" alt="(null)" style="border:0;" />|gsi;
+	}
+	elsif( /^wiki$/i ){
+	    my $t;
+	    $c =~ s|\[(http://\S+) (.*?)\]| <a href=\"$1\">\[$2\]</a> |gi;
+	    $c =~ s|([^\>\"])(http://\S+\.(:?jpg\|gif\|png\|bmp))|$1<a href=\"$2\"><img src=\"$2\" alt="$2" style="border:0;"></a>|gsi;
+	    $c =~ s|([^\>\"])(http://\S+)|$1<a href=\"$2\">$2</a>|gsi;
+	    $c =~ s|\(\((.*?)\)\)|utf8dump($1, $th{wikibase})|gsie;
+	    $c =~ s|^\-{4,}$|<hr />|gm;
+	}
+    }
+    return $c;
+}
+
+sub parsefn($)
+{
+    my($fs) = @_;
+    return ("$1.$3", unpackdate($2))
+	if( $fs =~ /^(.*),(\w+)\.(.*)$/ );
+    return ($fs, Today());
+}
+
+sub GetType($)
+{
+    my($f) = @_;
+    return 'text/css' if( $f =~ /.css$/i );
+    return 'text/html';
+}
+
+sub packdate($$$)
+{
+    return $_[0] * 10000 + $_[1] * 100 + $_[2];
+}
+
+sub unpackdate($)
+{
+    return (int($_[0] / 10000),
+	    (int($_[0] / 100)) % 100,
+	    $_[0] % 100);
+}
+
+sub dodbi
+{
+    my($func) = @_;
+    my($ret);
+    my $dbh = DBI->connect("DBI:mysql:database=$BLOGdbname;".
+			   "host=$BLOGdbhost",
+			   $BLOGdbuser, $BLOGdbpasswd,
+			   {'RaiseError' => 1})
+	if( !$dbh );
+    eval {
+	$ret = &{$func}($dbh);
+    };
+    print "SQL: $@\n" if( $@ );
+    return $ret;
+}
+
+main();
+1;
+
diff --git a/web/blog/builddb.pl b/web/blog/builddb.pl
new file mode 100755
index 00000000..9c805d90
--- /dev/null
+++ b/web/blog/builddb.pl
@@ -0,0 +1,247 @@
+#!/usr/bin/perl
+# $Id$
+use lib '/home/bbs/bin/';
+use strict;
+use Getopt::Std;
+use LocalVars;
+use IO::Handle;
+use Data::Dumper;
+use BBSFileHeader;
+use DB_File;
+use OurNet::FuzzyIndex;
+
+sub main
+{
+    my($fh);
+    die usage() unless( getopts('cdaofn:D:') );
+    die usage() if( !@ARGV );
+    builddb($_) foreach( @ARGV );
+}
+
+sub usage
+{
+    return ("$0 [-acdfo] [-n NUMBER] [board ...]\n".
+	    "\t-a\t\trebuild all files\n".
+	    "\t-c\t\tbuild configure\n".
+	    "\t-d\t\tprint debug message\n".
+	    "\t-f\t\tforce build\n".
+	    "\t-o\t\tonly build content(not building link)\n".
+	    "\t-n NUMBER\tonly build \#NUMBER article\n".
+	    "\t-D DATE\t\tdelete article of DATE\n");
+}
+
+sub debugmsg($)
+{
+    print "$_\n" if( $Getopt::Std::opt_d );
+}
+
+sub builddb($)
+{
+    my($board) = @_;
+    my(%bh, %ch);
+
+    debugmsg("building $board");
+    return if( !getdir("$BBSHOME/man/boards/".substr($board,0,1)."/$board",
+		       \%bh, \%ch) );
+    buildconfigure($board, \%ch)
+	if( $Getopt::Std::opt_c || $Getopt::Std::opt_a );
+    builddata($board, \%bh,
+	      $Getopt::Std::opt_a || '',
+	      $Getopt::Std::opt_o || '',
+	      $Getopt::Std::opt_n || '',
+	      $Getopt::Std::opt_f || '',
+	      $Getopt::Std::opt_D,);
+}
+
+sub buildconfigure($$)
+{
+    my($board, $rch) = @_;
+    my($outdir, $fn, $flag, %config, %attr);
+
+    $outdir = "$BLOGDATA/$board";
+    `/bin/rm -rf $outdir; /bin/mkdir -p $outdir`;
+
+    tie(%config, 'DB_File', "$outdir/config.db",
+	O_CREAT | O_RDWR, 0666, $DB_HASH);
+    tie(%attr, 'DB_File', "$outdir/attr.db",
+	O_CREAT | O_RDWR, 0666, $DB_HASH);
+
+    for ( 0..($rch->{num} - 1) ){
+	debugmsg("\texporting ".$rch->{"$_.title"});
+	if( $rch->{"$_.title"} =~ /^config$/i ){
+	    foreach( split("\n", $rch->{"$_.content"}) ){
+		$config{$1} = $2 if( !/^\#/ && /(.*?):\s*(.*)/ );
+	    }
+	}
+	else{
+	    my(@ls, $c, $a, $fn);
+	    
+	    $fn = $rch->{"$_.title"};
+	    if( $fn !~ /\.(css|htm|html|js)$/i ){
+		print "not supported filetype ". $rch->{"$_.title"}. "\n";
+		next;
+	    }
+	    
+	    $c = $rch->{"$_.content"};
+	    $c =~ s/<meta http-equiv=\"refresh\".*?\n//g;
+	    open FH, ">$outdir/$fn";
+	    
+	    if( $c =~ m|<attribute>(.*?)\n\s*</attribute>\s*\n(.*)|s ){
+		($a, $c) = ($1, $2);
+		$a =~ s/^\s*\#.*?\n//gm;
+		foreach( split("\n", $a) ){
+		    $attr{"$fn.$1"} = $2 if( /^\s*(\w+):\s+(.*)/ );
+		}
+	    }
+	    print FH $c;
+	}
+    }
+    debugmsg(Dumper(\%config));
+    debugmsg(Dumper(\%attr));
+}
+
+sub builddata($$$$$$)
+{
+    my($board, $rbh, $rebuild, $contentonly, $number, $force, $del) = @_;
+    my(%dat, $dbfn, $idxfn, $y, $m, $d, $t, $currid, $idx);
+
+    $dbfn = "$BLOGDATA/$board.db";
+    $idxfn = "$BLOGDATA/$board.idx";
+    if( $rebuild ){
+	unlink $dbfn;
+	unlink $idxfn;
+    }
+
+    tie %dat, 'DB_File', $dbfn, O_CREAT | O_RDWR, 0666, $DB_HASH;
+    $idx = OurNet::FuzzyIndex->new($idxfn);
+
+    if( $del ){
+	my($delmonth);
+	($y, $m) = (int($del / 10000), int($del / 100) % 100);
+
+	$delmonth = 1;
+	foreach( 0..32 ){
+	    $delmonth = 0
+		if( $d != $_ &&
+		    exists $dat{sprintf('%04d%02d%02d', $y, $m, $d)} );
+	}
+	delete $dat{ sprintf('%04d%02d', $y, $m) }
+	    if( $delmonth );
+
+	$currid = $del;
+	if( $dat{"$currid.prev"} ){
+	    $dat{ $dat{"$currid.prev"}.'.next' } = $dat{"$currid.next"};
+	} else{
+	    delete $dat{ $dat{"$currid.prev"}.'.next' };
+	}
+	if( $dat{"$currid.prev"} ){
+	    $dat{ $dat{"$currid.next"}.'.prev' } = $dat{"$currid.prev"};
+	} else{
+	    delete $dat{ $dat{"$currid.next"}.'.prev' };
+	}
+	$dat{head} = $dat{"$currid.next"} if( $dat{head} == $currid );
+	$dat{last} = $dat{"$currid.prev"} if( $dat{last} == $currid );
+
+	delete $dat{$currid};
+	delete $dat{"$currid.next"};
+	delete $dat{"$currid.prev"};
+	delete $dat{"$currid.title"};
+	delete $dat{"$currid.short"};
+	delete $dat{"$currid.content"};
+	delete $dat{"$currid.author"};
+	$idx->delete($currid);
+	goto out;
+    }
+
+    foreach( $number ? $number : (1..($rbh->{num} - 1)) ){
+	if( !(($y, $m, $d, $t) =
+	      $rbh->{"$_.title"} =~ /(\d+)\.(\d+).(\d+),(.*)/) ){
+	    debugmsg("\terror parsing $_: ".$rbh->{"$_.title"});
+	}
+	else{
+	    $currid = sprintf('%04d%02d%02d', $y, $m, $d);
+	    if( $dat{$currid} && !$force ){
+		debugmsg("\t$currid is already in db");
+		next;
+	    }
+
+	    debugmsg("\tbuilding $currid content");
+	    $dat{ sprintf('%04d%02d', $y, $m) } = 1;
+	    $dat{"$currid.title"} = $t;
+	    $dat{"$currid.author"} = $rbh->{"$_.owner"};
+	    # $dat{"$currid.content"} = $rbh->{"$_.content"};
+	    # ugly code for making short
+	    my @c = split("\n",
+			  $dat{"$currid.content"} = $rbh->{"$_.content"});
+	    $dat{"$currid.short"} = ("$c[0]\n$c[1]\n$c[2]\n$c[3]\n");
+
+	    $idx->delete($currid) if( $idx->findkey($currid) );
+	    $idx->insert($currid, ($dat{"$currid.title"}. "\n".
+				   $rbh->{"$_.content"}));
+
+	    if( !$contentonly ){
+		debugmsg("\tbuilding $currid linking... ");
+		if( $dat{$currid} ){
+		    debugmsg("\t\talready linked");
+		}
+		elsif( !$dat{head} ){ # first article
+		    $dat{head} = $currid;
+		    $dat{last} = $currid;
+		}
+		elsif( $currid < $dat{head} ){ # before head ?
+		    $dat{"$currid.next"} = $dat{head};
+		    $dat{"$dat{head}.prev"} = $currid;
+		    $dat{head} = $currid;
+		}
+		elsif( $currid > $dat{last} ){ # after last ?
+		    $dat{"$currid.prev"} = $dat{last};
+		    $dat{"$dat{last}.next"} = $currid;
+		    $dat{last} = $currid;
+		}
+		else{ # inside ? @_@;;;
+		    my($p, $c);
+		    for( $p = $dat{last} ; $p>$currid ; $p = $dat{"$p.prev"} ){
+			;
+		    }
+		    $c = $dat{"$p.next"};
+		    
+		    $dat{"$currid.next"} = $c;
+		    $dat{"$currid.prev"} = $p;
+		    $dat{"$p.next"} = $currid;
+		    $dat{"$c.prev"} = $currid;
+		}
+		$dat{$currid} = 1;
+	    }
+	}
+    }
+
+out:
+    untie %dat;
+    $idx->sync();
+    undef $idx;
+    chmod 0666, $idxfn;
+}
+
+sub getdir($$$$$)
+{
+    my($bdir, $rh_bh, $rh_ch) = @_;
+    my(%h);
+    tie %h, 'BBSFileHeader', "$bdir/";
+    if( $h{"-1.title"} !~ /blog/i || !$h{"-1.isdir"} ){
+	debugmsg("blogdir not found");
+	return;
+    }
+
+    tie %{$rh_bh}, 'BBSFileHeader', "$bdir/". $h{'-1.filename'}.'/';
+    if( $rh_bh->{'0.title'} !~ /config/i ||
+	!$rh_bh->{'0.isdir'} ){
+	debugmsg("configure not found");
+	return;
+    }
+
+    tie %{$rh_ch}, 'BBSFileHeader', $rh_bh->{dir}. '/'. $rh_bh->{'0.filename'};
+    return 1;
+}
+
+main();
+1;
diff --git a/web/blog/index.pl b/web/blog/index.pl
new file mode 100755
index 00000000..b30ed178
--- /dev/null
+++ b/web/blog/index.pl
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+# $Id$
+use CGI qw/:standard/;
+use lib qw/./;
+use LocalVars;
+
+sub main
+{
+    print redirect("/blog.pl/$1/")
+	if( $ENV{REDIRECT_REQUEST_URI} =~ m|/\?(.*)| );
+
+    return redirect("/blog.pl/$BLOGdefault/");
+}
+
+main();
+1;
+
-- 
cgit v1.2.3