#!/usr/bin/perl

# LiCoM - Lightweight contact manager
# Copyright (c) 2005-2006  Florian octo Forster <octo at verplant.org>
#
# 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; only version 2 of the License is applicable.
#
# 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

use strict;
use warnings;
use lib (qw(lib));

use Encode (qw(encode decode is_utf8));
use CGI (':cgi');
use CGI::Carp (qw(fatalsToBrowser));
use URI::Escape;
use HTML::Entities (qw(encode_entities));

use LiCoM::Config (qw(get_config set_config read_config));
use LiCoM::Connection ();
use LiCoM::Group ();
use LiCoM::Person ();

our $Debug = 0;

our @MultiFields = (qw(address homephone cellphone officephone fax mail uri));

our %FieldNames = 
(
	address		=> 'Address',
	homephone	=> 'Home Phone',
	cellphone	=> 'Cell Phone',
	officephone	=> 'Office Phone',
	fax		=> 'FAX',
	mail		=> 'E-Mail',
	uri		=> 'URI (Homepage)',
	group		=> 'Group'
);

our $MySelf = $ENV{'SCRIPT_NAME'};

our $Action = param_utf8 ('action');
$Action ||= 'default';

our %Actions =
(
	browse	=> [\&html_start, \&action_browse,  \&html_end],
	default	=> [\&html_start, \&action_browse,  \&html_end],
	detail	=> [\&html_start, \&action_detail,  \&html_end],
	edit	=> [\&html_start, \&action_edit,    \&html_end],
	list	=> [\&html_start, \&action_list,    \&html_end],
	save	=> [\&html_start, \&action_save,    \&html_end],
	search	=> [\&html_start, \&action_search,  \&html_end],
	verify	=> [\&html_start, \&action_verify,  \&html_end],
	delete	=> [\&html_start, \&action_ask_del,  \&html_end],
	expunge	=> [\&html_start, \&action_do_del,  \&html_end],
	vcard	=> \&action_vcard,
	edit_group => [\&html_start, \&action_edit_group, \&html_end],
	save_group => [\&html_start, \&action_save_group, \&html_end]
);

read_config ();

# make sure AuthLDAPRemoteUserIsDN is enabled.
die unless ($ENV{'REMOTE_USER'});
#set_config ('base_dn', $ENV{'REMOTE_USER'});

die ("Configuration is incomplete") unless (defined (get_config ('uri'))
	and defined (get_config ('base_dn'))
	and defined (get_config ('bind_dn'))
	and defined (get_config ('password')));

LiCoM::Connection->connect
(
	uri	 => get_config ('uri'),
	bind_dn  => get_config ('bind_dn'),
	password => get_config ('password')
) or die ("Unable to connect to LDAP directory server " . get_config ('uri'));

our ($UserCN, $UserID) = LiCoM::Person->get_user ($ENV{'REMOTE_USER'});

if (!$UserID and $Action ne 'save')
{
	$Action = 'edit';
}

if (!$UserCN)
{
	die ("No such user in the LDAP directory: " . $ENV{'REMOTE_USER'});
}

if (!defined ($Actions{$Action}))
{
	die ("No such action: $Action");
}

if (ref ($Actions{$Action}) eq 'CODE')
{
	$Actions{$Action}->();
}
elsif (ref ($Actions{$Action}) eq 'ARRAY')
{
	for (@{$Actions{$Action}})
	{
		$_->();
	}
}

LiCoM::Connection->disconnect ();

exit (0);

###

