#!/usr/bin/perl

################################################################################
### archive.pl
### generates html archive pages from webbbs data files www.psyke.org
###
### Copyright (C) 2002 Ratatosk / Morten Wulff <wulff@ratatosk.net>
###
### This program is free software; you can redistribute it and/or
### modify it under the terms of the GNU General Public License
### as published by the Free Software Foundation; either version 2
### of the License, or (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
################################################################################

### REVISIONS
###	Begun : 08/07/2002 : Morten Wulff <wulff@ratatosk.net>
###	1.0.0 : 08/09/2002 : Morten Wulff

use strict;

use File::Path;

################################################################################
### INIT
################################################################################

### path to webbbs files
my $input_path = 'd:/wwwroot/psyke/arc_psyke';

### path to output directory
my $output_path = 'd:/wwwroot/psyke/out/psyke';
my $link_path   = 'd:/wwwroot/psyke';

### number of threads per output page
my $threadsperpage = 25;

### html tags used to make message lists
my $begin = "<dl>\n";
my $end   = "</dl>\n";
my $itembegin = "<dd>";
my $itemend   = '</dd>';

### layout of the progress bar
my $bar = <<EOF;
0%  10%  20%  30%  40%  50%  60%  70%  80%  90%  100%
|----|----|----|----|----|----|----|----|----|----|
EOF

### indicates the width of the progress bar (100/width)
my $step = 2;

### moves beneath the progress bar
my $marker = '>';

### remember to edit the template below the __DATA__ token

################################################################################
### MAIN
################################################################################

### setup global hashes
my %INDEX;
my %POSTS;
my %LINKS;

################################################################################
print <<TEXT;
WebBBS Archiver : $threadsperpage threads per page

Getting file list...

TEXT
chdir $input_path or die "Could not change into: $input_path!\n$!\n";
my @files = <*>;

### flush output directory
rmtree($output_path) if ( -d $output_path );
mkpath($output_path);

################################################################################
print "Preprocessing files...\n\n";
progress_bar_init($#files);
my $counter;
foreach my $file (@files) {
	my @data = parse_file($file);

	$data[6] ||= 'NULL';

	push @{ $INDEX{$data[6]} }, $file;
	push @{ $POSTS{$file} }, @data;

	$LINKS{$data[10]} = $data[9];

	progress_bar_update($counter);
	$counter++;
}
my $threads = $#{ $INDEX{'NULL'} } + 1;
print "\nProcessed $counter file(s) in $threads thread(s)\n\n";

################################################################################
print "Generating output files...\n\n";

### get template
local $/;
my $template = <DATA>;

### process messages in chunks
my @parents = sort { $a <=> $b } @{ $INDEX{'NULL'} };
my $filenumber = 1;
my $from = 1;
my $to = $from + $threadsperpage - 1;
my %pages;
while ( my @chunk = splice @parents, 0, $threadsperpage ) {
	my $html;
	foreach my $id ( @chunk) {
		output_init();
		output($id);

		$html .= "$begin$itembegin" . output_format($id) . output_get() . "$itemend$end";
	}

	my $output = $template;
	$output =~ s/%%messages%%/$html/;
	$output =~ s/%%thread_from%%/$from/;
	$output =~ s/%%thread_to%%/$to/;

	my $path     = sprintf "$output_path/%03d", $filenumber;
	mkpath($path);
	my $filename = "$path/index.html";

	open (OUT, ">$filename") or die "Could not create file: $filename!\n$!\n";
	print OUT "$output\n";
	close OUT;

	$pages{$filenumber} = "Threads $from to $to";

	$filenumber++;
	$from += $threadsperpage;
	$to += $threadsperpage;
}

################################################################################
print "Generating index...\n\n";

my $html = "<h1>psyke.org</h1>";
foreach my $filenumber ( sort { $a <=> $b } keys %pages ) {
	my $filename = sprintf "%04d.html", $filenumber;
	$html .= <<HTML;
	<p>
		<a href="$filename">$pages{$filenumber}</a>
	</p>
HTML
}

my $output = $template;
$output =~ s/%%messages%%/$html/;
open (OUT, ">$output_path/index.html") or die "Could not create file: index.html!\n$!\n";
print OUT "$output\n";
close OUT;

### print link list
open (OUT, ">$link_path/links.txt");
foreach my $link ( keys %LINKS ) {
	print OUT <<TEXT;
TEXT : $LINKS{$link}
URL  : $link

TEXT
}
close OUT;

################################################################################
### SUBS
################################################################################

################################################################################
### output
{
	my $content;

	sub output_init { $content = ''; }
	sub output_get  { return $content; }

	sub output {
		my $parentid = shift;
		return unless defined @{ $INDEX{$parentid} };

		$content .= $begin;
		foreach my $id ( @{ $INDEX{$parentid} } ) {
			$content .= "$itembegin" . output_format($id) . "\n";
			output($id);
			$content .= "$itemend"
		}
		$content .= $end;
	}

	sub output_format {
		my $id = shift;
		my @data = @{ $POSTS{$id} };

		my $date = localtime($data[3]);

		$data[11] =~ s/<P>/<\/p><p>/g;
		$data[11] =~ s/<A HREF/<a href/g;
		$data[11] =~ s/\/A>/\/a>/g;
		$data[11] =~ s/<BR/<br/g;

		return <<HTML;
		<p>
			<strong>$data[0]</strong><br>
			<em>Posted by $data[1] on $date</em> (#$id)<br>
		</p>
		<p>
			$data[11]
		</p>
HTML
	}
}

################################################################################
sub parse_file {
	my $filename = shift;

	### enter slurp mode ;-)
	my $save_irs = $/;
	local $/;

	open (IN, $filename) or die "Could not open file: $filename!\n$!\n";
	my $raw = <IN>;
	close IN;

	### restore original input_record_separator
	$/ = $save_irs;

	my (@data) = (
		$raw =~ m/
			SUBJECT>(.*?)
			POSTER>(.*?)
			EMAIL>(.*?)
			DATE>(.*?)
			EMAILNOTICES>(.*?)
			IP_ADDRESS>(.*?)
			PREVIOUS>\s*(.*?)
			NEXT>\s*(.*?)
			IMAGE>(.*?)
			LINKNAME>(.*?)
			LINKURL>(.*?)<P>(.*)
		/sx );

	chomp @data;

	return @data;
}

################################################################################
### progress bar
{
	my $elements;
	my $count = 0;

	sub progress_bar_init {
		$elements = shift;
		print $bar;
		print $marker;
	}

	sub progress_bar_update {
		my $element = shift;
		my $percentile = $element / $elements * 100;
		while ($count < $percentile)
		{
			$count = $count + $step;
			print "\b $marker";
		}
	}
}

################################################################################
### TEMPLATE
################################################################################

__DATA__
<h1>Threads %%thread_from%% to %%thread_to%%</h1>

%%messages%%