#!/usr/bin/perl -w

################################################################################
### y.pl (Yggdrasil)
### generates a website from a directory tree of content and templates
###
### 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 : 17/07/2002 : Morten Wulff <wulff@ratatosk.net>
###	1.0.1 : 31/08/2002 : Added support for section-dependent sidebars
###	1.0.2 : 01/09/2002 : Now creates correct trails for non-index.html files
###     1.0.3 : 02/10/2002 : Skip files with defined prefix (makes it posible to mix
###                        : original and edited images - only edited versions are
###                        : published).

### TODO
### Better error messages

use strict;

use Data::Dumper;
use Date::Format;
use Digest::MD5;
use File::Copy;
use File::Path;
use Getopt::Long;
use HTML::Template;

################################################################################
### CONFIGURATION
################################################################################

my $Input_Dir  = 'd:/wwwroot/psyke/src';
my $Output_Dir = 'd:/wwwroot/psyke.org';

my $Base_Url = 'http://www.psyke.org';
my $Img_Url  = $Base_Url . '/img';

my $Dir_Create_Mode = '644';

my $Home_Label    = 'Home';
my $Default_Title = 'No Title';

my $Index = 'index.html';

my @HTML_Extensions    = ('html', 'shtml');
my $Template_Extension = '.tmpl';

my $Base_Template = 'base.tmpl';
my $Sidebar       = 'sidebar.tmpl';

my $Front_Page_Nav = 0; ### set to 0 if your basic navigation is in the templates

my $Skip_Prefix = '_';
my @Skip_Dirs = qw();
#my @Skip_Dirs = qw(bookstore contact coping faqs links personal pictures poetry);
my @No_Process_Dirs = qw(admin img thumbnails);

### names of digest files
my $Digest_New = 'y_new.dat';
my $Digest_Old = 'y_old.dat';

### the commandline switches override the following values
my $Verbose = 0; ### print directory names while processing if set to 1
my $Publish = 0; ### 0: lists changes  1: publish changed files
my $Debug   = 0;

################################################################################
### DON'T CHANGE ANYTHING BELOW THIS LINE
################################################################################

print "Initializing...\n";

GetOptions ('debug' => \$Debug, 'publish' => \$Publish, 'verbose' => \$Verbose);

my @Trail = ($Home_Label);
my @Path  = ();
my $Depth = 0;

### cache hashrefs
my $Title  = {};
my $Digest = {};
my $DigestOld = {};

### counters for the stats
my $Number_Of_Files;
my $Number_Of_Directories;
my $Total_Size;
my $HTML_Size;

### the hashref we pass to HTML::Template
my $Content = {};

### hashes are easier to use
my %Skip = map { ($_, 1) } @Skip_Dirs;
my %No_Process = map { ($_, 1) } @No_Process_Dirs;

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

get_digest();

open(DIGEST, ">$Digest_New") or die "Couldn't open file: $Digest_New\n$!";

flush_dir($Output_Dir);

print "Processing...\n";

process($Input_Dir);

print_stats();

################################################################################
### clean up
close DIGEST;

if ( $Publish ) {
	copy($Digest_New, $Digest_Old) or die "Couldn't copy from: $Digest_New to: $Digest_Old\n$!";
}

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

################################################################################
sub get_digest {
	if ( $Publish ) {
		open(IN, "$Digest_Old") or die "Couldn't open file: $Digest_Old\n$!";
		while(<IN>) {
			my ($filename, $digest) = split /\t/;
			$Digest_Old->{$filename} = $digest;
		}
		close IN;
	}
}