sub action_browse
{
	my $group = param_utf8 ('group');
	$group = shift if (@_);
	$group ||= '';

	if (!$group)
	{
		my @groups = LiCoM::Group->all ();

		print qq(\t\t<h2>Contact groups</h2>\n\t\t<ul class="groups">\n);
		for (@groups)
		{
			my $group = $_;
			my @members = $group->get_members ();
			my $members = scalar (@members);
			my $group_name = $group->name ();
			my $group_uri  = uri_escape_utf8 ($group_name);
			my $desc = $group->description ();

			print qq#\t\t\t<li><a href="$MySelf?action=browse&group=$group_uri">#,
			encode_entities ($group_name),
			qq#</a> ($members Member#, ($members == 1 ? ')' : 's)');
			print qq(<br />\n\t\t\t\t<span class="description">),
			encode_entities ($desc) . '</span>' if ($desc);
			print "</li>\n";
		}
		if (!@groups)
		{
			print qq(\t\t\t<li class="empty">There are no groups yet.</li>\n);
		}
		print <<EOF;
		</ul>
		<div class="menu">
			[<a href="$MySelf?action=list">List&nbsp;all</a>]
		</div>
EOF
	}
	else
	{
		my $group_obj    = LiCoM::Group->load ($group);
		my $group_uri    = uri_escape_utf8 ($group_obj->name ());
		my $group_html   = encode_entities ($group_obj->name ());
		my @member_names = $group_obj->get_members ();
		my $desc         = $group_obj->description ();
		my $desc_html    = encode_entities ($desc || '');
		
		print qq(\t\t<h2>Contact group &quot;$group_html&quot;</h2>\n);
		print qq(\t\t<div>$desc_html</div>\n) if ($desc);
		print qq(\t\t<ul class="results">\n);
		for (sort (@member_names))
		{
			my $cn = $_;
			my $cn_uri  = uri_escape_utf8 ($cn);
			my $cn_html = encode_entities ($cn);

			print qq(\t\t\t<li><a href="$MySelf?action=detail&cn=$cn_uri">$cn_html</a></li>\n);
		}
		
		print <<EOF;
		</ul>
		<div class="menu">
			[<a href="$MySelf?action=list&group=$group_uri">List</a>]
			[<a href="$MySelf?action=browse">Back</a>]
			[<a href="$MySelf?action=edit_group&group=$group_uri">Edit</a>]
		</div>
EOF
	}
}

sub action_list
{
	my $group_name = param_utf8 ('group');
	$group_name = shift if (@_);
	$group_name ||= '';

	my $group_name_html = encode_entities ($group_name || '');

	my $title = $group_name
		? "List of group &quot;$group_name_html&quot;"
		: 'List of all addresses';
	my @fields = (qw(address homephone cellphone officephone fax mail));

	my @all = ();
	if ($group_name)
	{
		my $group_obj = LiCoM::Group->load ($group_name);
		if (!$group_obj)
		{
			print <<HTML;
		<div class="error">
			Unable to load group &quot;$group_name_html&quot;.
		</div>
HTML
			return;
		}
		for ($group_obj->get_members ())
		{
			my $cn = $_;
			my $person_obj = LiCoM::Person->load ($cn);

			if (!$person_obj)
			{
				print STDERR "Unable to load cn = $cn;\n";
				next;
			}
			push (@all, $person_obj);
		}
	}
	else
	{
		@all = LiCoM::Person->search ([[group => $group_name]]);
	}

	print <<EOF;
		<h2>$title</h2>

		<table class="list">
			<tr>
				<th>Name</th>
EOF
	for (@fields)
	{
		print "\t\t\t\t<th>" . (defined ($FieldNames{$_}) ? $FieldNames{$_} : $_) . "</th>\n";
	}
	print "\t\t\t</tr>\n";

	for (sort { $a->name () cmp $b->name () } (@all))
	{
		my $person = $_;
		my $cn = $person->name ();
		my $sn = $person->lastname ();
		my $gn = $person->firstname ();

		my $cn_uri  = uri_escape_utf8 ($cn);
		my $cn_html = encode_entities ("$sn, $gn");

		print "\t\t\t<tr>\n",
		qq(\t\t\t\t<td><a href="$MySelf?action=detail&cn=$cn_uri">$cn_html</a></td>\n);

		for (@fields)
		{
			my $field = $_;
			my @values = $person->get ($field);
			print "\t\t\t\t<td>" . join ('<br />', map { markup_field ($field, $_) } (@values)) . "</td>\n";
		}

		print "\t\t\t</tr>\n";
	}
	print "\t\t</table>\n\n";

	if ($group_name)
	{
		my $group_esc = uri_escape_utf8 ($group_name);
		print qq(\t\t<div class="menu">[<a href="$MySelf?action=browse&group=$group_esc">Back</a>]</div>\n);
	}
	else
	{
		print qq(\t\t<div class="menu">[<a href="$MySelf?action=browse">Back</a>]</div>\n);
	}
}

