#! /usr/bin/env perl
# $Id: cgi.pm 181 2007-03-09 00:17:10Z yamada $
package PS::MOPS::DET::cgi;

use warnings;
use strict;
use CGI qw/:standard/;
use Fcntl;
use FileHandle;

use base qw(CGI);

my $debug = 1;

#
# Internal method.  Used as a way to exit a script while returning
# an error message.
#
# $self - object
# $error - Error message.  Should begin with a three digit error code.
# $form_action - What action was requested from this cgi script.
#

sub fail {
	my ($self, $error, $form_action) = @_;

	print
		$self->header(-status => $error),
		$self->start_html(-title => $error,
			-style => '/ds/test/det/stylesheets/default.css'),
		$self->h1($error),
		$self->p('Request failed.'),
		$self->p("\$form_action = \"$form_action\"\n"),
		$self->end_html();

	exit;
}

#
# CGI function.  Used to submit files.
#
# $self - object
# $destdir - Where are files created?
#

sub submit {
	my ($self, $destdir) = @_;

	my $fh = new FileHandle;

	#
	# Timestamps.
	#

	my ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
	$mon++;
	$year += 1900;

	#
	# See what sort of action was required.  The form_action should
	# be 'Submit File' (submit a file directly).  Anything else
	# indicates that the cgi form was called improperly.
	#

	my $form_action = $self->param('form_action');
	if (not defined $form_action) {
		$form_action = "";
	}

	#
	# Perform the requested action.
	#

	if ($self->cgi_error) {
		#
		# There's not much that can be done if there is a CGI error.
		# Just report the error and assume that the user can figure it
		# out.
		#

		$self->fail($self->cgi_error, $form_action);
	} elsif ($form_action eq 'Submit File') {
		#
		# Accept and submit the file.
		#

		my $file_handle = $self->upload('uploaded_file');
		my @file_stat = stat($file_handle);
		my $file_size = $file_stat[7];

		my $dbinstance = $self->param('dbinstance');
		my $type = $self->param('type');
		my $state = "N";

		#
		# dbinstance is used to create a directory name, so must be
		# filtered, for safety.
		#

		$dbinstance =~ s'[^A-Za-z0-9_.-]'_'g;

		#
		# See if the directory exists.  If not, create it and initialize
		# the count file and index.
		#

		my $dbdir = $destdir . "/" . $dbinstance;
		my $index = $destdir . "/index";
		my @dbstat = stat($dbdir);

		unless (@dbstat) {
			#
			# Create the per-instance directory.
			#

			mkdir($dbdir, 0777);
			chmod(0777, $dbdir);

			open($fh, ">$dbdir" . "/count");
			flock($fh, 2);
			chmod(0666, $dbdir . "/count");
			print $fh "0\n";
			close $fh;

			open($fh, ">$dbdir" . "/index");
			flock($fh, 2);
			chmod(0666, $dbdir . "/index");
			close $fh;

			#
			# Create an entry in the root index.
			#

			open($fh, ">>$index");
			flock($fh, 2);
			chmod(0666, $index);
			printf($fh "%s|%04d-%02d-%02dT%02d:%02d:%02d|%s\n",
				$dbinstance,
				$year, $mon, $mday, $hour, $min, $sec, 'INSTANCE');
			close $fh;
		}

		#
		# Read and increment the count number.
		#

		my $count;

		open($fh, "+<$dbdir/count");
		flock($fh, 2);
		chmod(0666, "$dbdir/count");
		$count = <$fh>;
		chomp($count);
		seek($fh, 0, 0);
		print $fh $count + 1 . "\n";
		close $fh;

		#
		# Send the file.
		#

		if (!$file_handle || $file_size == 0) {
			$self->fail("400 No File or Invalid File Sent", $form_action);
		} elsif (!defined $dbinstance || $dbinstance eq "") {
			$self->fail("400 dbinstance was not set", $form_action);
		} elsif (!defined $type || $type eq "") {
			$self->fail("400 type was not set", $form_action);
		} else {
			#
			# Got a valid file.
			#

			my $output_file = sprintf("%s/%.05d", $dbdir, $count);

			if (sysopen($fh, $output_file,
					Fcntl::O_WRONLY|Fcntl::O_CREAT|Fcntl::O_EXCL, 0666)) {
				flock($fh, 2);
				chmod(0666, $output_file);

				my $buffer;
				my $bufsize = 1024;

				while (read($file_handle, $buffer, $bufsize)) {
					print $fh $buffer;
				}
				close($fh);

				open($fh, ">>$dbdir/index");
				flock($fh, 2);
				printf($fh "%.05d|%04d-%02d-%02dT%02d:%02d:%02d|%s|%s\n",
					$count,
					$year, $mon, $mday, $hour, $min, $sec,
					$type, $state);
				close($fh);

				#
				# Everything succeeded.  Report back to the user.
				#

				print
					$self->header(-style => '/ds/test/det/stylesheets/default.css'),
					$self->start_html(-title=>'Simulation File Submitted'),
					$self->h1('Simulation File Submitted'),
					$self->p("\$file_handle = $file_handle."),
					$self->p("\$file_size = $file_size."),
					$self->p("\$output_file = $output_file"),
					$self->p("\$form_action = \"$form_action\""),
					$self->p("\$dbinstance = \"$dbinstance\""),
					$self->end_html;
			} else {
				$self->fail("400 Could not create output file $output_file",
					$form_action);
			}
		}
	} else {
		#
		# The user executed the cgi form without correctly specifying all
		# required parameters.
		#

		$self->fail('400 Bad Request', $form_action, $form_action);
	}
}

