use strict;
use Getopt::Long;
use Pod::Usage;
use File::Spec;
use File::Spec::Unix;
use locale;
use POSIX qw(strftime);
use Date::Parse;
use Carp;
GetOptions(
	"template=s" => \my $template_file,
	"dest=s" => \my $destdir,
	"help|?" => \my $help,
	"shadow=s" => \my $shadowheaders,
	"man" => \my $man) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus=>0, -verbose=>2) if $man;
pod2usage(2) if !(-d $destdir) || !defined($template_file);

my ($destvol, $dest_dir) = File::Spec->splitpath($destdir, 1);
my @template = split(/<!--\s*\[TEXT\]\s*-->/, read_file($template_file));
my $lastchange;
for (@template) { $lastchange = 1 if /\@LASTCHANGE\@/; }
my %lastchange;
if ($lastchange) {
	open my $fh, '-|', 'cvs', 'log', '-rHEAD', @ARGV
		or die "Cannot cvs log: $!";
	my $fn;
	while (<$fh>) {
		$fn = $1 if /^Working file:\s*(.*)/;
		$lastchange{$fn} = strftime("%F %T %Z", localtime(str2time($1)))
			if m#^date: (\d{4}/\d\d/\d\d \d\d:\d\d:\d\d)#;
	}
}

my $menu=undef;
# generate menu
for (@template) {
		s/<!--\s*\[MENU:\s*(\S+)\s*,\s*(\S+)\s*\]\s*-->/build_menu($template_file,$1,$2)/ge;
}		

	



