From: octo <octo>
Date: Fri, 22 Apr 2005 16:17:36 +0000 (+0000)
Subject: Initial import
X-Git-Tag: Release-0.1~15
X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=6333caf0b25222e22ccae4e103b10a366d8155f5;p=licom.git

Initial import
---

6333caf0b25222e22ccae4e103b10a366d8155f5
diff --git a/book.cgi b/book.cgi
new file mode 100755
index 0000000..c6de51e
--- /dev/null
+++ b/book.cgi
@@ -0,0 +1,482 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use lib (qw(lib));
+
+use CGI (':cgi');
+use CGI::Carp (qw(fatalsToBrowser));
+use URI::Escape;
+use Data::Dumper;
+
+use Person;
+
+our $Debug = 0;
+our %Config = ();
+
+our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group));
+
+our $MySelf = $ENV{'SCRIPT_NAME'};
+
+our $Action = param ('action');
+$Action ||= 'default';
+
+our %Actions =
+(
+	default	=> \&action_default,
+	edit	=> \&action_edit,
+	save	=> \&action_save,
+	search	=> \&action_search
+);
+
+read_config ();
+
+# make sure AuthLDAPRemoteUserIsDN is enabled.
+die unless ($ENV{'REMOTE_USER'});
+$Config{'base_dn'} = $ENV{'REMOTE_USER'};
+
+Person->connect
+(
+	uri	=> $Config{'uri'},
+	base_dn => $Config{'base_dn'},
+	bind_dn => $Config{'bind_dn'},
+	password => $Config{'password'}
+) or die;
+
+our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'});
+
+if (!$UserID and $Action ne 'save')
+{
+	$Action = 'edit';
+}
+
+print <<HEADER;
+Content-Type: text/html; charset=UTF-8
+
+HEADER
+
+print_html_start ("octo's Address Book");
+
+if (!$UserCN)
+{
+	die;
+}
+
+if (!defined ($Actions{$Action}))
+{
+	die;
+}
+
+$Actions{$Action}->();
+
+print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
+
+print_html_end ();
+
+Person->disconnect ();
+
+exit (0);
+
+###
+
+sub action_default
+{
+	print "<code>action_default</code>\n";
+}
+
+sub action_search
+{
+	print "<code>action_search</code>\n";
+}
+
+sub action_edit
+{
+	my %opts = @_;
+
+	my $cn = param ('cn');
+
+	$cn = $opts{'cn'} if (defined ($opts{'cn'}));
+	$cn ||= '';
+
+	if (!$UserID)
+	{
+		$cn = $UserCN;
+	}
+
+	my $person;
+
+	my $lastname;
+	my $firstname;
+
+	my $contacts = {};
+	$contacts->{$_} = [] for (@MultiFields);
+
+	if ($cn)
+	{
+		$person = 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 ();
+		$contacts->{'address'}     = $person->address ();
+		$contacts->{'homephone'}   = $person->homephone ();
+		$contacts->{'cellphone'}   = $person->cellphone ();
+		$contacts->{'officephone'} = $person->officephone ();
+		$contacts->{'fax'}         = $person->fax ();
+		$contacts->{'mail'}        = $person->mail ();
+		$contacts->{'uri'}         = $person->uri ();
+		$contacts->{'group'}       = $person->group ();
+	}
+
+	$lastname    = param ('lastname')    if (param ('lastname')  and $UserID);
+	$firstname   = param ('firstname')   if (param ('firstname') and $UserID);
+
+	get_contacts ($contacts);
+	
+	$lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
+	$firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
+	for (@MultiFields)
+	{
+		my $field = $_;
+		@{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
+	}
+
+	if ($cn)
+	{
+		print "<h2>Edit contact $cn</h2>\n";
+	}
+	else
+	{
+		print "<h2>Create new contact</h2>\n";
+	}
+
+	my $selector = sub
+	{
+		my $selected = @_ ? shift : '';
+
+		my @options =
+		(
+			[none		=> '-- Contact --'],
+			[address	=> 'Address'],
+			[homephone	=> 'Home Phone'],
+			[cellphone	=> 'Cellphone'],
+			[officephone	=> 'Office Phone'],
+			[fax		=> 'FAX'],
+			[mail		=> 'E-Mail'],
+			[uri		=> 'URI (Homepage)'],
+			[group		=> 'Group']
+		);
+
+		print qq(<select name="c_type">\n);
+		for (@options)
+		{
+			my ($field, $print) = @$_;
+			my $sel = $field eq $selected ? ' selected="selected"' : '';
+			print qq(\t\t\t\t<option value="$field"$sel>$print</option>\n);
+		}
+		print qq(\t\t\t</select>);
+	};
+
+	print <<EOF;
+	<form action="$MySelf" method="post">
+	<input type="hidden" name="action" value="save" />
+	<input type="hidden" name="cn" value="$cn" />
+	<table class="edit">
+		<tr>
+			<td>Lastname</td>
+EOF
+	if ($UserID)
+	{
+		print qq(\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
+	}
+	else
+	{
+		print qq(\t\t\t<td>$lastname</td>\n);
+	}
+	print <<EOF;
+		</tr>
+		<tr>
+			<td>Firstname</td>
+EOF
+	if ($UserID)
+	{
+		print qq(\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
+	}
+	else
+	{
+		print qq(\t\t\t<td>$firstname</td>\n);
+	}
+	
+	print "\t\t</tr>\n";
+
+	for (@MultiFields)
+	{
+		my $field = $_;
+		my @values = @{$contacts->{$field}};
+
+		@values = ('') unless (@values);
+		
+		for (@values)
+		{
+			my $value = $_;
+			print "\t\t<tr>\n",
+			"\t\t\t<td>";
+			$selector->($field);
+			print "</td>\n", <<EOF;
+			<td><input type="text" name="c_value" value="$value" /></td>
+		</tr>
+EOF
+		}
+	}
+
+	print "\t\t<tr>\n",
+	"\t\t\t<td>";
+	$selector->();
+	print "</td>\n", <<EOF;
+			<td><input type="text" name="c_value" value="" /></td>
+		</tr>
+		<tr>
+			<td colspan="2"><input type="submit" name="button" value="Save" /></td>
+		</tr>
+	</table>
+	</form>
+EOF
+}
+
+sub action_save
+{
+	my $cn = $UserID ? param ('cn') : $UserCN;
+
+	if ($cn)
+	{
+		action_update ();
+		return;
+	}
+
+	die unless ($UserID);
+
+	if (!param ('lastname') or !param ('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 ('lastname');
+	my $firstname = param ('firstname');
+
+	my $contacts = get_contacts ();
+
+	my $person = 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 ();
+
+	action_edit (cn => $cn);
+}
+
+sub action_update
+{
+	my $cn = $UserID ? param ('cn') : $UserCN;
+	my $person = Person->load ($cn);
+
+	die unless ($person);
+
+	if ($UserID)
+	{
+		my $lastname  = param ('lastname');
+		my $firstname = param ('firstname');
+
+		$person->lastname  ($lastname)  if ($lastname);
+		$person->firstname ($firstname) if ($firstname);
+
+		$cn = $person->name ();
+	}
+
+	my $contacts = get_contacts ();
+
+	for (@MultiFields)
+	{
+		my $field = $_;
+		
+		if (defined ($contacts->{$field}))
+		{
+			my $values = $contacts->{$field};
+			$person->set ($field, $values);
+		}
+		else
+		{
+			$person->set ($field, []);
+		}
+	}
+
+	action_edit (cn => $cn);
+}
+
+sub print_html_start
+{
+	my $title = shift;
+	$title = 'Search for names' unless ($title);
+
+	print <<EOF;
+<html>
+<head>
+<title>$title</title>
+<style type="text/css">
+<!--
+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;
+	
+	font-size: x-small;
+	text-align: right;
+	border-top: 1px solid black;
+	width: 100%;
+}
+
+div.menu form
+{
+	display: inline;
+	margin-right: 5ex;
+}
+
+img
+{
+	border: none;
+}
+
+td
+{
+	color: black;
+	background-color: #cccccc;
+}
+
+th
+{
+	color: black;
+	background-color: #999999;
+	text-align: left;
+}
+//-->
+</style>
+</head>
+
+<body>
+EOF
+	if ($UserID)
+	{
+		my $search = param ('search') || '';
+		print <<EOF;
+	<div class="menu">
+		<form action="$MySelf" method="post">
+			<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">
+			<input type="hidden" name="action" value="edit" />
+			<input type="hidden" name="dn" value="" />
+			<input type="submit" name="button" value="Add New" />
+		</form>
+	</div>
+	<hr />
+EOF
+	}
+	print "\t<h1>octo's lightweight address book</h1>\n";
+}
+
+sub print_html_end
+{
+	print <<EOF;
+		<div class="foot">octo's Address Book &lt;octo at verplant.org&gt;</div>
+	</body>
+</html>
+EOF
+}
+
+sub read_config
+{
+	my $file = '/var/www/html/cgi.verplant.org/address/book.conf';
+	my $fh;
+
+	open ($fh, "< $file") or die ("open ($file): $!");
+	for (<$fh>)
+	{
+		chomp;
+		my $line = $_;
+
+		if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
+		{
+			my $key = lc ($1);
+			my $val = $2;
+
+			$Config{$key} = $val;
+		}
+	}
+
+	close ($fh);
+
+	for (qw(uri bind_dn password))
+	{
+		die ("Not defined: $_") unless (defined ($Config{$_}));
+	}
+}
+
+sub get_contacts
+{
+	my $contacts = @_ ? shift : {};
+
+	if (param ('c_value'))
+	{
+		my @c_values = param ('c_value');
+		my @c_types  = param ('c_type');
+
+		my %cts = ();
+
+		die if (scalar (@c_values) != scalar (@c_types));
+
+		for (my $i = 0; $i < scalar (@c_values); $i++)
+		{
+			my $type  = $c_types[$i];
+			my $value = $c_values[$i];
+
+			$cts{$type} = [] unless (defined ($cts{$type}));
+			push (@{$cts{$type}}, $value) if ($value);
+		}
+
+		for (@MultiFields)
+		{
+			my $type = $_;
+			@{$contacts->{$type}} = @{$cts{$type}} if (defined ($cts{$type}));
+		}
+	}
+
+	return ($contacts);
+}
diff --git a/lib/Person.pm b/lib/Person.pm
new file mode 100644
index 0000000..79ed9f7
--- /dev/null
+++ b/lib/Person.pm
@@ -0,0 +1,529 @@
+package Person;
+
+use strict;
+use warnings;
+
+use Net::LDAP;
+use Net::LDAP::Filter;
+
+=head1 NAME
+
+Person - High level interface for address books using an LDAP-backend.
+
+=cut
+
+our %Config =
+(
+	base_dn		=> undef
+);
+
+our %ValidFields =
+(
+	telephoneNumber			=> 1,
+	facsimileTelephoneNumber	=> 1,
+	sn				=> 0,
+	cn				=> 0,
+	givenName			=> 0,
+	homePhone			=> 1,
+	homePostalAddress		=> 1,
+	labeledURI			=> 1,
+	mail				=> 1,
+	mobile				=> 1,
+	o				=> 1
+);
+
+our %ExternalNames =
+(
+	officephone	=> 'telephoneNumber',
+	fax		=> 'facsimileTelephoneNumber',
+	lastname	=> 'sn',
+	name		=> 'cn',
+	firstname	=> 'givenName',
+	homephone	=> 'homePhone',
+	address		=> 'homePostalAddress',
+	uri		=> 'labeledURI',
+	mail		=> 'mail',
+	cellphone	=> 'mobile',
+	group		=> 'o'
+);
+
+our $Ldap;
+
+return (1);
+
+=head1 METHODS
+
+=over 4
+
+=item Person-E<gt>B<connect> (I<$server>, I<$bind_dn>, I<$password>, I<$base_dn>, [I<$port>])
+
+Connects to the LDAP-Server given.
+
+=cut
+
+sub connect
+{
+	my $pkg = shift;
+	my %opts = @_;
+
+	my $bind_dn = $opts{'bind_dn'};
+	my $base_dn = $opts{'base_dn'};
+	my $uri     = $opts{'uri'};
+	my $passwd  = $opts{'password'};
+
+	my $msg;
+
+	$Ldap = Net::LDAP->new ($uri);
+
+	$msg = $Ldap->bind ($bind_dn, password => $passwd);
+	if ($msg->is_error ())
+	{
+		warn ('LDAP bind failed: ' . $msg->error_text ());
+		return (0);
+	}
+
+	$Config{'base_dn'} = $base_dn;
+
+	return (1);
+}
+
+=item Person-E<gt>B<disconnect> ()
+
+Disconnect from the LDAP-Server.
+
+=cut
+
+sub disconnect
+{
+	$Ldap->unbind ();
+	$Ldap = undef;
+}
+
+=item Person-E<gt>B<new> (I<$ldap_entry>)
+
+Created a new I<Person>-object from the passed I<Net::LDAP::Entry>-object.
+
+=cut
+
+sub new
+{
+	my $pkg = shift;
+	my $entry = shift;
+	my $obj = {};
+
+	$obj->{'dn'} = $entry->dn ();
+	$obj->{'ldap'} = $entry;
+
+	for (keys %ValidFields)
+	{
+		my $key = $_;
+		$obj->{$key} = $entry->get_value ($key, asref => $ValidFields{$key});
+	}
+
+	return (bless ($obj, $pkg));
+}
+
+=item Person-E<gt>B<load> (I<$cn>)
+
+Loads the given CN and returns the B<Person>-object.
+
+=cut
+
+sub load
+{
+	my $pkg = shift;
+	my $cn = shift;
+
+	my ($retval) = search ($pkg, cn => $cn);
+
+	if (!$retval)
+	{
+		warn ("CN '$cn' could not be found");
+		return (undef);
+	}
+	
+	return ($retval);
+}
+
+=item Person-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)
+
+Create a new I<Net::LDAP::Entry>-object and return it's corresponding
+I<Person>-object.
+
+=cut
+
+sub create
+{
+	my $pkg = shift;
+
+	my %hash = @_;
+	my $entry = Net::LDAP::Entry->new ();
+	my $dn;
+	my $ou;
+
+	$entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]);
+
+	for (keys %hash)
+	{
+		my $key = $_;
+		my $val = $hash{$key};
+		my $field = defined ($ExternalNames{$key}) ? $ExternalNames{$key} : $key;
+		
+		if (!defined ($ValidFields{$field}))
+		{
+			warn ("Invalid field $field");
+			next;
+		}
+
+		if ($ValidFields{$field})
+		{
+			if (ref ($val) eq 'ARRAY')
+			{
+				$entry->add ($field => [@$val]);
+			}
+			elsif (!ref ($val))
+			{
+				$entry->add ($field => [$val]);
+			}
+			else
+			{
+				warn ("You cannot pass ref-type " . ref ($val));
+			}
+		}
+		else
+		{
+			my $temp;
+			if (ref ($val) eq 'ARRAY')
+			{
+				$temp = $val->[0];
+			}
+			elsif (!ref ($val))
+			{
+				$temp = $val;
+			}
+			else
+			{
+				warn ("You cannot pass ref-type " . ref ($val));
+			}
+
+			$entry->add ($field => $val) if (defined ($val) and $val);
+		}
+	}
+
+	my $sn = $entry->get_value ('sn');
+	my $gn = $entry->get_value ('givenName');
+
+	if (!defined ($sn) or !defined ($gn))
+	{
+		warn ("sn or givenName not given");
+		return (undef);
+	}
+
+	$dn = "cn=$sn $gn," . $Config{'base_dn'};
+	($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i;
+	
+	$entry->add (cn => "$sn $gn", ou => $ou);
+	$entry->dn ($dn);
+
+	print "<!--\n";
+	$entry->dump (*STDOUT);
+	print "-->\n";
+
+	$entry->changetype ('add');
+	my $mesg = $entry->update ($Ldap);
+
+	if ($mesg->is_error ())
+	{
+		warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
+		return (undef);
+	}
+
+	return (new ($pkg, $entry));
+}
+
+=item Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
+
+Search for the given patterns. Returns a list of I<Person>-objects.
+
+=cut
+
+sub search
+{
+	my $pkg = shift;
+	my %patterns = @_;
+	my %filter = ();
+	my $filter = '(objectclass=inetOrgPerson)';
+	my $mesg;
+	my @retval = ();
+
+	for (keys %patterns)
+	{
+		my $key = $_;
+		my $val = $patterns{$key};
+
+		$key = $ExternalNames{$key} if (defined ($ExternalNames{$key}));
+		if (!defined ($ValidFields{$key}))
+		{
+			warn ("Not a valid field: $key");
+			next;
+		}
+
+		$filter{$key} = $val;
+	}
+
+	if (%filter)
+	{
+		if (scalar (keys %filter) == 1)
+		{
+			my ($key) = keys (%filter);
+			my $val = $filter{$key};
+			$filter = "(& $filter ($key=$val))";
+		}
+		else
+		{
+			my $tmp = join (' ', map { '(' . $_ . '=' . $filter->{$_} . ')' } (keys (%$filter)));
+			$filter = "(& $filter (| $tmp))";
+		}
+	}
+
+	$mesg = $Ldap->search
+	(
+		base   => $Config{'base_dn'},
+		filter => $filter
+	);
+
+	if ($mesg->is_error ())
+	{
+		warn ("Error while querying LDAP server: " . $mesg->error_text ());
+		return (qw());
+	}
+
+	for ($mesg->entries ())
+	{
+		my $entry = $_;
+		my $obj = new ($pkg, $entry);
+
+		push (@retval, $obj);
+	}
+
+	return (@retval);
+}
+
+=item I<$obj>-E<gt>B<delete> ()
+
+Deletes the record.
+
+=cut
+
+sub delete
+{
+	my $obj = shift;
+	my $entry = $obj->{'ldap'};
+
+	$entry->changetype ('delete');
+	$entry->delete ();
+	$entry->update ($Ldap);
+
+	%$obj = ();
+}
+
+=item I<$obj>-E<gt>B<lastname> ([I<$lastname>])
+
+Get or set the lastname.
+
+=cut
+
+sub _update_dn
+{
+	my $obj = shift;
+	my $entry = $obj->{'ldap'};
+	my $sn = $obj->{'sn'};
+	my $gn = $obj->{'givenName'};
+	my $cn = "$sn $gn";
+	my $dn = "cn=$cn," . $Config{'base_dn'};
+
+	$obj->{'cn'} = $cn;
+
+	$entry->changetype ('modify');
+	$entry->replace (sn => $sn, givenName => $gn, cn => $cn);
+	$entry->dn ($dn);
+	$entry->update ($Ldap);
+}
+
+sub lastname
+{
+	my $obj = shift;
+
+	if (@_)
+	{
+		$obj->{'sn'} = shift;
+		_update_dn ($obj);
+	}
+
+	return ($obj->{'sn'});
+}
+
+=item I<$obj>-E<gt>B<firstname> ([I<$firstname>])
+
+Get or set the firstname.
+
+=cut
+
+sub firstname
+{
+	my $obj = shift;
+
+	if (@_)
+	{
+		$obj->{'givenName'} = shift;
+		_update_dn ($obj);
+	}
+
+	return ($obj->{'givenName'});
+}
+
+=item I<$obj>-E<gt>B<name> ()
+
+Returns the CN.
+
+=cut
+
+sub name
+{
+	my $obj = shift;
+	return ($obj->{'cn'});
+}
+
+=item I<$obj>-E<gt>B<address> ([I<@address>])
+
+=item I<$obj>-E<gt>B<homephone> ([I<@homephone>])
+
+=item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])
+
+=item I<$obj>-E<gt>B<officephone> ([I<@officephone>])
+
+=item I<$obj>-E<gt>B<fax> ([I<@fax>])
+
+=item I<$obj>-E<gt>B<mail> ([I<@mail>])
+
+=item I<$obj>-E<gt>B<uri> ([I<@uri>])
+
+=item I<$obj>-E<gt>B<group> ([I<@groups>])
+
+Get or set the attribute.
+
+=cut
+
+sub AUTOLOAD
+{
+	my $obj = shift;
+	my @values = @_;
+	my $field = $Person::AUTOLOAD;
+	$field =~ s/.*:://;
+
+	return (set ($obj, $field, @values ? [@values] : undef))
+}
+
+sub get
+{
+	my $obj = shift;
+	my $field = shift;
+
+	return (set ($obj, $field, undef));
+}
+
+sub set
+{
+	my $obj = shift;
+	my $field = shift;
+	my $value = @_ ? shift : undef;
+	my $entry = $obj->{'ldap'};
+	
+	if (defined ($ExternalNames{$field}))
+	{
+		$field = $ExternalNames{$field};
+	}
+	if (!defined ($ValidFields{$field}))
+	{
+		return (undef);
+	}
+
+	if (defined ($value))
+	{
+		$entry->changetype ('modify');
+
+		if ($ValidFields{$field})
+		{
+			$entry->replace ($field, [@$value]);
+			$obj->{$field} = $value;
+		}
+		else
+		{
+			splice (@$value, 1) if (scalar (@$value) > 1);
+			$entry->replace ($field, $value);
+			$obj->{$field} = $value->[0];
+		}
+
+		$entry->update ($Ldap);
+	}
+
+	$obj->{$field} = [] unless (defined ($obj->{$field}));
+	
+	if (wantarray () and $ValidFields{$field})
+	{
+		return (@{$obj->{$field}});
+	}
+	else
+	{
+		return ($obj->{$field});
+	}
+}
+
+sub get_user
+{
+	my $pkg = shift;
+	my $dn = shift;
+	my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;
+
+	die unless ($search);
+	
+	my $cn = '';
+	my $id = '';
+
+	my $mesg = $Ldap->search
+	(
+		base   => $Config{'base_dn'},
+		filter => "(cn=$search)"
+	);
+
+	if ($mesg->is_error ())
+	{
+		warn ("Error while querying LDAP server: " . $mesg->error_text ());
+		return ('');
+	}
+
+	for ($mesg->entries ())
+	{
+		my $e = $_;
+		my ($t_cn) = $e->get_value ('cn', asref => 0);
+		my ($t_id) = $e->get_value ('uid', asref => 0);
+
+		print STDERR "LDAP result: $t_cn, $t_id";
+
+		if (!$id or $t_id)
+		{
+			$cn = $t_cn;
+			$id = $t_id;
+		}
+	}
+
+	return ($cn, $id);
+}
+
+=back
+
+=head1 AUTHOR
+
+Florian octo Forster E<lt>octo at verplant.orgE<gt>
+
+=cut