#
# CGI function.  Used to change file status.
#
# $self - object
# $destdir - Where do files live.
#

sub status {
	my ($self, $destdir) = @_;

	my $fh = new FileHandle;

	#
	# See what sort of action was required.  The form_action should
	# be 'Change Status' (submit a file directly).  Anything else
	# indicates that the cgi form was called improperly.
	#

	my $form_action = $self->param('form_action');
	if (not defined $form_action) {
		$form_action = "";
	}

	#
	# Perform the requested action.
	#

	if ($self->cgi_error) {
		#
		# There's not much that can be done if there is a CGI error.
		# Just report the error and assume that the user can figure it
		# out.
		#

		$self->fail($self->cgi_error, $form_action);
	} elsif ($form_action eq 'Change Status') {
		my $dbinstance = $self->param('dbinstance');
		my $dbfile = $self->param('dbfile');
		my $status = $self->param('status');

		#
		# dbinstance and dbfile are used to create a directory name, so must be
		# filtered, for safety.
		#

		$dbinstance =~ s'[^A-Za-z0-9_.-]'_'g;
		$dbfile =~ s'[^A-Za-z0-9_.-]'_'g;

		unless ($status =~ m/[A-Z]/) {
			$self->fail("400 Status must be exactly 1 upper case character.",
				$form_action);
			exit();
		}

		#
		# The index file.
		#

		my $dbindex = $destdir . "/" . $dbinstance . "/index";

		#
		# Update the index
		#

		if (open($fh, "+<$dbindex")) {
			flock($fh, 2);

			#
			# Look for the specified file in the index.
			#

			my $pos;
			my $file;
			my $date;
			my $type;
			my $state;
			my $match;

			$match = 0;
			$pos = tell($fh);
			while (<$fh>) {
				my $line = $_;
				chomp $line;
				($file, $date, $type, $state) = split(/\|/, $line);
				if ($file eq $dbfile) {
					#
					# Rewrite the existing line in-place.  The new line
					# must be exactly as long as the line that it replaces,
					# or it will cause major problems.
					#
					# TODO: Make this more robust.
					#

					seek($fh, $pos, 0);
					printf $fh "%s|%s|%s|%s\n", $file, $date, $type, $status;
					$match++;
				}

				$pos = tell($fh);
			}

			close($fh);

			$self->fail("400 File not found", $form_action) unless $match;

			#
			# Everything succeeded.  Report back to the user.
			#

			print
				$self->header(-style => '/ds/test/det/stylesheets/default.css'),
				$self->start_html(-title=>'Simulation File Updated'),
				$self->h1('Simulation File Updated'),
				$self->p("\$form_action = \"$form_action\""),
				$self->p("\$dbinstance = \"$dbinstance\""),
				$self->p("\$dbfile = \"$dbfile\""),
				$self->p("\$status = \"$status\""),
				$self->p("\$dbindex = \"$dbindex\""),
				$self->p("\$match = \"$match\""),
				$self->end_html;
		} else {
			$self->fail("400 Could not open file \"$dbindex\"",
				$form_action);
		}
	} else {
		#
		# The user executed the cgi form without correctly specifying all
		# required parameters.
		#

		$self->fail('400 Bad Request', $form_action, $form_action);
	}
}

