diff options
author | piaip <piaip@63ad8ddf-47c3-0310-b6dd-a9e9d9715204> | 2008-03-26 13:47:01 +0800 |
---|---|---|
committer | piaip <piaip@63ad8ddf-47c3-0310-b6dd-a9e9d9715204> | 2008-03-26 13:47:01 +0800 |
commit | 2a2078146f1e079732cd1a471e064d34a4399890 (patch) | |
tree | 79317a4ab4ed6a610033ed914a2c8782c3a37790 /blog | |
parent | b860b474520a4f30b20c829d507d60a90338aadc (diff) | |
download | pttbbs-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/INSTALL | 79 | ||||
-rwxr-xr-x | blog/blog.pl | 483 | ||||
-rwxr-xr-x | blog/builddb.pl | 247 | ||||
-rwxr-xr-x | blog/index.pl | 17 |
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\">". - " </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/\</</gs; - $c =~ s/\>/>/gs; - $c =~ s/\"/"/gs; - $c =~ s/\'/'/gs; -# $c =~ s/ / /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; - |