diff options
| -rw-r--r-- | blog/BBSFileHeader.pm | 56 | ||||
| -rwxr-xr-x | blog/builddb.pl | 135 |
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; |