#
# CGI function.  Used to change file status.
#
# $self - object
# $destdir - Where do files live.
#

sub remove {
	my ($self, $destdir) = @_;

	my $fh = new FileHandle;

	#
	# See what sort of action was required.  The form_action should
	# be 'Change Status' (submit a file directly).  Anything else
	# indicates that the cgi form was called improperly.
	#

	my $form_action = $self->param('form_action');
	if (not defined $form_action) {
		$form_action = "";
	}

	#
	# Perform the requested action.
	#

	if ($self->cgi_error) {
		#
		# There's not much that can be done if there is a CGI error.
		# Just report the error and assume that the user can figure it
		# out.
		#

		$self->fail($self->cgi_error, $form_action);
	} elsif ($form_action eq 'Remove File') {
		my $dbinstance = $self->param('dbinstance');
		my $dbfile = $self->param('dbfile');

		#
		# dbinstance and dbfile are used to create a directory name, so must be
		# filtered, for safety.
		#

		$dbinstance =~ s'[^A-Za-z0-9_.-]'_'g;
		$dbfile =~ s'[^A-Za-z0-9_.-]'_'g;

		#
		# The index file.
		#

		my $dbindex = $destdir . "/" . $dbinstance . "/index";

		#
		# Update the index
		#

		if (open($fh, "+<$dbindex")) {
			flock($fh, 2);

			#
			# Look for the specified file in the index.  I assume that
			# the index file is short enough that I can create a copy in 
			# memory, instead of writing a temporary file.
			#

			my $file;
			my $date;
			my $type;
			my $state;
			my $match;
			my @new_index;

			$match = 0;
			while (<$fh>) {
				my $line = $_;
				chomp $line;
				($file, $date, $type, $state) = split(/\|/, $line);
				if ($file eq $dbfile) {
					$match++;
				} else {
					push(@new_index, $_);
				}
			}

			#
			# Write the new index file.
			#

			seek($fh, 0, 0);
			truncate($fh, 0);
			for my $new_line ( @new_index ) {
				print $fh $new_line;
			}

			#
			# Finished with the index.
			#

			close($fh);

			#
			# Check for at least 1 match.
			#

			$self->fail("400 File not found", $form_action) unless $match;

			#
			# Now unlink the actual file.
			#

			unlink($destdir . "/" . $dbinstance . "/" . $dbfile);

			#
			# Everything succeeded.  Report back to the user.
			#

			print
				$self->header(-style => '/ds/test/det/stylesheets/default.css'),
				$self->start_html(-title=>'Simulation File Removed'),
				$self->h1('Simulation File Removed'),
				$self->p("\$form_action = \"$form_action\""),
				$self->p("\$dbinstance = \"$dbinstance\""),
				$self->p("\$dbfile = \"$dbfile\""),
				$self->p("\$dbindex = \"$dbindex\""),
				$self->end_html;
		} else {
			$self->fail("400 Could not open file \"$dbindex\"",
				$form_action);
		}
	} else {
		#
		# The user executed the cgi form without correctly specifying all
		# required parameters.
		#

		$self->fail('400 Bad Request', $form_action, $form_action);
	}
}

1;

__END__

=head1 NAME

PS::MOPS::DET::cgi - Implements cgi handlers.

=head1 SYNOPSIS

use PS::MOPS::DET::cgi;

=head1 DESCRIPTION

Defines cgi handlers.

=head1 PUBLIC FUNCTIONS

=head2 submit

Submit a file into the datastore.  Files are created in a fixed
directory, with a subdirectory named after the simulation instance.

=head2 status

Change the status of a file in the datastore.  Files are created
in a fixed directory, with a subdirectory named after the simulation
instance.  The status is stored in the index file.

=cut
