#!/usr/bin/perl

use strict;
use AnnotateConfig;
use CGI ':cgi';
use OutputFactory;

my $cgi = new CGI;
my $Config = new AnnotateConfig;
my $cookie;

# if a new output mode has been requested, save it in a cookie
my $mode = $cgi->param('mode') || $cgi->cookie('mode') || $Config->get('DefaultOutputMode');

my $check = $Config->get('AdminUsername') . $Config->get('AdminPassword');
$check = crypt($check,$check);

if($cgi->cookie('credentials') eq $check)
{
	$Config->set('AdminMode',1);
}

$Config->set('UserName',$cgi->cookie('name'));
$Config->set('UserEmail',$cgi->cookie('eMail'));

my $Output = OutputFactory::instantiate($mode);

if($cgi->param('action') eq 'do_annotate')
{
	my $Comments = new Comments();

	$Comments->add_comment(
		{
			'node_id' => $cgi->param('node_id'),
			'name' => $cgi->param('name'),
			'eMail' => $cgi->param('eMail'),
			'comment' => $cgi->param('comment')
		}
	);

	# save name and eMail in a Cookie
	$cookie = [
		$cgi->cookie(-name => 'name', -value => $cgi->param('name'), -expires => '+3M'),
		$cgi->cookie(-name => 'eMail', -value => $cgi->param('eMail'), -expires => '+3M')
	];
	print relative_redirect('#' . $cgi->param('node_id') . "-comments");
	exit;
}
elsif($cgi->param('action') eq 'delete' && $Config->get('AdminMode') == 1)
{
	if(defined($cgi->param('id')))
	{
		my $Comments = new Comments;

		$Comments->delete_comment($cgi->param('id'));
	}
}
elsif($cgi->param('action') eq 'login')
{
	print_login();
}
elsif($cgi->param('action') eq 'do_login')
{
	my $credentials = $cgi->param('user') . $cgi->param('password');
	if(crypt($credentials,$check) eq $check)
	{
		$cookie = $cgi->cookie(
			-name => 'credentials',
			-value => $check
		);
		$Config->set('AdminMode',1);
	}
	else
	{
		print_login();
	}
}
elsif($mode ne 'Annotate' && $mode ne 'ViewComments')
{
	$cookie = $cgi->cookie(
		-name => 'mode',
		-value => $mode,
		-expires => '+3M'
	);
}

output_file($Config->get('DocumentRoot'), $ENV{"PATH_INFO"});


# subroutines start from here
sub output_file
{
	my $documentroot = shift;
	my $file = shift;

	# $documentroot must end in '/'
	unless($documentroot =~ m|/$|)
	{
		$documentroot .= '/';
	}

	unless(-e $documentroot . $file)
	{
		catch_error("$file: No such file or directory",'404 Not Found')
	}

	if(-d $documentroot . $file)
	{
		if($file =~ m|/$|)
		{
			$file .= $Config->get('DirectoryIndex');
		}
		else
		{
			print relative_redirect($file . '/');
			exit;
		}
	}

	my $mime_type = mime_type($file);

	open(FILE,"<$documentroot$file") or catch_error("$file: $!");

	# parse HTML files ...
	if($mime_type eq 'text/html')
	{
		# slurp file
		local $/;
		undef $/;

		print $cgi->header(-cookie => $cookie);

		while(<FILE>)
		{
			# falls der Benutzer einen Teil des Dokuments zum Annotieren ausgewhlt hat,
			# wird dieser an das Ausgabemodul weitergeleitet
			$Output->print($_,$cgi->param('node_id'));
		}
	}
	# ... pass through everything else
	else
	{
		print $cgi->header(-cookie => $cookie, -type => $mime_type);

		while(<FILE>)
		{
			print;
		}
	}

	close(FILE);
}

# this subroutine returns the MIME type for a file name, looking at its suffix
# if the Annotate configuration provides Apache's mime.types, use it
# otherwise, try to find out the type manually
sub mime_type
{
	my $suffix = lc shift;

	$suffix =~ s/.*\.(.*)$/$1/;

	if(open(MIMETYPES,$Config->get('MimeTypes')))
	{
		while(<MIMETYPES>)
		{
			s/\#.*//g; # ignore comments

			if(m/^(\S*)\s.*\s$suffix\s/)
			{
				close(MIMETYPES);
				return $1;
			}
		}
		close(MIMETYPES);
	}
	# MIME database is not available, fall back for the most important types
	elsif($suffix eq 'html' || $suffix eq 'htm')
	{
		return 'text/html';
	}
	elsif($suffix eq 'jpg' || $suffix eq 'jpeg')
	{
		return 'image/jpeg';
	}
	elsif($suffix eq 'gif')
	{
		return 'image/gif';
	}
	elsif($suffix eq 'png')
	{
		return 'image/png';
	}

	return 'application/octet-stream';
}

sub catch_error
{
	my $reason = shift;
	my $responsecode = shift or "500 Internal Server Error";

	print $cgi->header(
		-cookie => $cookie
	);

	print $reason;
	exit(1);
}

# returns a redirect, relative to the current address
sub relative_redirect
{
	my $address = shift;

	$cgi->redirect($ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} . $address);
}

sub print_login
{
	print $cgi->header();

	open(LOGIN,$Config->get('TemplateRoot') . '/' . $Config->get('LoginTemplate'));
	print while(<LOGIN>);
	close(LOGIN);
	exit;
}
