summaryrefslogtreecommitdiffstats
path: root/blog
diff options
context:
space:
mode:
authorpiaip <piaip@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2008-03-26 13:47:01 +0800
committerpiaip <piaip@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2008-03-26 13:47:01 +0800
commit2a2078146f1e079732cd1a471e064d34a4399890 (patch)
tree79317a4ab4ed6a610033ed914a2c8782c3a37790 /blog
parentb860b474520a4f30b20c829d507d60a90338aadc (diff)
downloadpttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar.gz
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar.bz2
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar.lz
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar.xz
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.tar.zst
pttbbs-2a2078146f1e079732cd1a471e064d34a4399890.zip
- (internal) directory layout structure finetune
git-svn-id: http://opensvn.csie.org/pttbbs/trunk/pttbbs@4022 63ad8ddf-47c3-0310-b6dd-a9e9d9715204
Diffstat (limited to 'blog')
-rw-r--r--blog/INSTALL79
-rwxr-xr-xblog/blog.pl483
-rwxr-xr-xblog/builddb.pl247
-rwxr-xr-xblog/index.pl17
4 files changed, 0 insertions, 826 deletions
diff --git a/blog/INSTALL b/blog/INSTALL
deleted file mode 100644
index 1f216292..00000000
--- a/blog/INSTALL
+++ /dev/null
@@ -1,79 +0,0 @@
-這篇文章在描述怎麼架設 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/blog/blog.pl b/blog/blog.pl
deleted file mode 100755
index 5362f4b5..00000000
--- a/blog/blog.pl
+++ /dev/null
@@ -1,483 +0,0 @@
-#!/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/blog/builddb.pl b/blog/builddb.pl
deleted file mode 100755
index 9c805d90..00000000
--- a/blog/builddb.pl
+++ /dev/null
@@ -1,247 +0,0 @@
-#!/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/blog/index.pl b/blog/index.pl
deleted file mode 100755
index b30ed178..00000000
--- a/blog/index.pl
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/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;
-