################################################################################
sub create_output_path {
	### make sure the output path exists
	my $output_path = join('/', $Output_Dir, @Path[1..$#Path]);
	if ( ! -d $output_path ) {
		mkpath( $output_path , 0, $Dir_Create_Mode) or die "mkpath failed for: $output_path\n$!";
	}
}

################################################################################
sub flush_dir {
	my $dir = shift;

	print "Flushing output dir...\n\n";

	if ( -d $dir ) {
		rmtree($dir) or die "rmtree failed for: $dir\n$!";
	}

	mkpath($dir, 0, $Dir_Create_Mode) or die "Couldn't create directory: $dir\n$!";
}

################################################################################
sub get_content {
	my $file = shift;

	if ( !$Publish && !$Digest->{$file} ) {
	    open(FILE, $file) or die "Can't open '$file': $!";
	    binmode(FILE);
		my $digest = Digest::MD5->new->addfile(*FILE)->hexdigest;
	    print DIGEST "$file\t$digest\n";
	    $Digest->{$file} = $digest;
	}

	local $/;

	open( INPUT, $file ) or die "Can't open '$file': $!";
	my $content = <INPUT>;
	close INPUT;

	return $content;
}

################################################################################
sub get_title {
	my $file = shift;

	if ( $Debug && $Title->{$file} ) {
		print "DEBUG: title cache hit - $file\n";
	}

	return $Title->{$file} if $Title->{$file};

	my $title;
	if ( -f $file ) {
		my $html = get_content($file);

		($title) = ($html =~ /<h1.*?>(.*)<\/h1>/);

		$Title->{$file} = $title;
	}
	return $title || $Default_Title;
}

################################################################################
sub print_stats {
	### give stats in kilobytes
	$Total_Size = int($Total_Size/1024);
	$HTML_Size  = int($HTML_Size/1024);

	print <<TEXT;

Processed $Number_Of_Files files in $Number_Of_Directories directories ($Total_Size kB, $HTML_Size kB in html files)
TEXT
}

################################################################################
sub process {
	my $dir = shift;

	push @Path, $dir;
	$Depth++;

	if ( $Depth > 1 ) {
		push @Trail, get_title(join('/', @Path, $Index));
	}

	my $Path = join '/', @Path;
	chdir $Path or die "Couldn't chdir into: $Path\n$!";
	print "$Path\n" if $Verbose;

	opendir(DIR, $Path) or die "Couldn't open dir: $Path\n$!";
	my @contents = readdir DIR;
	closedir(DIR);

	@contents = sort { $a cmp $b } @contents; ### sort alphabetically

	my @dirs  = grep {-d and not /^\.{1,2}$/} @contents;
	my @files = grep {-f } @contents;

	### process directories
	my @navigation = ();
	foreach my $d (@dirs) {
		next if ( $Depth < 2 && $Skip{ $d } ); ### only skip 1st level subdirs
		$Number_Of_Directories++;
		my $index_file = join '/', $Path, $d, $Index;

		unless ( do_not_process($d) ) {
			push @navigation, { name => get_title($index_file), href => "$d/" };
		}

		process( $d );
	}

	### process files
	foreach my $f (@files) {
		next if ( $f =~ /$Template_Extension$/o || $f =~ /^$Skip_Prefix/o );
		$Number_Of_Files++;
		my $pop_now = 0;

		if ( $f =~ /\.html$/ && $f ne 'index.html' ) {
			push @Trail, get_title(join('/', @Path, $f));
			push @Path, $f;
			$pop_now = 1;
		}

		set_content(@navigation);
		set_trail($f);

		pop @Path if $pop_now;

		process_file($f);

		pop @Trail if $pop_now;
	}

	pop @Trail if $Depth > 1;
	pop @Path;
	$Depth--;
}

################################################################################
sub do_not_process {
	my $dir = shift;

	return $No_Process{$dir};
}

################################################################################
sub process_file {
	my $file = shift;

	my $from = join '/', @Path, $file;
	my $to   = join '/', $Output_Dir, @Path[1..$#Path], $file;

	create_output_path();

	my $filesize = (stat $from)[7];

	my $is_html = 0;
	foreach ( @HTML_Extensions ) {
		if ( $file =~ /\.$_$/o ) {
			$is_html = 1;
			last;
		}
	}

	if ( $is_html && !do_not_process($Path[$#Path]) ) {
		my $base_template = get_base_template($Base_Template, @Path);

		my $t = HTML::Template->new(
			filename => $base_template,
			cache    => 1,
			path     => [ $Input_Dir ],
			die_on_bad_params => 0, ### not all params are used in all templates
			global_vars       => 1,
			loop_context_vars => 1
		);

		### set file-specific content
		$Content->{body}    = get_content($from);
		$Content->{title}   = get_title($from);
		$Content->{sidebar} = get_sidebar(@Path);

		$t->param($Content);

		### write result in output directory
		open( TO, ">$to" ) or die "Couldn't open output file: $to\n$!";
		print TO $t->output;
		close TO;

		$Total_Size += $filesize;
		$HTML_Size  += $filesize;
	} else {
		copy($from, $to) or die "Couldn't copy from: $from to: $to\n$!";
		$Total_Size += $filesize;
	}
}

################################################################################
sub get_base_template {
	my $base = shift;
	my @path = @_;

	while ( @path ) {
		my $from = join '/', @path, $Base_Template;
		return $from if -f $from;
		pop @path;
	}

	return undef;
}

################################################################################
sub get_sidebar {
	my @path = @_;

	while ( @path ) {
		my $from = join '/', @path, $Sidebar;
		if ( -f $from ) {
			return get_content($from);
		}
		pop @path;
	}

	return undef;
}

################################################################################
sub set_content {
	my @navigation = @_;

	@{$Content->{navigation}} = $Front_Page_Nav || $Depth > 1 ? @navigation : ();

	$Content->{location}  = join '/', $Base_Url, @Path[1..$#Path];
	$Content->{base_url}  = $Base_Url;
	$Content->{img_url}   = $Img_Url;
	$Content->{timestamp} = time2str('%a %b %e %Y (%T)', time);

	$Content->{rel_path} = '../' x ( $Depth - 1 );
}

################################################################################
sub set_trail {
	my $file = shift;

	my $dots = $#Trail + 1;
	@{$Content->{trail}} = map {
		$dots--;
		$dots ? { name => $_, href => '../' x $dots }
		      : { name => $_, href => '' }
	} @Trail;

	if ( $file ne 'index.html' ) {
		my $index_pos = $#{$Content->{trail}} - 1;
		my $count = 0;
		foreach ( @{$Content->{trail}} ) {
			if ( $count == $index_pos ) {
				$_->{href} =~ s!(.*)../$!$1./!;
			} else {
				$_->{href} =~ s!../!!;
			}
			$count++;
		}
	}
}

################################################################################
### DOCUMENTATION
################################################################################
__END__

=head1 Yggdrasil

A script for generating web sites with a tree-like structure.

@navigation - list of children with links {name, href}
@Trail      - list of parent articles with links {name, href}
$body       - contents of the source html document
$location   - url of article location
$title      - contents of the first <h1></h1> in the source document