add BBSFileHeader.pm, builddb.pl

git-svn-id: http://opensvn.csie.org/pttbbs/pttbbs/trunk/pttbbs@889 63ad8ddf-47c3-0310-b6dd-a9e9d9715204

2 files changed, 191 insertions, 0 deletions

diff --git a/blog/BBSFileHeader.pm b/blog/BBSFileHeader.pm
new file mode 100644
index 00000000..4865da8b
--- /dev/null
+++ b/blog/BBSFileHeader.pm
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+package BBSFileHeader;
+use strict;
+use IO::Handle;
+use Data::Dumper;
+
+use fields qw/dir fh cache/;
+
+sub TIEHASH
+{
+    my($class, $dir) = @_;
+    my $self = fields::new($class);
+
+    open $self->{fh}, "<$dir/.DIR";
+    return undef if( !$self->{fh} );
+
+    $self->{dir} = $dir;
+    return $self;
+}
+
+sub FETCH
+{   
+    my($self, $k) = @_;
+
+    return $self->{dir} if( $k eq 'dir' );
+    return ((-s "$self->{dir}/.DIR") / 128) if( $k eq 'num' );
+
+    my($num, $key) = $k =~ /(.*)\.(.*)/;
+    my($t, %h);
+
+    $num += $self->FETCH('num')	if( $num < 0 );
+
+    return $self->{cache}{$num}{$key} if( $self->{cache}{$num}{$key} );
+
+    seek($self->{fh}, $num * 128, 0);
+    $self->{fh}->read($t, 128);
+
+    if( $key eq 'isdir' ){
+	my $fn = "$self->{dir}/" . $self->FETCH("$num.filename");
+	return (-d $fn);
+    }
+    elsif( $key eq 'content' ){
+	my $fn = "$self->{dir}/" . $self->FETCH("$num.filename");
+	return `/bin/cat $fn`;
+    }
+    else{
+	($h{filename}, $h{recommend}, $h{owner}, $h{date}, $h{title}) =
+	    unpack('Z33cZ14Z6Z65', $t);
+	$h{title} = substr($h{title}, 3);
+	$self->{cache}{$num}{$_} = $h{$_}
+	    foreach( 'filename', 'owner', 'date', 'title' );
+	return $h{$key};
+    }
+}
+
+1;
diff --git a/blog/builddb.pl b/blog/builddb.pl
new file mode 100755
index 00000000..18660e48
--- /dev/null
+++ b/blog/builddb.pl
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+use strict;
+use Getopt::Std;
+use LocalVars;
+use IO::Handle;
+use Data::Dumper;
+use BBSFileHeader;
+use DB_File;
+
+sub main
+{
+    my($fh);
+    die usage() unless( getopts('ca') );
+    die usage() if( !@ARGV );
+    builddb($_) foreach( @ARGV );
+}
+
+sub usage
+{
+    return ("$0 [-ca] [board ...]\n".
+	    "\t-c build configure\n".
+	    "\t-a rebuild all files\n");
+}
+
+sub builddb($)
+{
+    my($board) = @_;
+    my(%bh, %ch);
+    
+    print "building $board\n";
+    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);
+}
+
+sub buildconfigure($$)
+{
+    my($board, $rch) = @_;
+    my($outdir, $fn, $flag, %config, %attr);
+
+    $outdir = "$BLOGROOT/$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) ){
+	print "\texporting ".$rch->{"$_.title"}."\n";
+	if( $rch->{"$_.title"} =~ /^config$/i ){
+	    foreach( split("\n", $rch->{"$_.content"}) ){
+		$config{$1} = $2 if( /(.*?):\s*(.*)/ );
+	    }
+	}
+	else{
+	    my(@ls, $t);
+
+	    @ls = split("\n", $rch->{"$_.content"});
+	    open FH, ">$outdir/". $rch->{"$_.title"};
+	    if( $rch->{"$_.title"} =~ /\.html$/ ){
+		while( $t = shift @ls ){
+		    last if( $t !~ /^\*/ );
+		    $attr{($rch->{"$_.title"}. ".$1")} = $2
+			if( $t =~ /^\*\s+(\w+): (.*)/ );
+		}
+		unshift @ls, $t;
+	    }
+	    print FH "$_\n"
+		foreach( @ls );
+	}
+    }
+    print Dumper(\%config);
+    print Dumper(\%attr);
+}
+
+sub builddata($$$)
+{
+    my($board, $rbh, $rebuild) = @_;
+    my(%dat, $dbfn, $y, $m, $d, $t, $currid);
+
+    $dbfn = "$BLOGROOT/$board.db";
+    unlink $dbfn if( $rebuild );
+    
+    tie %dat, 'DB_File', $dbfn, O_CREAT | O_RDWR, 0666, $DB_HASH;
+    foreach( 1..($rbh->{num} - 1) ){
+	if( ($y, $m, $d, $t) =
+	    $rbh->{"$_.title"} =~ /(\d+)\.(\d+).(\d+),(.*)/ ){
+
+	    $currid = sprintf('%04d%02d%02d', $y, $m, $d);
+	    if( $currid <= $dat{last} ){
+		print "\t$currid skipped\n";
+	    }
+	    else{
+		$dat{ sprintf('%04d%02d', $y, $m) } = 1;
+		$dat{"$currid.title"} = $t;
+		$dat{"$currid.content"} = $rbh->{"$_.content"};
+		$dat{"$currid.author"} = $rbh->{"$_.owner"};
+		$dat{"$currid.prev"} = $dat{'last'};
+		$dat{"$dat{last}.next"} = $currid
+		    if( $dat{'last'} );
+		$dat{'last'} = $currid;
+		$dat{head} = $currid if( !$dat{head} );
+		print "\t${currid} built\n";
+	    }
+	}
+    }
+    untie %dat;
+}
+
+sub getdir($$$$$)
+{
+    my($bdir, $rh_bh, $rh_ch) = @_;
+    my(%h);
+    tie %h, 'BBSFileHeader', "$bdir/";
+    if( $h{"-1.title"} !~ /blog/i || !$h{"-1.isdir"} ){
+	print "blogdir not found\n";
+	return;
+    }
+
+    tie %{$rh_bh}, 'BBSFileHeader', "$bdir/". $h{'-1.filename'}.'/';
+    if( $rh_bh->{'0.title'} !~ /configure/i ||
+	!$rh_bh->{'0.isdir'} ){
+	print "configure not found\n";
+	return;
+    }
+
+    tie %{$rh_ch}, 'BBSFileHeader', $rh_bh->{dir}. '/'. $rh_bh->{'0.filename'};
+    return 1;
+}
+
+main();
+1;