for my $text_file (@ARGV) {
	pod2usage(2) if File::Spec->file_name_is_absolute($text_file);
	my ($textvol, $textdir, $textname) = File::Spec->splitpath($text_file);
	my $text = read_file($text_file);
	my ($head, $body_attrs, $body) = ($text =~ m#<head>\s*(.*?)\s*</head>.*<body([^>]*)>\s*(.*?)\s*</body>#is);
	my ($before_title, $title, $after_title) = ($head =~ m#(.*)<title>(.*?)</title>(.*)#is);
	my @tpl = @template;
	if (defined $shadowheaders) {
		$body =~ s#<h([$shadowheaders])>(.*?)</h\1>#<h$1 class="shadow"><div class="shadowbox"><div class="headertext">$2</div><div class="headershadow">$2</div></div></h$1>#isg;
	}	
	$tpl[0] =~ s#(<title\b)#$before_title$1#is;
	$tpl[0] =~ s#(</title>)#$title$1$after_title#is;
	$tpl[0] =~ s#(<body\b)#$1$body_attrs#is if $body_attrs;
	my $top = File::Spec::Unix->abs2rel('', $textdir);
	print "top=$top\n";
	$top = "" if ($top eq '/');
	$top .= "/" if length($top);
	my $result = join('', $tpl[0], $body, $tpl[1]);
	$result =~
	s#<!--\s*\[DIR:\s+(\S+)\s+([^\[\s]+)\s*\]\s*-->#mk_filelist($template_file,$text_file,$1,$2)#egs;
	
	$result =~ s#\@TOP\@#$top#g;
	$result =~ s#\@LASTCHANGE\@#$lastchange{$text_file}# if $lastchange;
	my $resdir = File::Spec->catdir($dest_dir, $textdir);
	write_file(File::Spec->catpath($destvol, $resdir, $textname), $result);
}

sub read_file
{
	my ($filename) = @_;
	open my $fh, '<', $filename
		or croak "Cannot open file '$filename' for read: $!";
	local $/;
	my $res = <$fh>;
	return $res;
}

sub write_file
{
	my $filename = shift;
	open my $fh, '>', $filename
		or croak "Cannot open file '$filename' for write: $!";
	print $fh @_
		or croak "Error writing to '$filename': $!";
	close $fh
		or croak "Error closing '$filename': $!";
}

sub build_menu 
{
	my $templ_name= shift;
	my $templ_file = shift;
	my $menu_file = shift;
# Compute menu name
	my $menu_name = $templ_name;
	$menu_name =~ s#/[^/]+$#/$menu_file#;
# compute menu item template (language independent)
	my $item_name = $templ_name; 
	$item_name =~ s#/[^/]+$#/$templ_file#;
	my $item_template = read_file($item_name);
	my $fh;
	open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
		$!";
	local $_;
	my $menu="";
	while (<$fh>) {
		s/#.*$//;
		next if /^\s*$/;
		if (!/\s*(\S+)\s+(.*)$/) {
			croack("Invalid menu line $_ in $menu_name");
		}	
		$menu.=process_item($item_template,$1,$2);
	}
	return $menu;
} 


sub build_menu1 
{
	my $templ_name = shift;
# Compute menu name
	my $menu_name = $templ_name;
	$menu_name =~ s/\.[^.]+$/.mnu/;
# compute menu item template (language independent)
	my $item_name = $templ_name; 
	$item_name =~ s#/[^/]+$#/menu1.tpl#;
	my $item_template = read_file($item_name);
	my $fh;
	open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
		$!";
	local $_;
	my $menu="";
	while (<$fh>) {
		s/#.*$//;
		next if /^\s*$/;
		if (!/\s*(\S+)\s+(.*)$/) {
			croack("Invalid menu line $_ in $menu_name");
		}	
		$menu.=process_item($item_template,$1,$2);
	}
	return $menu;
} 



sub process_item 
{
	my ($item_template,$link_uri,$item_text) = @_;
	$item_template =~ s/\@LINK\@/$link_uri/g;
	$item_template =~ s/\@TEXT\@/$item_text/g;
	return $item_template;
}	

sub mk_filelist 
{	
	my ($template_file,$text_file,$pattern,$item_template)=@_;
	my ($textvol, $file_dir, $textname) = File::Spec->splitpath($text_file);
	$template_file =~ s/[^\/]+$/$item_template/;
	my $template = read_file($template_file);
	my @files=map(glob,map("$file_dir$_", split "," ,$pattern));
	my %fileinfo;
	my $list="";
	print STDERR "Processing directory '$pattern' in the file $text_file\n";
	foreach my $file (@files) {
		print STDERR ".matching file $file\n"; 
		next if $file eq $text_file;
		my ($title,$descr,$filename);
		$filename=$1 if $file=~/([^\/]+)$/;
		next if $filename eq "CVS";
		next if $filename eq "fileinfo";
		if ($file =~ /\.html?$/) {
			print STDERR "..It is html\n"; 
			($title,$descr)=get_html_metadata($file);
		} elsif (-d $file) {
			print STDERR "..It is directory\n";
			($title,$descr) = get_html_metadata("$file/index.html");
		} else {	
			get_fileinfo($file_dir) if (!%fileinfo);
			if ($fileinfo{$file}) {
				print STDERR ".. it is described in fileinfo\n";
				($title,$descr) = @{$fileinfo{$file}};
			} else {
				print STDERR ".. no metadata\n";
				$title = $filename;
				$descr = "";
			}
		}	
		my $link = substr($file,length($file_dir));
		my $item = $template;
		$item =~s/\@LINK\@/$link/gs;
		$item =~s/\@NAME\@/$filename/gs;
		$item =~s/\@TITLE\@/$title/gs;
		$item =~s/\@DESCR\@/$descr/gs; 
		$list .= $item;
	}			

	return $list;		

}

sub get_fileinfo {
	my $dir = shift;
	my $f;
	local $_;
	my @out;
	open $f,"<$dir/fileinfo";
	while (<$f>) {
		if (/(\S+)\s+"([^"]+)"\s+(.*)/) {
			push @out,$1,[$2,$3]
		} else {
			die "Error in $dir/fileinfo - unparsable line $.\n"
		}
	}
	close $f;
	return @out;
}		

sub get_html_metadata {
	my $data = read_file(shift);
	my ($title,$descr)=(undef,undef);
	$title=$1 if ($data=~m#<title>([^<]*)</title>#is); 
	$descr=$1 if
	($data=~m#<meta\s+name="?description"?\s+content="([^"]+)">#is);
	return ($title,$descr);	
}

__END__

=head1 NAME

make_html.pl - make HTML from template and text

=head1 SYNOPSIS

 perl make_html.pl <options> <text files>

 Options:
  --template=<template>  template file
  --dest=<dir>           destination directory
  --help                 this help
  --shadow=nnn			 List of header numbers (1 for h1 etc) which
						  should be displayed with shadow
  --man                  man

=head1 OPTIONS

=over 4

=item B<--template>=template

Use a template file template

=cut