sub action_detail
{
	my $cn = param_utf8 ('cn');
	$cn = shift if (@_);
	die unless ($cn);

	my $cn_html = encode_entities ($cn);
	my $cn_uri  = uri_escape_utf8 ($cn);

	my $person = LiCoM::Person->load ($cn);
	if (!$person)
	{
		print qq(\t<div>Entry &quot;$cn_html&quot; could not be loaded from DB.</div>\n);
		return;
	}

	print qq(\t\t<h2>Details for $cn_html</h2>\n);

	print <<EOF;
		<table class="detail">
			<tr>
				<th>Name</th>
				<td>$cn_html</td>
			</tr>
EOF
	for (@MultiFields)
	{
		my $field = $_;
		my $values = $person->get ($field);
		my $num = scalar (@$values);
		my $field_name = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;

		next unless ($num);

		$field_name = encode_entities ($field_name);

		print "\t\t\t<tr>\n";
		if ($num > 1)
		{
			print qq(\t\t\t\t<th rowspan="$num">$field_name</th>\n);
		}
		else
		{
			print qq(\t\t\t\t<th>$field_name</th>\n);
		}

		for (my $i = 0; $i < $num; $i++)
		{
			my $val = markup_field ($field, $values->[$i]);
			
			print "\t\t\t<tr>\n" if ($i);
			print "\t\t\t\t<td>$val</td>\n",
			"\t\t\t</tr>\n";
		}
	}

	my @groups = LiCoM::Group->load_by_member ($cn);
	if (@groups)
	{
		my $num = scalar (@groups);
		print "\t\t\t<tr>\n",
		"\t\t\t\t<th", ($num == 1 ? '' : qq( rowspan="$num")), ">Group", ($num == 1 ? '' : 's'), "</th>\n";
		for (my $i = 0; $i < $num; $i++)
		{
			my $group = $groups[$i];
			my $group_name = $group->name ();
			my $group_uri  = uri_escape_utf8 ($group_name);
			my $group_html = encode_entities ($group_name);

			print "\t\t\t<tr>\n" if ($i != 0);
			print qq(\t\t\t\t<td><a href="$MySelf?action=browse&group=$group_uri">$group_html</a></td>\n),
			"\t\t\t</tr>\n";
		}
	}
	
	print <<EOF;
		</table>

		<div class="menu">
			[<a href="$MySelf?action=verify&cn=$cn_uri">Verify</a>]
			[<a href="$MySelf?action=vcard&cn=$cn_uri">vCard</a>]
			[<a href="$MySelf?action=edit&cn=$cn_uri">Edit</a>]
			[<a href="$MySelf?action=delete&cn=$cn_uri">Delete</a>]
		</div>

EOF
}

sub action_search
{
	my $search = param_utf8 ('search');

	$search ||= '';
	$search =~ s/[^\s\w]//g;

	if (!$search)
	{
		print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
		action_default ();
		return;
	}

	my @patterns = split (m/\s+/, $search);
	my @filter = ();

	for (@patterns)
	{
		my $pattern = "$_*";
		push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
	}

	my @matches = LiCoM::Person->search (@filter);

	if (!@matches)
	{
		print qq(\t<div>No entries matched your search.</div>\n);
		return;
	}

	if (scalar (@matches) == 1)
	{
		my $person = shift (@matches);
		my $cn = $person->name ();
		action_detail ($cn);
		return;
	}

	print qq(\t<ul class="result">\n);
	for (sort { $a->name () cmp $b->name () } (@matches))
	{
		my $person = $_;
		my $cn = $person->name ();
		my $cn_uri  = uri_escape_utf8 ($cn);
		my $cn_html = encode_entities ($cn);

		print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_uri">$cn_html</a></li>\n);
	}
	print qq(\t</ul>\n);
}

