#!/usr/bin/perl
use lib '/home/erealms/ethereal/mgmt/perl';

#################################################################################
# Created       : Martin Foster
# Modified      : 01-Apr-2007
#################################################################################
#
# Bio - Script part of Ethereal Realms designed to show a puppet/puppeteer bio 
# Copyright (C) 2000-2007  Martin Foster
#
# 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.
#
# Author of this script can be contacted at the following:
#       E-Mail  : martin@ethereal-realms.org
#       Address : 4-3526 Wolfe Cres
#                 Halifax, Nova Scotia
#                 B3L 3S2
#
#################################################################################

use CGI qw(-no_debug -nosticky);				# Common gateway interface
use CGI::Carp qw(fatalsToBrowser);				# CGI Error logs
use strict;							# Strict variable enforcement

use Ethereal::Comm;						# Communication handler
use Ethereal::Database;						# Database handler
use Ethereal::Login;						# Login handler
use Ethereal::Mail;						# Mail handler
use Ethereal::Menu;						# Consistent menu
use Ethereal::Param;						# Parameter control
use Ethereal::Template;						# Template handler

#################################################################################
# Gobal override
#################################################################################
$CGI::POST_MAX=1024 * 50;					# Maximum posts
$CGI::DISABLE_UPLOADS = 1;					# Disable uploads


#################################################################################
# Data Members
#################################################################################
my $cgi;							# Common gateway interface handle
my $comm;							# Communications panel
my $database;							# Database handle
my $login;							# Login display
my $menu;							# Menu handling structure
my $param;							# Parameter handle
my $tmpl;							# Template handle
my $tmpl_realm;							# Specific for realm

my $sparam;							# Address line parameters

my $contact;							# Contacts
my $exist;							# Existence
my $nav;							# Navigational variable
my $offline;							# Offline panels
my $panel;							# Comm panel widget

my $bio;							# Bio Link
my $default;							# Default handle
my $display;							# Display information
my $openid;							# OpenID template
my $user;							# Username

my %bio;							# Configuration hash
my %realm;							# Realm handle