sub action_edit
{
	my %opts = @_;

	my $cn = param_utf8 ('cn');

	$cn = $opts{'cn'} if (defined ($opts{'cn'}));
	$cn ||= '';

	my $cn_html = encode_entities ($cn);

	if (!$UserID)
	{
		$cn = $UserCN;
	}

	my $person;

	my $lastname;
	my $firstname;

	my $lastname_html;
	my $firstname_html;

	my $contacts = {};
	$contacts->{$_} = [] for (@MultiFields);

	if ($cn)
	{
		$person = LiCoM::Person->load ($cn);

		if (!$person)
		{
			print qq(\t<div class="error">Unable to load CN &quot;$cn&quot;. Sorry.</div>\n);
			return;
		}
	
		$lastname    = $person->lastname ();
		$firstname   = $person->firstname ();

		for (@MultiFields)
		{
			$contacts->{$_} = $person->get ($_);
		}
	}

	$lastname  = param_utf8 ('lastname')  if (param_utf8 ('lastname')  and $UserID);
	$firstname = param_utf8 ('firstname') if (param_utf8 ('firstname') and $UserID);

	get_contacts ($contacts);
	
	$lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
	$firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
	$lastname_html  = encode_entities ($lastname);
	$firstname_html = encode_entities ($firstname);

	for (@MultiFields)
	{
		my $field = $_;
		@{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
	}

	if ($cn)
	{
		print "\t\t<h2>Edit contact $cn_html</h2>\n";
	}
	else
	{
		print "\t\t<h2>Create new contact</h2>\n";
	}

	print <<EOF;
		<form action="$MySelf" method="post" accept-charset="UTF-8">
		<input type="hidden" name="action" value="save" />
		<input type="hidden" name="cn" value="$cn_html" />
		<table class="edit">
			<tr>
				<th>Lastname</th>
EOF
	if ($UserID)
	{
		print qq(\t\t\t\t<td><input type="text" name="lastname" value="$lastname_html" /></td>\n);
	}
	else
	{
		print qq(\t\t\t\t<td>$lastname_html</td>\n);
	}
	print <<EOF;
			</tr>
			<tr>
				<th>Firstname</th>
EOF
	if ($UserID)
	{
		print qq(\t\t\t\t<td><input type="text" name="firstname" value="$firstname_html" /></td>\n);
	}
	else
	{
		print qq(\t\t\t\t<td>$firstname_html</td>\n);
	}
	
	print "\t\t\t</tr>\n";

	for (@MultiFields)
	{
		my $field = $_;
		my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
		my @values = @{$contacts->{$field}};

		next if ($field eq 'group');

		push (@values, '');

		$field = encode_entities ($field);
		$print = encode_entities ($print);
		
		for (@values)
		{
			my $value = encode_entities ($_);

			print <<EOF;
			<tr>
				<th>$print</th>
				<td><input type="text" name="$field" value="$value" /></td>
			</tr>
EOF
		}
	}

	if ($UserID)
	{
		my @all_groups = LiCoM::Group->all ();

		if (@all_groups)
		{
			print "\t\t\t<tr>\n",
			"\t\t\t\t<th>Group(s)</th>\n",
			qq(\t\t\t\t<td><select name="group" multiple="multiple" size="5">\n);

			for (@all_groups)
			{
				my $group = $_;
				my $group_name = encode_entities ($group->name ());
				my $selected = '';

				if (grep { $cn eq $_ } ($group->get_members ()))
				{
					$selected = ' selected="selected"';
				}

				print qq(\t\t\t\t\t<option value="$group_name"$selected>$group_name</option>\n);
			}
			print "\t\t\t\t</select></td>\n",
			"\t\t\t</tr>\n";
		}
			
		print "\t\t\t<tr>\n",
		"\t\t\t\t<th>New Group</th>\n",
		qq(\t\t\t\t<td><input type="text" name="newgroup" value="" /></td>\n),
		"\t\t\t</tr>\n";
	}

	print <<EOF;
			<tr>
				<th colspan="2" class="menu">
EOF
	if ($UserID)
	{
		print <<EOF;
					<input type="submit" name="button" value="Cancel" />
					<input type="submit" name="button" value="Apply" />
EOF
	}
	print <<EOF;
					<input type="submit" name="button" value="Save" />
				</th>
			</tr>
		</table>
		</form>
EOF
}

sub action_save
{
	my $cn = $UserID ? param_utf8 ('cn') : $UserCN;

	if (verify_fields ())
	{
		action_edit (cn => $cn);
		return;
	}

	if ($cn)
	{
		action_update ();
		return;
	}

	die unless ($UserID);

	my $button = lc (param_utf8 ('button'));
	$button ||= 'save';

	if ($button eq 'cancel')
	{
		action_browse ();
		return;
	}

	if (!param_utf8 ('lastname') or !param_utf8 ('firstname'))
	{
		print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
		action_edit (cn => '');
		return;
	}

	my $lastname  = param_utf8 ('lastname');
	my $firstname = param_utf8 ('firstname');

	my $contacts = get_contacts ();

	my $person = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts);

	if (!$person)
	{
		print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
		return;
	}
	
	$cn = $person->name ();

	for (param_utf8 ('group'))
	{
		my $group_name = $_;
		my $group = LiCoM::Group->load ($group_name);

		if ($group)
		{
			$group->add_members ($cn);
		}
		else
		{
			my $group_html = encode_entities ($group_name);
			print qq(\t<div class="error">Group &quot;$group_html&quot; does not exist or could not be loaded.</div>\n);
		}
	}

	if (param_utf8 ('newgroup'))
	{
		# FIXME add error handling
		my $group_name = param_utf8 ('newgroup');
		LiCoM::Group->create ($group_name, '', $cn);
	}

	if ($button eq 'apply')
	{
		action_edit (cn => $cn);
	}
	else
	{
		action_detail ($cn);
	}
}

sub action_update
{
	my $cn = $UserID ? param_utf8 ('cn') : $UserCN;

	my $person = LiCoM::Person->load ($cn);
	die ("Unable to load CN `$cn'") unless ($person);

	my $button = lc (param_utf8 ('button'));
	$button ||= 'save';

	if ($UserID and $button eq 'cancel')
	{
		action_detail ($cn);
		return;
	}

	if ($UserID)
	{
		my $lastname  = param_utf8 ('lastname');
		my $firstname = param_utf8 ('firstname');

		my $old_cn = $person->name ();

		print <<HTML;
<div><code>
	\$lastname = $lastname<br />
	\$firstname = $firstname<br />
	\$old_cn = $old_cn
</code></div>
HTML

		$person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
		$person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());

		$cn = $person->name ();

		# Change the cn's saved in the groups
		if ($old_cn ne $cn)
		{
			my @groups = LiCoM::Group->load_by_member ($old_cn);
			for (@groups)
			{
				# ->del_members automatically deleted the
				# group, if no more members exist. So this
				# order is important.
				print "<div><code>\$cn = " . encode_entities ($cn) . "; "
				. "\$old_cn = " . encode_entities ($old_cn) . ";</code></div>\n";
				$_->add_members ($cn);
				$_->del_members ($old_cn);
			}
		} # if ($old_cn ne $cn)
	}

	my $contacts = get_contacts ();

	for (@MultiFields)
	{
		my $field = $_;
		
		next if (!$UserID and $field eq 'group');

		if (defined ($contacts->{$field}))
		{
			my $values = $contacts->{$field};
			$person->set ($field, $values);
		}
		else
		{
			$person->set ($field, []);
		}
	}

	# only `authorized' users may see and change groups
	if ($UserID)
	{
		my %changed_groups = map { $_ => 1 } (param_utf8 ('group'));
		my @current_groups = LiCoM::Group->load_by_member ($cn);

		for (@current_groups)
		{
			my $group_obj = $_;
			my $group_name = $group_obj->name ();

			if (!defined ($changed_groups{$group_name}))
			{
				$group_obj->del_members ($cn);
			}
			else
			{
				delete ($changed_groups{$group_name});
			}
		}
		for (keys %changed_groups)
		{
			my $group_name = $_;
			my $group_obj = LiCoM::Group->load ($group_name) or die;

			$group_obj->add_members ($cn);
		}

		if (param_utf8 ('newgroup'))
		{
			# FIXME add error handling
			my $group_name = param_utf8 ('newgroup');
			LiCoM::Group->create ($group_name, '', $cn);
		}
	}

	if (!$UserID)
	{
		print <<HTML;
		<h3>Your changes have been saved.</h3>
		<p>Thank you very much for taking the time to keep this record up to date.</p>

HTML
	}

	if ($button eq 'apply' or !$UserID)
	{
		action_edit (cn => $cn);
	}
	else
	{
		action_detail ($cn);
	}
}

sub action_vcard
{
	my $cn = param_utf8 ('cn');
	$cn = shift if (@_);
	die unless ($cn);

	my $person = LiCoM::Person->load ($cn);
	die unless ($person);

	my %vcard_types =
	(
		homephone	=> 'TEL;TYPE=home,voice',
		cellphone	=> 'TEL;TYPE=cell',
		officephone	=> 'TEL;TYPE=work,voice',
		fax		=> 'TEL;TYPE=fax',
		mail		=> 'EMAIL',
		uri		=> 'URL',
		group		=> 'ORG'
	);

	my $sn = $person->lastname ();
	my $gn = $person->firstname ();
	my $cn_esc = uri_escape_utf8 ($cn);

	print <<EOF;
Content-Type: text/x-vcard
Content-Disposition: attachment; filename="$cn.vcf"

BEGIN:VCARD
VERSION:3.0
FN: $cn
N: $sn;$gn
EOF

	for (@MultiFields)
	{
		my $field = $_;
		my $vc_fld = $vcard_types{$field};
		my $values = $person->get ($field);

		next unless ($vc_fld);

		for (@$values)
		{
			my $value = $_;
			print "$vc_fld:$value\n";
		}
	}
	print "END:VCARD\n";
}