#################################################################################
# Program Area
#################################################################################

	# Initial handles
	$cgi      = new CGI;
	$database = new Ethereal::Database();

	# Connect and Fetch
	$database->Connect($cgi);

	# Set title
	$database->{'TITLE'} = $database->{'SYS'}{'TitBio'};

	# Parameter handling
	$param = new Ethereal::Param($database, $cgi);
	$param->GetParam();


	# Link with hash
	$database->GetHashBio(\%bio);
	$database->GetHashRealm(\%realm);

	
	# Initialize handles
	$tmpl     = new Ethereal::Template(\%bio);
	$menu     = new Ethereal::Menu($database, $param);


	# Fetch and format
	$sparam = $cgi->path_info();
	$sparam =~ s/^(\/)(.*)(\/)?$/$2\//;

	# Parse into sections
	($param->{'BCHAR'},
	 $param->{'BPOOL'}) = split(/\//, $cgi->unescape($sparam));

 	# Assume for safety
	$param->{'BPOOL'} = 'system'
	  unless ((defined($param->{'BPOOL'})) && ($param->{'BPOOL'} =~ /\w+/));


	# Pull information
	# Puppet specific homepage
	($bio, $default, $user, $param->{'CCHAR'}, $param->{'CPOOL'}) = $database->DataGet("SELECT
		 p.PuppetBio,
		 p.PuppetDefault,
		 p.PuppeteerLogin,
		 p.PuppetName,
		 p.PuppetPool
		FROM  Puppet p, Realm r
		WHERE p.PuppetPool=r.RealmName
		  AND p.PuppetShort=?
		  AND r.RealmShort=?", 
	
	 $param->{'BCHAR'},
	 $param->{'BPOOL'}) if (defined($param->{'BCHAR'}));

	# Establish OpenID server
	$openid = ($param->{'BPOOL'} eq 'system')
	  ? "<link rel\=\"openid\.server\" href\=\"$database->{SYS}{LnkExtOpenID}\">"
	  : "<!- Not available -->";


	# Authenthicated users
	# Advanced functions
	if ((defined($param->{'USER'}))
	 || (defined($param->{'FORCE'})))
	{
		# Login and template instance
		$login = new Ethereal::Login($database, $cgi, $param, $menu);

		# Disable header generation
		$login->{'AUTOMATE'} = 0;
		
		
		# Authenthication
		if ($login->GetVerificationRealm())
		{
			
			# Prevent bans
			$login->CheckLegality(\%realm) if (defined($param->{'ROOM'}));


			# Handling of watch
			if (defined($param->{'WATCH'}))
			{
				# Insert watch
				if ($param->{'WATCH'} eq 'ins')
				{
					# Insert new entry
					$database->Quick("INSERT INTO Watch
						(PuppetName,
						 PuppetPool,
						 RealmName,
						 PuppeteerLogin)
						VALUES(?,?,?,?)",

					 $param->{'CCHAR'},
					 $param->{'CPOOL'},
					 $param->{'ROOM'},
					 $param->{'USER'}
					);
				}

				# Discontinue
				elsif ($param->{'WATCH'} eq 'del')
				{
					# Remove entry
					$database->Quick("DELETE FROM Watch
						WHERE PuppetName=?
						  AND PuppetPool=?
						  AND RealmName=?
						  AND PuppeteerLogin=?",

					 $param->{'CCHAR'},
					 $param->{'CPOOL'},
					 $param->{'ROOM'},
					 $param->{'USER'}
					);
				}

				# Cleanup
				$param->Cleanup('WATCH');
			}


			# Fetch navigational structure
			($nav) = CreateNav($database, $cgi, $param, $tmpl, \%bio, $bio, $user, $default)
		         unless (defined($param->{'IGGY'}));


			# Contact information
			if (defined($param->{'CONTACT'}))
			{
				# Contact information
				$contact = CreateContact($database, $param, $tmpl, \%bio, $user, $default);

				# Document display
				print $cgi->header();

				# Search and replace
				print $menu->Rewrite(
				  $tmpl->Pass('TmplBase',
					MCHAR   => $param->{'CCHAR'},
					MMAIN   => $contact,
					MOPENID => $openid,
					MMOVE   => $nav
				 ));
			}

			# Puppet level ignore
			elsif (defined($param->{'IGGY'}))
			{
				# Insert ignore
				$database->Quick("INSERT INTO PuppetIgnore
					(PuppeteerLogin,
					 PuppetName,
					 PuppetIgnore)
					VALUES(?,?,'single')",

				 $param->{'USER'},
				 $param->{'BCHAR'}
				);

				# Nav bar will miss details
				($nav) = CreateNav($database, $cgi, $param, $tmpl, \%bio, $bio, $user, $default);


				# Document display
				print $cgi->header();

				# Search and replace
				print $menu->Rewrite(
				  $tmpl->Pass('TmplBase',
					MCHAR   => $param->{'CCHAR'},
					MMAIN   => $contact,
					MOPENID => $openid,
					MMOVE   => $nav
				 ));
			}

			# Offline messaging
			elsif (defined($param->{'INTERNAL'}))
			{
				# Mail specific
				# Writing of post
				$offline = MailSender($database, $cgi, $param, \%bio) 
				 if (defined($param->{'MSEND'}));

				# Contact information
				$offline = CreateOffline($database, $cgi, $param, $tmpl, \%bio)
			       	 unless (defined($offline));

				# Document display
				print $cgi->header();

				# Search and replace
				print $menu->Rewrite(
				  $tmpl->Pass('TmplBase',
					MCHAR   => $param->{'CCHAR'},
					MMAIN   => $offline,
					MOPENID => $openid,
					MMOVE   => $nav
				 ));
			}

			# Private messaging
			else
			{
				# Create instances
				$tmpl_realm = new Ethereal::Template(\%realm);
				$comm       = new Ethereal::Comm($database, $cgi, $tmpl_realm);


				# Make sure it's valid
				if (defined($param->{'CHAR'}))
				{
					# Existence
					($exist) = $database->DataGetPuppetExistence($param->{'CHAR'}, $param->{'USER'}) ;

					# Invalid handle
					unless (defined($exist))
					{
						# Check for a current handle
						($param->{'CHAR'}) = $database->DataGetPuppetCurrent($param->{'ROOM'}, $param->{'USER'});

						# Ensure definition
						($param->{'CHAR'}) = $database->DataGetDefault($param->{'USER'})
					       	 unless (defined($param->{'CHAR'}));
					}
				}
				else
				{
					# Check for a current handle
					($param->{'CHAR'}) = $database->DataGetPuppetCurrent($param->{'ROOM'}, $param->{'USER'});

					# Ensure definition
					($param->{'CHAR'}) = $database->DataGetDefault($param->{'USER'}) 
					 unless (defined($param->{'CHAR'}));
				}


				# Writing of post
				if (defined($param->{'PSEND'}))
				{
					# Create variables
					$param->{'SOURCE'}  = $param->{'USER'};
					$param->{'TARGET'}  = $user;
					$param->{'OTARGET'} = $param->{'BCHAR'};

					# Write post
					$comm->DataWrite($param);

					# Clean up
					$param->Cleanup('SOURCE', 'TARGET', 'OTARGET');
				}

				# Contact information
				$panel = CreatePanel($database, $cgi, $param, $comm, $tmpl, \%bio);

				# Document display
				print $cgi->header();

				# Search and replace
				print $menu->Rewrite(
				  $tmpl->Pass('TmplBase',
					MCHAR   => $param->{'CCHAR'},
					MMAIN   => $panel,
					MOPENID => $openid,
					MMOVE   => $nav
				 ));
			}
		}
	}

	# Limited functions
	else
	{
		# Fetch navigational structure
		($nav, $display) = CreateNav($database, $cgi, $param, $tmpl, \%bio, $bio, $user, $default);

		# Document display
		print $cgi->header();

		# Enough information to handle
		if ($display eq 'yes')
		{
			# Contact information
			$contact = CreateContact($database, $param, $tmpl, \%bio, $user, $default);

			# Search and replace
			print $menu->Rewrite(
			  $tmpl->Pass('TmplBase',
				MCHAR   => $param->{'CCHAR'},
				MMAIN   => $contact,
				MOPENID => $openid,
				MMOVE   => $nav
			 ));
		}

		# Warn user
		else
		{
			# Search and replace
			print $menu->Rewrite(
			  $tmpl->Pass('TmplBase',
				MCHAR   => $param->{'CCHAR'},
				MMAIN   => $bio{'TmplDisabled'},
				MOPENID => $openid,
				MMOVE   => $nav
			 ));
		}
	}


#################################################################################
# Sub-Routines
#################################################################################

#####################
# Create Contact
#
# Will generate the contact addresses for users and return it to be implemented
# into a greater scheme.

sub CreateContact
{
	#####################
	# Data members
	my $database = shift;					# Database handle
	my $param    = shift;					# Parameter list
	my $tmpl     = shift;					# Templating
	my $bio      = shift;					# Realm hash
	my $user     = shift;					# Users login name
	my $default  = shift;					# Permission to display

	my $count;						# What is available
	my $contact;						# Formatted entry
	
	my $display;						# Display settings
	my $source;						# Source of contact
	my $iff;						# Indentify Friend Foe

	my $vanity;						# Vanity shot
	my $width;						# Demensions
	my $height;						# Demensions
	my $picture;						# Picture template
	
	my $data;						# Data pulled
	my $name;						# Formatted name
	my $type;						# Type of contact

	my $res;						# Results hash
	my $statement;						# Database query

	my %tags;						# Tag types


	#####################
	# Program Area

	# Is this the default handle
	if ($default eq 'yes')
	{
		# Display settings
		($display) = $database->DataGetPuppeteerContact($user);

		# Quick check
		unless ($display eq 'no')
		{
			# Identify Freind or Foe
			# Check for need
			if (($display eq 'limit')
			 && (defined($param->{'USER'})))
		 	{
				# Pull liason data	
				($source, $iff) = $database->DataGetLiason($user, $param->{'USER'});
				
				# Check and return if failed
				return $bio->{'TmplDisabled'}
				  unless ((defined($iff)) && ($iff eq 'friend'));
			}

			# Critical component missing
			elsif (($display eq 'limit')
			 && (!defined($param->{'USER'})))
			{
				# Can't authenticate user
				return $bio->{'TmplDisabled'};
			}
			

			
			# Verify need
			# Determine what is available
			($count) = $database->DataGet("SELECT COUNT(*)
				FROM PuppeteerContact
				WHERE PuppeteerLogin=?", $user);

			# Create display
			if  ($count > 0)
			{ 
				# Initial assignment
				$contact =  $bio->{'TmplContact'};

				# Specifics
				# Display images
				$database->Pull(\$statement, "SELECT 
					  c.ContactName   AS \"Name\", 
					  c.ContactType   AS \"Type\",
					  d.ContactData   AS \"Data\"
					FROM Contact c
					LEFT OUTER JOIN PuppeteerContact d
					  ON (d.ContactName=c.ContactName
					 AND  d.PuppeteerLogin=?)
					ORDER BY c.ContactType, c.ContactName", $user);

				# Create all
				while (($name, $type, $data) = $statement->fetchrow())
				{
					# Quick search and replace
					$name =~ s/\s/_/gs;
					$name =~ s/\W//gs;

					# Adjust the name	
					$name = uc($name) . '_' . uc($type);	

					# Search and replace
					$contact =~ s/$name/$data/gs;
				}

				# End query
				$statement->finish();


				# Vanity shot
				# Check
				($vanity, $width, $height) = $database->DataGetVanity($user);

				# Predefine
				$picture = '';

				# Valid
				if (defined($vanity))
				{
					# Generate template
					$picture = $tmpl->Pass('TmplContactVanity',
						BASE_PICTURE => $vanity,
						BASE_HEIGHT  => $width,
						BASE_WIDTH   => $height
					 );
				}

				# Search and replace
				$contact =~ s/LSTPICTURE/$picture/gs;

				# Return formatted
				return $contact;
			}
		}
	}

	# Returns generated content
	return  $bio->{'TmplDisabled'};
}


#####################
# Create Nav
#
# Creates the navigational menu system necessary to be able to move from
# one component to the other

sub CreateNav
{
	#####################
	# Data members
	my $database = shift;					# Database handle
	my $cgi      = shift;					# Common gateway interface
	my $param    = shift;					# Parameters
	my $tmpl     = shift;					# Template handling
	my $bio      = shift;					# Reference to realm hash
	my $ubio     = shift;					# Biographical link
	my $user     = shift;					# Username
	my $default  = shift;					# Option to display

	my $res;						# Results hash
	my $statement;						# Database query
	
	my $line;						# Navigational string
	my $url;						# Self referencing link

	my $ictc;						# Inline contact
	my $igal;						# Inline galleries
	my $ioff;						# Inline offline
	my $iggy;						# Inline ignore prompt
	my $ipst;						# Inline posting
	my $iwtc;						# User watching

	my $display;						# Display controls
	my $source;						# Source of contact
	my $iff;						# Indentify Freind Foe

	
	my $id;							# Id number to search from
	my $ignore;						# User Ignored
	my $label;						# Display label
	my $offline;						# User offline
	my $watch;						# User being watched
	
	my %args;						# Cut down on repetitive arguments


	#####################
	# Program area

	# What is the url
	$url  = $cgi->url(-absolute=>1) . '/' . $param->{'BCHAR'} . '/' . $param->{'BPOOL'};

	# Display of contact information
	if ($default eq 'yes')
	{
		# Display settings
		($display) = $database->DataGetPuppeteerContact($user);

		# Quick check
		unless ($display eq 'no')
		{
			# Identify Freind or Foe
			# Check for need
			if (($display eq 'limit')
			 && (defined($param->{'USER'})))
		 	{
				# Pull liason data	
				($source, $iff) = $database->DataGetLiason($user, $param->{'USER'});
				
				# Check and return if failed
				$default = 'no'
				  unless ((defined($iff)) && ($iff eq 'friend'));
			}
	
			# Critical component missing
			elsif (($display eq 'limit')
			 && (!defined($param->{'USER'})))
			{
				# Can't authenticate user
				$default = 'no';
			}
		}
	}
			

	# Template
	# Initial assignment
	$line = (defined($ubio)) 
	 ? $tmpl->Pass('TmplNav',
		MLINK => "$ubio\" TARGET=\"_BLANK",
		MNAME => $bio->{'TagBioHome'})
	 : '';


	# Parameters
	# Users specific
	if (defined($param->{'USER'}))
	{
		# Additional parameters
		$args{'USER'}   = $param->{'USER'};
		$args{'CRYPT'}  = $param->{'CRYPT'};
		$args{'ROOM' }  = $param->{'ROOM'}   if (defined($param->{'ROOM'}));
		$args{'PSTART'} = $param->{'PSTART'} if (defined($param->{'PSTART'}));
	}

	# Continue with offline status
	$args{'OFFLINE'} = 'True' if (defined($param->{'OFFLINE'}));


	# Verified if user is located in a realm
	# Not the case
	unless (defined($param->{'ROOM'}))
	{
		# Generate inline menu
		if (defined($param->{'USER'}))
		{
			# Registered users
			$ictc = $param->EmbedInline(%args, CONTACT=>'True');
			$ioff = $param->EmbedInline(%args, INTERNAL=>'True');
		}
		else
		{
			# Unregistered users
			$ictc = $param->Crypt(%args, CONTACT=>'True');
			$ioff = $param->Crypt(%args, INTERNAL=>'True', FORCE=>'True');
		}
		
		# Contact Information
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$ictc", MNAME=>$bio->{'TagBioContact'}) if ($default eq 'yes');;
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$ioff", MNAME=>$bio->{'TagBioOffline'});
	}

	# Is the case
	else
	{
		
		# Verify if ignored
		($ignore) = $database->DataGet("SELECT PuppetName
			FROM PuppetIgnore
			WHERE PuppetName=?
			  AND PuppeteerLogin=?",

		 $param->{'BCHAR'},
		 $param->{'USER'}
		);


		# User activity
		# Offline realms
		if (defined($param->{'OFFLINE'}))
		{
			# Set offline
			$offline = 0;
		}

		# Active realms
		else
		{
			# Search position
			($id) = $database->DataGetPostID();

			
			# Check user
			($offline) = $database->DataGet("SELECT COUNT(*) 
				FROM Post
				WHERE PuppeteerLogin=?
				  AND RealmName=?
				  AND PostIDNumber > ?::INT",

			 $param->{'USER'},
			 $param->{'ROOM'},
			 $id
			) if (defined($param->{'ROOM'}));


			# Ensure definition
			$offline = (defined($offline)) ? $offline : 0;
		}

		# Generate inlines
		$ictc = $param->EmbedInline(%args, CONTACT=>'True');
		$ioff = $param->EmbedInline(%args, INTERNAL=>'True');
		$iggy = $param->EmbedInline(%args, IGGY=>'True');
		$ipst = $param->EmbedInline(%args);

		
		# Contact Information
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$ictc", MNAME=>$bio->{'TagBioContact'}) if ($default eq 'yes');
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$iggy", MNAME=>$bio->{'TagBioIgnore'})  unless (defined($ignore));
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$ioff", MNAME=>$bio->{'TagBioOffline'}) if ($offline < 1);
		$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$ipst", MNAME=>$bio->{'TagBioPrivate'}) if ($offline > 0);


		# Offline realms menu handling
		if (defined($param->{'OFFLINE'}))
		{
			# Check if big brother mode is on
			($watch) = $database->DataGet("SELECT PuppetName
				FROM Watch
				WHERE PuppetName=?
				  AND PuppetPool=?
				  AND RealmName=?
				  AND PuppeteerLogin=?",

			 $param->{'CCHAR'},
			 $param->{'CPOOL'},
			 $param->{'ROOM'},
			 $param->{'USER'}
			);

			# Watch
			$label = (defined($watch)) ? $bio->{'TagBioBlock'} : $bio->{'TagBioWatch'};
			$watch = (defined($watch)) ? 'del' : 'ins';
			
			# Generate inline
			$iwtc = $param->EmbedInline(%args, WATCH=>$watch);

			# Appedn to bar
			$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$iwtc", MNAME=>$label);
		}
	}


	# Safety check
	$param->{'INTERNAL'} = 'True' if ($offline < 1);


	# Gallery display
	# Only system handles
	if ($param->{'CPOOL'} eq 'system')
	{
		# Pull information
		$database->Pull(\$statement, "SELECT
			 GalleryID   AS \"GalleryID\",
			 GalleryName AS \"GalleryName\"
			FROM Gallery
			WHERE GalleryPenName=?
			  AND GalleryPrivacy='no'", $param->{'CCHAR'});


		# Litmus test
		if ($res = $statement->fetchrow_hashref())
		{
			# Append spacer
			$line .= $bio->{'TagSpacer'};

			# Generate inline
			$igal = (defined($param->{'USER'}))
			 ? $param->EmbedInline(USER=>$param->{'USER'}, CRYPT=>$param->{'CRYPT'})
			 : '';


			# Loop and display
			do
			{
				# Generate url
				$url = $database->{'SYS'}{'LnkIntGallery'} . '/view/' . $res->{'GalleryID'};

				# New nav field
				$line .= $tmpl->Pass('TmplNav', MLINK=>"$url$igal", MNAME=>$res->{'GalleryName'});
			}
			while ($res = $statement->fetchrow_hashref());
		}

		# Finish off
		$statement->finish();
	}

	# Return generated code
	return $line, $default;
}


####################
# Offline Messaging
#
# Exists to allow users to send Internal Mail without the entire hassle of
# using that specific interface

sub CreateOffline
{
	####################
	# Data members
	my $database = shift;					# Database handle
	my $cgi      = shift;					# Cgi handle
	my $param    = shift;					# Parameter handle
	my $tmpl     = shift;					# Template name
	my $bio      = shift;					# Realm options

	my $default;						# Default puppet
	my $panel;						# Offline message panel

	my @puppets;						# List of puppets
	

	####################
	# Program area

	# Populate puppet list
	$database->GetListPuppetYours(\@puppets, $param->{'USER'});

	# Cleanup for embed
	$param->Cleanup('POST');


	# Default puppet
	($default) = (defined($param->{'CHAR'}))
	  ? $param->{'CHAR'} 
	  : $database->DataGetDefault($param->{'USER'});


	# Widgets
	# Assigning values
	my $wmsbmt = $cgi->submit(
		-name      => $bio->{'TxtSend'},
		-value     => $bio->{'TxtSend'},
		-tabindex  => 2
	 );

	# Subject line
	my $wmsubj = $cgi->textfield(
		-name      => 'MSUBJ', 
		-default   => $bio->{'SetDefault'},
	        -size      => 25,
		-maxlength => 250,
		-tabindex  => 4
	 );
	
	# Posting window
	my $wmbody = $cgi->textarea(
		-name      => 'MBODY',
		-rows      => 10,
		-columns   => 60,
		-wrap      => 'SOFT',
		-tabindex  => 1
	 );

	# Puppet selection
	my $wchars = $cgi->popup_menu(
		-name      => 'MFROM',
		-values    => \@puppets,
		-default   => $default,
		-tabindex  => 3
	 );


	# Display
	# Form 
	my $wfrmstart = $cgi->start_form();
	my $wfrmhiddn = $param->EmbedNormal($param->Flat(), MSEND=>'True');

	my $wfrmends = $cgi->end_form() . "\n";
	

	# Template display
	my $wfrmwidgt = $tmpl->Pass('TmplOffline',
		WFRMSTRT => $wfrmstart . $wfrmhiddn,  
		WFRMENDS => $wfrmends,
		WMSUBJ   => $wmsubj,
		WMBODY   => $wmbody,
		WCHARS   => $wchars,
		WMSBMT   => $wmsbmt
	 );

	# Return options
	return $wfrmwidgt;
}


####################
# Panel Creation
#
# Display prompt for a private message, this includes a list of all the puppets
# et cetera. 

sub CreatePanel
{
	####################
	# Data members
	my $database = shift;					# Database handle
	my $cgi      = shift;					# Cgi handle
	my $param    = shift;					# Parameter handle
	my $comm     = shift;					# Communications panel
	my $tmpl     = shift;					# Templating
	my $bio      = shift;					# Realm options

	my $access;						# Access control
	my $defsize; 						# Default size
	my $defcolor;						# Default colour
	my $defface;						# Default face

	my $panel;						# Private message panel

	my @char;						# List of characters
	my @color;						# Colour choices
	my @face;						# Font face

	my %who;						# Associative hash
	

	####################
	# Program area


	# Pull values
	($access) = $database->DataGetRealmAccess($param->{'ROOM'});


	# Populate arrays
        @color = $comm->FontSelectColor($param);
        @face  = $comm->FontSelectFace($param);

	# Populate puppet list
	$database->GroupList(\@char, $access, $param->{'USER'}, $param->{'ROOM'}); 

	
	# Retreive size and color
	($defsize,
	 $defcolor,
	 $defface) = $database->DataGetFont($param->{'CHAR'}, $param->{'USER'}, $color[0], $face[0]);

	# Cleanup for embed
	$param->Cleanup('POST');


	# Widgets
	# Assigning values
	my $wpostsend = $cgi->submit(
		-name     => $bio->{'TxtSend'},
		-value    => $bio->{'TxtSend'},
		-tabindex => 2
	 );

	# Posting window
	my $wposttext = $cgi->textarea(
		-name     => 'POST',
		-rows     => 3,
		-columns  => 55,
		-wrap     => 'SOFT',
		-tabindex => 1
	 );

	# Selection
	# Our own
	my $wcharslct = $cgi->popup_menu(
		-name     => 'CHAR',
		-values   => \@char,
		-default  => $param->{'CHAR'},
		-tabindex => 3
	 );

	# Form values
	my $wformstrt = $cgi->start_form();
	my $wformhidn = $param->EmbedNormal($param->Flat(),
		 SIZE  => $defsize,
		 COLOR => $defcolor,
		 FACE  => $defface,
		 PSEND => 'True'
	 );
	my $wformends = $cgi->end_form();


	# Widget replacements
	# Posting widgets
	$panel = $tmpl->Pass('TmplPrivate',
		WPOSTSEND => $wpostsend,
		WPOSTTEXT => $wposttext,
		WCHARSLCT => $wcharslct,
		WFRMSTRT  => $wformstrt . $wformhidn,
		WFRMENDS  => $wformends
	 );

	# Document
	return $panel;
}


#####################
# Mail Sender
#
# Allows for composed message to be sent out to the designated person.

sub MailSender
{
	#####################
	# Data members

	my $database = shift;					# Database Handle
	my $cgi      = shift;					# Common gateway interface
	my $param    = shift;					# Parameter list
	my $bio      = shift;					# Mail hash

	my $send;						# Mail handler

	my $from;						# Origin of message
	my $rcpt;						# Intended audience
	my $subj;						# Subject of message
	my $body;						# Body of message

	my $id;							# ID Number of message
	my $notice;						# Notice message

	my $email;						# Email address
	my $ignored;						# Ignored users
	my $mailer;						# Mailer settings
	my $name;						# Name of target
	my $target;						# Display of drop down


	#####################
	# Program area

	# Data retreival
	$from = $param->{'MFROM'};	
	$rcpt = $param->{'BCHAR'};
	$subj = $param->{'MSUBJ'};
	$body = $param->{'MBODY'};

	# Determine puppeteer
	($target)  = $database->DataGetPuppeteerLogin($param->{'BCHAR'});
	($ignored) = $database->DataGetIgnored($target, $rcpt, $param->{'USER'});


	# Determine action
	# Processing
	if ((defined($target))
	 && (!defined($ignored)))
	{
		# Retreive full name
		($name)           = $database->DataGetPuppeteerName($target);
		($email, $mailer) = $database->DataGetPuppeteerEmail($target);

		# Pull ID
		($id)     = $database->DataGetInsert('seqMail');

		# Insert into database
		$database->Quick("INSERT INTO Mail
			(MailIDNumber,
			 PuppeteerLogin,
			 MailFrom,
			 MailRcpt,
			 MailSubject,
			 MailContents)
			VALUES(?,?,?,?,?,?)", 

		 $id,
		 $target,
		 $from,
		 $rcpt,
		 $subj,
		 $body);


	 	# Mail notification
		if ($mailer eq 'ext')
		{
			# Final preperations
			# Retreive values
			($notice) = $database->DocumentGetMailNotice();
				

			# Compose and send email
			# Message information
			if (defined($notice))
			{
				# Send mail
				# Initiate instance
				$send = tie(*MAIL, 'Ethereal::Mail', $database);

				# Initial setup
				$send->SetSubject("You have mail from: $from");
				$send->SetSearch(
					AUTHSTRING  => $database->{'SYS'}{'LnkExtMail'},
					FULLNAME    => $name,
					ORIGIN      => $from,
					RETURNEMAIL => $database->{'SYS'}{'SetInfoContactAddress'},
					SERVERNAME  => $database->{'SYS'}{'SetInfoServer'},
					SUBJECT     => $subj
				 );

				# Recipients
				$send->AddTo("$name <$email>");

				# Message
				print MAIL $notice;

				# Close and Send
				close(MAIL);
			}
		}
	}

	# Notify user
	return $bio->{'TmplSentMail'};
}