sub action_verify
{
	my $cn = param_utf8 ('cn');
	$cn = shift if (@_);
	die unless ($cn);

	my $cn_html = encode_entities ($cn);

	my $person = LiCoM::Person->load ($cn);
	die unless ($person);

	my ($mail) = $person->get ('mail');
	$mail ||= '';

	my $message;
	my ($password) = $person->get ('password');
	my $password_html;

	if (!$password)
	{
		$password = pwgen ();
		$person->set ('password', [$password]);
	}
	$password_html = encode_entities ($password);

	$message = qq(The password for the record &quot;$cn_html&quot; is &quot;$password_html&quot;.);

	if ($mail)
	{
		if (action_verify_send_mail ($person))
		{
			my $mail_html = encode_entities ($mail);
			$message .= qq( A request for verification has been sent to $mail_html.);
		}
	}
	else
	{
		$message .= q( There was no e-mail address, thus no verification request could be sent.);
	}

	print qq(\t\t<div class="message">$message</div>\n);

	action_detail ($cn);
}

sub action_verify_send_mail
{
	my $person = shift;
	my $owner = LiCoM::Person->load ($UserCN);
	my $smh;

	my ($owner_mail) = $owner->get ('mail');
	if (!$owner_mail)
	{
		my $cn_uri = uri_escape_utf8 ($UserCN);
		print qq(\t\t<div class="error">You have no email set in your own profile. <a href="$MySelf?action=edit&cn=$cn_uri">Edit it now</a>!</div>\n);
		return (0);
	}

	my $max_width = 0;
	for (keys %FieldNames)
	{
		$max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_});
	}
	$max_width++;

	my $person_name   = $person->name ();
	my ($person_mail) = $person->get ('mail');
	my $person_gn     = $person->firstname ();
	my ($password)    = $person->get ('password');

	my $host = $ENV{'HTTP_HOST'};
	my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : 'http://') . $host . $MySelf;
	
	open ($smh, '|-', '/usr/sbin/sendmail', '-t', '-f', $owner_mail) or die ("open (sendmail): $!");
	print $smh <<EOM;
To: $person_name <$person_mail>
From: $UserCN <$owner_mail>
Subject: Please verify our entry in my address book

Hello $person_gn,

the following is your entry in my address book:
EOM
	for (@MultiFields)
	{
		my $field = $_;
		my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
		my @values = $person->get ($field);

		for (@values)
		{
			printf $smh ('%'.$max_width."s: %-s\n", $print, $_);
		}
	}
	print $smh <<EOM;

If this entry is outdated or incomplete, please take a minute and correct it.
  Address: $url
 Username: $person_name
 Password: $password

Thank you very much :)

Regards,
$UserCN
--
This message was automatically generated by LiCoM,
http://verplant.org/licom/
EOM
	close ($smh);

	return (1);
}

sub action_ask_del
{
	my $cn = param_utf8 ('cn');
	$cn or die;

	my $person = LiCoM::Person->load ($cn);
	$person or die;

	my $cn_uri  = uri_escape_utf8 ($cn);
	my $cn_html = encode_entities ($cn);

	print <<EOF;
		<h2>Really delete $cn_html?</h2>

		<div>
			You are about to delete <strong>$cn_html</strong>.
			Are you totally, absolutely sure you want to do this?
		</div>

		<div class="menu">
			[<a href="$MySelf?action=expunge&cn=$cn_uri">Yes, delete</a>]
			[<a href="$MySelf?action=detail&cn=$cn_uri">No, keep</a>]
		</div>

EOF
}

sub action_do_del
{
	my $cn = param_utf8 ('cn');
	$cn or die;

	my $cn_html = encode_entities ($cn);

	my $person = LiCoM::Person->load ($cn);
	$person or die;

	$person->delete ();

	print <<EOF;
		<div>$cn_html has been deleted.</div>

EOF
	action_browse ();
}

sub action_edit_group
{
	my $group_name = param_utf8 ('group') or die;

	my $group_name_html = encode_entities ($group_name);

	my $group_obj = LiCoM::Group->load ($group_name);

	if (!$group_obj)
	{
		print qq(\t<div class="error">Group &quot;$group_name_html&quot; does not exist or could not be loaded.</div>\n);
		return;
	}

	$group_name_html = encode_entities ($group_obj->name ());

	my $desc_html = encode_entities ($group_obj->description () || '');

	print <<HTML;
	<h2>Edit contact group &quot;$group_name_html&quot;</h2>
	<form action="$MySelf" method="post" accept-charset="UTF-8">
	  <input type="hidden" name="action" value="save_group" />
	  <input type="hidden" name="group" value="$group_name_html" />
	  <table>
	    <tr>
	      <th>Group Name</th>
	      <td>$group_name_html</td>
	    </tr>
	    <tr>
	      <th>Description</th>
	      <td><input type="text" name="description" value="$desc_html" /></td>
	    </tr>
	    <tr>
	      <th colspan="2"><input type="submit" name="button" value="Save" /></th>
	    </tr>
	  </table>
	</form>
HTML
}

sub action_save_group
{
	my $group_name = param_utf8 ('group') or die;

	my $group_name_html = encode_entities ($group_name);

	my $group_obj = LiCoM::Group->load ($group_name);

	if (!$group_obj)
	{
		print qq(\t<div class="error">Group &quot;$group_name_html&quot; does not exist or could not be loaded.</div>\n);
		return;
	}

	my $desc = param_utf8 ('description');
	$group_obj->description ($desc);

	action_browse ();
	return;
}

sub html_start
{
	my $title = shift;
	$title = q(Lightweight Contact Manager) unless ($title);

	$title = encode_entities ($title);

	print <<EOF;
Content-Type: text/html; charset=UTF-8

<html>
	<head>
		<title>$title</title>
		<style type="text/css">
		<!--
		\@media screen
		{
			a
			{
				color: blue;
				background-color: inherit;
				text-decoration: none;
			}

			a:hover
			{
				text-decoration: underline;
			}

			a:visited
			{
				color: navy;
				background-color: inherit;
			}

			body
			{
				color: black;
				background-color: white;
			}

			div.error
			{
				color: red;
				background-color: yellow;

				font-weight: bold;
				padding: 1ex;
				border: 2px solid red;
			}

			div.foot
			{
				color: gray;
				background-color: white;

				position: fixed;
				top: auto;
				right: 0px;
				bottom: 0px;
				left: 0px;

				font-size: x-small;
				text-align: right;
				border-top: 1px solid black;
				width: 100%;
			}

			div.foot a
			{
				color: black;
				background-color: inherit;
				text-decoration: none;
			}

			div.foot a:hover
			{
				text-decoration: underline;
			}

			div.menu
			{
				border-top: 1px solid black;
				margin-top: 1ex;
				font-weight: bold;
			}

			div.menu a
			{
				color: blue;
				background-color: transparent;
			}

			div.topmenu
			{
				margin-bottom: 1ex;
				padding-bottom: 1ex;
				border-bottom: 1px solid black;
			}

			div.topmenu form
			{
				display: inline;
				margin-right: 5ex;
			}

			h1
			{
				position: absolute;
				top: 1ex;
				right: 1ex;
				bottom: auto;
				left: auto;

				font-size: 100%;
				font-weight: bold;
			}

			img
			{
				border: none;
			}

			table.list
			{
				width: 100%;
				border: 2px solid #d0d0d0;
			}

			table.list td
			{
				empty-cells: show;
			}

			td
			{
				color: black;
				background-color: #e8e8e8;
				vertical-align: top;
			}

			th
			{
				color: black;
				background-color: #d0d0d0;
				padding: 0.3ex;
				text-align: left;
				vertical-align: top;
			}

			ul.groups li
			{
				margin-top: 0.5ex;
			}
		}

		\@media print
		{
			a
			{
				color: inherit;
				background-color: inherit;
				text-decoration: underline;
			}
			
			div.topmenu, div.menu
			{
				display: none;
			}

			div.foot
			{
				font-size: 50%;
				text-align: right;
			}

			h1
			{
				display: none;
			}

			h2
			{
				font-size: 100%;
			}

			table
			{
				border-collapse: collapse;
			}

			table.list
			{
				width: 100%;
			}

			table.list td
			{
				empty-cells: show;
			}

			table.list th
			{
				border-bottom-width: 2px;
			}

			td, th
			{
				border: 1px solid black;
				vertical-align: top;
			}

			th
			{
				font-weight: bold;
				text-align: center;
			}
		}
		//-->
		</style>
	</head>

	<body>
EOF

	if ($UserID)
	{
		my $search = param_utf8 ('search') || '';
		$search = encode_entities ($search);
		print <<EOF;
		<div class="topmenu">
			<form action="$MySelf" method="post" accept-charset="UTF-8">
				<input type="hidden" name="action" value="browse" />
				<input type="submit" name="button" value="Browse" />
			</form>
			<form action="$MySelf" method="post" accept-charset="UTF-8">
				<input type="hidden" name="action" value="search" />
				<input type="text" name="search" value="$search" />
				<input type="submit" name="button" value="Search" />
			</form>
			<form action="$MySelf" method="post" accept-charset="UTF-8">
				<input type="hidden" name="action" value="edit" />
				<input type="hidden" name="dn" value="" />
				<input type="submit" name="button" value="Add New" />
			</form>
		</div>
EOF
	}
	print "\t\t<h1>$title</h1>\n";
}

sub html_end
{
	print <<EOF;
		<div class="foot">
			&quot;Lightweight Contact Manager&quot;,
			written 2005-2006 by <a href="http://verplant.org/">Florian octo Forster</a>
			&lt;octo at verplant.org&gt;
		</div>
	</body>
</html>
EOF
}

sub pwgen
{
	my $len = @_ ? shift : 6;
	my $retval = '';

	while (!$retval)
	{
		my $numbers = 0;
		my $lchars  = 0;
		my $uchars  = 0;
		
		while (length ($retval) < $len)
		{
			my $chr = int (rand (128));

			if ($chr >= 48 and $chr < 58)
			{
				$numbers++;
			}
			elsif ($chr >= 65 and $chr < 91)
			{
				$uchars++;
			}
			elsif ($chr >= 97 and $chr < 123)
			{
				$lchars++;
			}
			else
			{
				next;
			}
			$retval .= chr ($chr);
		}

		$retval = '' if (!$numbers or !$lchars or !$uchars);
	}

	return ($retval);
}

sub verify_fields
{
	my @errors = ();
	for (param_utf8 ('uri'))
	{
		my $val = $_;
		next unless ($val);

		if ($val !~ m#^[a-zA-Z]+://#)
		{
			push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
			last;
		}
	}

	for (param_utf8 ('homephone'), param_utf8 ('cellphone'), param_utf8 ('officephone'), param_utf8 ('fax'))
	{
		my $number = $_;
		next unless ($number);

		if ($number !~ m/^\+[0-9 \-]+$/)
		{
			push (@errors, 'Telephone numbers have to begin with the country code and only numbers, spaces and dashes are allowed, e.g. &quot;+49 911-123456&quot;');
			last;
		}
	}

	print qq(\t\t<div class="error">\n) if (@errors);
	for (my $i = 0; $i < scalar (@errors); $i++)
	{
		my $e = $errors[$i];

		print "<br />\n" if ($i);
		print "\t\t\t$e";
	}
	print qq(\n\t\t</div>\n\n) if (@errors);

	return (scalar (@errors));
}

sub markup_field
{
	my $field = shift;
	my $value = shift;

	my $value_uri  = uri_escape_utf8 ($value);
	my $value_html = encode_entities ($value);

	if ($field eq 'group')
	{
		return (qq(<a href="$MySelf?action=browse&group=$value_uri">$value_html</a>));
	}
	elsif ($field eq 'uri')
	{
		if ($value =~ m#^([a-z]+)://(.+)$#)
		{
			$value_uri = $1 . '://' . uri_escape_utf8 ($2);
		}
		else
		{
			$value_uri = 'http://' . uri_escape_utf8 ($value);
		}
		return (qq(<a href="$value_uri" class="extern">$value_html</a>));
	}
	elsif ($field eq 'mail')
	{
		return (qq(<a href="mailto:$value_uri" class="mail">$value_html</a>));
	}
	return ($value_html);
}

sub get_contacts
{
	my $contacts = @_ ? shift : {};

	for (@MultiFields)
	{
		my $field = $_;
		my @values = grep { $_ } (param_utf8 ($field));

		next unless (@values);

		if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
		{
			for (@values)
			{
				$_ =~ s/[^0-9 \-]//g;
				$_ = '+' . $_ if ($_);
			}
		}
		
		$contacts->{$field} = [@values] if (@values);
	}

	return ($contacts);
}

sub is_valid_utf8
{
	my $str = join ('', @_);

	# Taken from here: <http://www.w3.org/International/questions/qa-forms-utf-8>
	return ($str =~ m/^(
     [\x09\x0A\x0D\x20-\x7E]            # ASCII
   | [\xC2-\xDF][\x80-\xBF]             # non-overlong 2-byte
   |  \xE0[\xA0-\xBF][\x80-\xBF]        # excluding overlongs
   | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straight 3-byte
   |  \xED[\x80-\x9F][\x80-\xBF]        # excluding surrogates
   |  \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3
   | [\xF1-\xF3][\x80-\xBF]{3}          # planes 4-15
   |  \xF4[\x80-\x8F][\x80-\xBF]{2}     # plane 16
  )*$/x);
}

sub param_utf8
{
	my @args = @_;
	my @ret = ();

	@ret = grep { is_valid_utf8 ($_) } (param (@args));
	$_ = decode ('UTF-8', $_) for (@ret);
	return (wantarray () ? @ret : $ret[0]);
}

sub uri_escape_utf8
{
	return (uri_escape (encode ('UTF-8', shift)));
}