#!/usr/bin/perl -wT
use strict;
use CGI;
use DB_File;
use Digest::MD5 qw(md5);

my $q = CGI->new;


$ENV{PATH} = "/bin:/usr/sbin";

#parameter for sending Emails
my $sendmail = "/usr/sbin/sendmail -t"; 
my $replyto  = "Reply-to: donotreply".'@'."clxbs.com\n"; 
my $from = "From: Complex Biosystems Inc <donotreply".'@'."clxbs.com>\n";
my $subject  = "Subject: Contractor registration request\n"; 
my $sendto = "To: jbeaumont".'@'."clxbs.com\n";
my $emailmsg;

#DB management parameters
#DB file
my $CTRfile = 'cbcontracts.db';
my $PWDfile = 'cbpasswd.db';
my $ACMfile = 'cbacm.db';

our (%ctrid,  $ctrval);
our (%acmid,  $acmval);
our (%invcid, $invcval);
our (%ctrhash, %acmhash, %pwdhash, %invchash);
our (@ctrcheck, @acmcheck, @sacmcheck, @invccheck, @keyval, $word);
our ($nacm, @acmanagers);
our ($i, $wno, $msg, $tag, $logname, $passwd, $confirm);


my @ctrkeyw = qw(bname address city state zip web invoice description acmlist);
my @ctrreqr = (1, 1, 1, 1, 1, 1, 1, 1, 0);
my @acmkeyw = qw(fname mi lname email phone fax login);
my @acmreqr = (1, 0, 1, 1, 1, 0, 1);
my @sacmkeyw = qw(fname mi lname email phone fax login blogin);
my @sacmreqr = (1, 0, 1, 1, 1, 0, 1, 1);
my @invckeyw = qw(service number frsp mrsp lrsp emailrsp phonersp 
					facr macr lacr emailacr phoneacr compl due amount status view 
					outline detail);
my @invcreqr = (1, 1,    1, 0, 1, 1, 0,   1, 0, 1, 1, 0,  1, 1, 1, 1, 1, 1, 1);

our ($bname, $address, $city, $state, $zip, $web, $invoice, $description, $acmlist);
our ($fname, $mi, $lname, $email, $phone, $fax, $login, $blogin);
our ($service, $number, $frsp, $mrsp, $lrsp, $emailrsp, $phonersp, 
		$facr, $macr, $lacr, $emailacr, $phoneacr, $compl, $due, $amount, $status, $view, 
		$outline, $detail);
our ($key, $value,  %keyval);


#Parameter shared among forms
my %bgcolor;
my %bginit = (
	ctrname =>    	'white',
	ctraddress => 	'white',
	ctrcity =>    	'white',
	ctrstate =>   	'white',
	ctrzip =>     	'white',
	ctrweb =>     	'white',
	ctrdesc =>    	'white',
	pfname =>  		'white',
	pmi =>     		'white',
	plname =>  		'white',
	pemail =>  		'white',
	pphone =>  		'white',
	pfax =>    		'white',
	plogin =>  		'white',
	ppasswd => 		'white',
	sfname => 		'white',
	smi => 			'white',
	slname => 		'white',
	semail => 		'white',
	sphone => 		'white',
	sfax => 		'white',
	slogin => 		'white',
	spasswd =>  	'white',
	scfirmp => 		'white',
	);

my %bgsubmit = (
	ctrname =>    	'white',
	ctraddress => 	'white',
	ctrcity =>    	'white',
	ctrstate =>   	'white',
	ctrzip =>     	'white',
	ctrweb =>     	'white',
	ctrdesc =>    	'white',
	pfname =>  		'white',
	pmi =>     'gray',
	plname =>  'white',
	pemail =>  'white',
	pphone =>  'white',
	pfax =>    'gray',
	plogin =>  'white',
	ppasswd => 'gray',
	sfname => 'gray',
	smi => 'gray',
	slname => 'gray',
	semail => 'gray',
	sphone => 'gray',
	sfax => 'gray',
	slogin => 'gray',
	spasswd =>  'gray',
	scfirmp => 'gray',
	);

my %bgretrieve = (
	ctrname =>    'gray',
	ctraddress => 'gray',
	ctrcity =>    'gray',
	ctrstate =>   'gray',
	ctrzip =>     'gray',
	ctrweb =>     'gray',
	ctrdesc =>    'gray',
	pfname =>  'gray',
	pmi =>     'gray',
	plname =>  'gray',
	pemail =>  'gray',
	pphone =>  'gray',
	pfax =>    'gray',
	plogin =>  'white',
	ppasswd => 'white',
	sfname => 	'gray',
	smi => 		'gray',
	slname => 	'gray',
	semail => 	'gray',
	sphone => 	'gray',
	sfax => 	'gray',
	slogin => 	'gray',
	spasswd =>  'gray',
	scfirmp => 	'gray',
	);
	
my %bgupdate = (
	ctrname =>    'white',
	ctraddress => 'white',
	ctrcity =>    'white',
	ctrstate =>   'white',
	ctrzip =>     'white',
	ctrweb =>     'white',
	ctrdesc =>    'white',
	pfname =>  'white',
	pmi =>     'gray',
	plname =>  'white',
	pemail =>  'white',
	pphone =>  'white',
	pfax =>    'gray',
	plogin =>  'gray',
	ppasswd => 'white',
	sfname => 	'white',
	smi => 	  	'white',
	slname => 	'white',
	semail => 	'white',
	sphone => 	'white',
	sfax => 	'gray',
	slogin => 	'gray',
	spasswd =>  'white',
	scfirmp => 	'white',
	);

##### methods ###############################################################
sub stripstring
	{
	my $trim = $_[0];
	$trim =~ s/^\s+//;   #left trailing space
	$trim =~ s/\s+$//;   #right trailing space
	#$trim =~ s/\\|\R//g; #remove carriage return
    return $trim;
	}

##############################################################################



#get which button was pressed in the html form
my $btnpress = '';

if($q->param)
	{
	my @word = split (" ", $q->param('bsubmit'));
	$btnpress = $word[0];
	}

#print header
print $q->header;
print $q->start_html(-title=>'clxbs --graphic and simulation software for complex biological systems',
	-style=>{src=>'./smallsite.css', type=>'text/css'});

#main body division, includes banner and navigation
print '<div id="Body">';

#display the banner
print <<BANNER;	
<div id="Logo"> <!--Banner-->
<IMG src="../Figures/EmbryoDigital.png" alt="Emblem" width="120" height="118" align="left" border="0">
</div>
<div id="Banner">
<p>Complex Biosystems Inc.</p>
</div>
<div id="Icon">
<IMG src="../Figures/StatueLiberty.png" alt="New York" width="80" height="118" align="right" border="0">
</div> <!--End Banner-->
BANNER

print $q->code(
	$q->ul({-id=>'Menu'},
		$q->li({-style=>'margin-top:5px;'}, 'Contractor:'),
		$q->li($q->a({-href=>'./ctrregister-small.pl'}, 'Register')),
		$q->li({-style=>'margin-top:5px;'}, 'Account manager:'),
		$q->li($q->a({-href=>'./acmlogin-small.pl'}, 'Login')),
		$q->li({-style=>'margin-top:5px;'}, 'Return to:'),
		$q->li($q->a({-href=>'./index.shtml'}, 'Home')),
		$q->li($q->a({-href=>'./contact-small.shtml'}, 'Contact us')),
	));

#main content division, after banner and navigation
print '<div id="Content-noscroll">';

#print instructions to pay invoices
print $q->h2('Contractor registration form');

print $q->p('<b> Register: </b>
Enter the contractor identification with at least the nane of one
account manager authorized to pay invoices. For the primary contact 
just enter all information but the password. Then press Register. 
The request will be processed by an administrator. You 
will receive an acknowledgement of the request followed by
another Email when the registration is completed with a password 
for the primary contact. This one will be allowed to modify the
   information on file, including making any changes to the secondary
contact');

print $q->p('<b> Retrieve: </b>
To retrieve information on file for a contactor. The primary contact
enters his login name and password, and the press Retrieve
');

print $q->p('<b> Update: </b>
Information on file for a contractor can be modified by the primary contact.
After the information is retrieved (see above). Edit it,
and the press Update. Information on the secondary contact can be
changed. The login name of the primary contact can never been changed.
   If this is desired submit an new registration request, and use the description
field to indicate the naure of the change. If the login name of the secondary
contact is changed, we treat it as a new contact, and the old contact
is deleted from the system.');

print $q->p('<b> Add contact:</b>
Only the primary contact can add a secondary account manager. Use
the update button for this operation (see above)');

print $q->p('<b>NB:</b> gray fields are not required. There are no login here since
permissions are checked at each execution. Thus you are automatically logged out
when you leave the page');

#register a new contractor
if(($q->param) && ($btnpress eq 'Submit'))
#if(!$q->param)
	{
	#set the default field colors
	%bgcolor = %bgsubmit;
	
	#verify the required fields been filled
	$i = 0;
	my @names = $q->param;
# 	foreach my $str (@names)
# 		{
# 		if(!$q->param($str)) {$i++}
# 			{
# 			print $q->h5({-style=>'color:red;'}, "Error: field $q->param($str) required ");
# 			goto ENDRQ;
# 			}
# 		if($rqsubmit[$i] == 1)
# 			{$bgcolor{} => 'blue';}
# 		elsif($rqsubmit[$i] == 0)
# 			{$bgcolor{} => 'yellow';}
# 		$i++;
# 		}
	
	#verify the Email is valid
	
	#verify the phone is valid

	#verify the web site exists

	#verify the login name is valid

	#verify the login name is unique
	#the login should be at least 8 char long
	$logname = stripstring($q->param('plogin'));
	if(length ($logname)<8) 
		{
		print $q->h5({-style=>'color:red;'}, "Error: the login name --$logname-- should be at least 8 characters long");
		goto ENDRQ;
		}
	
	#open the password DB
	tie %pwdhash, 'DB_File', $PWDfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open password DB <<$PWDfile>> \n\n"; 
	
	#if the login name exists abort
	if($pwdhash{$logname})
		{
		print $q->h5({-style=>'color:red;'}, "Error: the login name --$logname-- already exists pick a different one");
		goto ENDRQ;
		}
	
	#Compose the message
	open(HD, '>', \$emailmsg) or die "pipe redirection error \n";
	print(HD 
		"Request to register a contrator in the DB\n",
		"Contractor:",
		"\n	Name =", $q->param('ctrname'), 
		"\n	Address =", $q->param('ctraddress'),
		"\n	City =", $q->param('ctrcity'),
		"\n	Sate =", $q->param('ctrstate'),
		"\n	Zip =", $q->param('ctrzip'),
		"\n	Web =", $q->param('ctrweb'),
		"\n	Description =", $q->param('ctrdesc'),
		"\n
		\nPrimary contact:",
		"\n	First name=", $q->param('pfname'),
		"\n	MI=", $q->param('pmi'),
		"\n	Last name=", $q->param('plname'),
		"\n	Email=", $q->param('pemail'),
		"\n	Phone=", $q->param('pphone'),
		"\n	Fax=", $q->param('pfax'),
		"\n	Login=", $q->param('plogin'),
		"\n");
	close(HD);

	#send email to DB administrator
	open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!\n"; 
	print(SENDMAIL $replyto); 
	print(SENDMAIL $subject); 
	print(SENDMAIL $sendto); 
	print(SENDMAIL "Content-type: text/plain\n\n"); 
	print(SENDMAIL $emailmsg); 
	close(SENDMAIL);

	print $q->h5({-style=>'color:green;'}, "registration request for ---",$q->param('ctrname'),"--- submitted successfully");
	ENDRQ:
	untie %pwdhash;
	}

#retrieve information on an existing contractor
if(($q->param) && ($btnpress eq 'Retrieve'))
	{
	#set the default field colors
	%bgcolor = %bgretrieve;
	
	#verify the login name exist in password, account manager and contractor DBs.
	
	#print message if it does not pass the test

	#verify primary contact password match the one in password DB

	#verify the password in file matches the password entered
	
	#if no match display error message and abort

	#if paswwords match
	#load record from contractor DB 
	#open the password contractor and account manager DBs
	tie %pwdhash, 'DB_File', $PWDfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open password DB <<$PWDfile>> \n\n"; 
	tie %ctrhash, 'DB_File', $CTRfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open contractor DB <<$CTRfile>> \n\n"; 
	tie %acmhash, 'DB_File', $ACMfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open account manager DB <<$ACMfile>> \n\n"; 
	
	#check for the existence of login id
	$logname = stripstring($q->param('plogin'));
	if(!$pwdhash{$logname})
		{
		print $q->h5({-style=>'color:red;'}, "Error: the login name --$logname-- does not exists");
		goto ENDRETR;
		}

	#check the password match
	if($pwdhash{$logname} ne $q->param('ppasswd'))
		{
		print $q->h5({-style=>'color:red;'}, "Error: password for login name --$logname-- is incorrect");
		goto ENDRETR;
		}

	#check we have a contractor with this login id
	if(!$ctrhash{$logname})
		{
		print $q->h5({-style=>'color:red;'}, "Error: no contractor with this primary contact login id ");
		goto ENDRETR;
		}

	#Retrieve the record and parse the field stream
	($bname, $address, $city, $state, $zip, $web, $invoice, 
		$description, $acmlist) = split(/<!>/, $ctrhash{$logname});
	$q->param('ctrname',  	$bname);
	$q->param('ctraddress',	$address);
	$q->param('ctrcity',  	$city);
	$q->param('ctrstate', 	$state);
	$q->param('ctrzip', 	$zip);
	$q->param('ctrweb',   	$web);
	$q->param('ctrdesc',  	$description);
	
	#parse the account manager list
	(@acmanagers) = split(/<#>/, $acmlist);
	$nacm = @acmanagers;
	
	#load the primary contact
	($fname, $mi, $lname, $email, $phone, $fax) = split(/<!>/, $acmhash{$acmanagers[0]});
	$q->param('pfname',  $fname);
	$q->param('pmi',  	 $mi);
	$q->param('plname',  $lname);
	$q->param('pemail',  $email);
	$q->param('pphone',  $phone);
	$q->param('pfax',    $fax);
	
	#load the secondary contact if one exists
	if($nacm>1)
		{
		($fname, $mi, $lname, $email, $phone, $fax, $blogin) = 
			split(/<!>/, $acmhash{$acmanagers[1]});
		$q->param('sfname',  $fname);
		$q->param('smi',  	 $mi);
		$q->param('slname',  $lname);
		$q->param('semail',  $email);
		$q->param('sphone',  $phone);
		$q->param('sfax',    $fax);
		}
	
	ENDRETR:
	untie %pwdhash;
	untie %ctrhash;
	untie %acmhash;
	}

#update information on an existing contractor
if(($q->param) && ($btnpress eq 'Update'))
	{
	#set the default field colors
	%bgcolor = %bgupdate;
	
	#verify the required fields are present
	
	#open the password contractor and account manager DBs
	tie %pwdhash, 'DB_File', $PWDfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open password DB <<$PWDfile>> \n\n"; 
	tie %ctrhash, 'DB_File', $CTRfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open contractor DB <<$CTRfile>> \n\n"; 
	tie %acmhash, 'DB_File', $ACMfile, O_RDWR|O_CREAT, 0644, $DB_HASH or 
		die "\n\tCannot open account manager DB <<$ACMfile>> \n\n"; 
	
	#check for the existence of login id
	$logname = stripstring($q->param('plogin'));
	if(!$pwdhash{$logname})
		{
		print $q->h5({-style=>'color:red;'}, "Error: the login name --$logname-- does not exist");
		goto ENDUPD;
		}

	#check the passwords match
	if($pwdhash{$logname} ne $q->param('ppasswd'))
		{
		print $q->h5({-style=>'color:red;'}, "Error: password for login name --$logname-- is incorrect");
		goto ENDUPD;
		}

	#check we have a contractor with this login id
	if(!$ctrhash{$logname})
		{
		print $q->h5({-style=>'color:red;'}, "Error: we have not contractor with this login id primary contact");
		goto ENDUPD;
		}

	#load the contractor record
	($bname, $address, $city, $state, $zip, $web, $invoice, 
		$description, $acmlist) = split(/<!>/, $ctrhash{$logname});
	(@acmanagers) = split(/<#>/, $acmlist);
	$nacm = @acmanagers;
	
	#load the account manager record
	($fname, $mi, $lname, $email, $phone, $fax, $blogin) = 
			split(/<!>/, $acmhash{$acmanagers[1]});
	
	#abort if primary contact login do not match
	if($acmanagers[0] ne $logname)
		{
		print $q->h5({-style=>'color:red;'}, "The primary contact login does not and the record will not be updated");
		goto ENDUPD;
		}

	#stream the contractor record fields and save the contractor record
	$ctrval = join("<!>", $q->param('ctrname'), $q->param('ctraddress'), $q->param('ctrcity'), $q->param('ctrstate'),
		$q->param('ctrzip'), $q->param('ctrweb'), $invoice, $q->param('ctrdesc'), $acmlist);	
	$ctrhash{$logname} = $ctrval;

	#stream the primary account manager record fields and save it
	$acmval = join("<!>", $q->param('pfname'), $q->param('pmi'),  $q->param('plname'), 
		$q->param('pemail'), $q->param('pphone'), $q->param('pfax'), $blogin);	
	$acmhash{$acmanagers[0]} = $acmval;
	
	#if only one field of secondary contact is filled
	#flag the missing required fields
	
	#proceed with the secondary account manager if there is one
	if(($nacm>1) && $q->param('sfname') &&  $q->param('slname'))
		{
		$acmval = join("<!>", $q->param('sfname'), $q->param('smi'),  
			$q->param('slname'), $q->param('semail'), 
			$q->param('sphone'), $q->param('sfax'), $blogin);	
		$acmhash{$acmanagers[1]} = $acmval;
		}
	
	ENDUPD:
	untie %pwdhash;
	untie %ctrhash;
	untie %acmhash;
	
	#Email confirmation to primary contact
	print $q->h5({-style=>'color:green;'}, "Update sucessfully completed");
	}

#reset the fields in the form
if(($q->param) && ($btnpress eq 'Reset'))
	{
	#set the default field colors
	%bgcolor = %bginit;
	
	my @names = $q->param;
	foreach my $str (@names)
		{
		$q->param($str, '');
		}
	}

#generate the form
print $q->start_form({
	-action => 'ctrregister-small.pl',
	-method => 'POST',
	-enctype => 'application/x-www-form-urlencode',
	}),
	
	$q->fieldset($q->legend('Contractor identification'),
	$q->ol(
	$q->li($q->label({for=>'ctrname'}, "Business name:"),
		$q->textfield(-style => "background:$bgcolor{'ctrname'};", 
		id => 'ctrname', -name => 'ctrname', -size => 30, -maxlength => 60)),
	
	$q->li($q->label({for=>'ctraddress'}, 'Street address:'),
		$q->textfield(-style => "background:$bgcolor{'ctraddress'};",
		-id => 'ctraddress', -name => 'ctraddress', -size => 35, -maxlength => 60)),
	
	$q->li($q->label({for=>'ctrcity'}, 'City:'),
		$q->textfield(-style => "background:$bgcolor{'ctrcity'};",
		-id => 'ctrcity', -name => 'ctrcity', -size => 20, -maxlength => 30)),
	
	$q->li($q->label({for=>'ctrstate'}, 'Sate:'),
		$q->popup_menu(-style => "background:$bgcolor{'ctrstate'};",
		-id => 'ctrstate', -name => 'ctrstate', -values=>[
			'', 'AL', 'AK', 'AZ', 'AR', 'CA', 'CO', 'CT', 'DE', 'DC', 'FL', 'GA', 'HI', 
			'ID', 'IL', 'IN', 'IA', 'KS', 'KY', 'LA', 'ME', 'MD', 'MA', 'MI', 'MN', 
			'MS', 'MO', 'MT', 'NE', 'NV', 'NH', 'NJ', 'NM', 'NY', 'NC', 'ND', 'OH', 
			'OK', 'OR', 'PA', 'RI', 'SC', 'SD', 'TN', 'TX', 'UT', 'VT', 'VA', 'WA', 
			'WV', 'WI', 'WY', 'AS', 'GU', 'MP', 'PR', 'VI']),
		'Zip:',  
		$q->textfield(-style => "background:$bgcolor{'ctrzip'};", 
		-id => 'ctrzip', -name => 'ctrzip',  -size => 5, -maxlength => 5)),
	
	$q->li($q->label({for=>'ctrweb'}, 'Web site:'),
		$q->textfield(-style => "background:$bgcolor{'ctrweb'};",
		-id => 'ctrweb', -name => 'ctrweb', -size => 20, -maxlength => 40)),
	
	$q->li($q->label({for=>'ctrdesc'}, 'Description:'),
		$q->textarea(-style => "background:$bgcolor{'ctrdesc'};",
		-id => 'ctrdesc', -name => 'ctrdesc',
		-rows=>10, -columns => 90)),
	)), #end ordered list, and fieldset
	
	$q->fieldset($q->legend('Primary contact'),
	$q->ol(
	$q->li($q->label({for=>'pfname'}, 'First name:'),
		$q->textfield(-style => "background:$bgcolor{'pfname'};",
		-id => 'pfname', -name => 'pfname', -size => 12, -maxlength => 32),
		'MI:',
		$q->textfield(-style => "background:$bgcolor{'pmi'};",
		-id => 'pmi', -name => 'pmi', -size => 2, -maxlength => 3)),
		
	$q->li($q->label({for=>'plname'}, 'Last name:'),
		$q->textfield(-style => "background:$bgcolor{'plname'};",
		-id => 'plname', -name => 'plname', -size => 22, -maxlength => 32)),
	
	$q->li($q->label({for=>'pemail'}, 'Email:'),
		$q->textfield(-style => "background:$bgcolor{'pemail'};",
		-id => 'pemail', -name => 'pemail', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'pphone'}, 'Phone:'),
		$q->textfield(-style => "background:$bgcolor{'pphone'};",
		-id => 'pphone', -name => 'pphone', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'pfax'}, 'Fax:'),
		$q->textfield(-style => "background:$bgcolor{'pfax'};",
		-id => 'pfax', -name => 'pfax', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'plogin'}, 'Login:'),
		$q->textfield(-style => "background:$bgcolor{'plogin'};",
		-id => 'plogin', -name => 'plogin', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'ppasswd'}, 'Password:'),
		$q->password_field(-style => "background:$bgcolor{'ppasswd'};",
		-id => 'ppasswd', -name => 'ppasswd', -size => 12, -maxlength => 24)),	
	)), #end ordered list, and fieldset

	$q->fieldset($q->legend('Secondary contact'),
	$q->ol(
	$q->li($q->label({for=>'sfname'}, 'First name:'),
		$q->textfield(-style => "background:$bgcolor{'sfname'};",
		-id => 'sfname', -name => 'sfname', -size => 12, -maxlength => 32),
		'MI:',
		$q->textfield(-style => "background:$bgcolor{'smi'};",
		-id => 'smi', -name => 'smi', -size => 2, -maxlength => 3)),
		
	$q->li($q->label({for=>'slname'}, 'Last name:'),
		$q->textfield(-style => "background:$bgcolor{'slname'};",
		-id => 'slname', -name => 'slname', -size => 22, -maxlength => 32)),
	
	$q->li($q->label({for=>'semail'}, 'Email:'),
		$q->textfield(-style => "background:$bgcolor{'semail'};",
		-id => 'semail', -name => 'semail', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'sphone'}, 'Phone:'),
		$q->textfield(-style => "background:$bgcolor{'sphone'};",
		-id => 'sphone', -name => 'sphone', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'sfax'}, 'Fax:'),
		$q->textfield(-style => "background:$bgcolor{'sfax'};",
		-id => 'sfax', -name => 'sfax', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'slogin'}, 'Login:'),
		$q->textfield(-style => "background:$bgcolor{'slogin'};",
		-id => 'slogin', -name => 'slogin', -size => 20, -maxlength => 60)),
	
	$q->li($q->label({for=>'spasswd'}, 'Password:'),
		$q->password_field(-style => "background:$bgcolor{'spasswd'};",
		-id => 'spasswd', -name => 'spasswd', -size => 12, -maxlength => 24)),
	
	$q->li($q->label({for=>'scfirmp'}, 'Confirm password:'),
		$q->password_field(-style => "background:$bgcolor{'scfirmp'};",
		-id => 'scfirmp', -name => 'scfirmp', -size => 12, -maxlength => 24)),
	)), #end ordered list, and fieldset

#control buttons
$q->fieldset({-class=>'control'},
	$q->submit('bsubmit', 'Submit registration'),
	$q->submit('bsubmit', 'Retrieve'),
	$q->submit('bsubmit', 'Update'),
	$q->submit('bsubmit', 'Add contact'),
	$q->submit('bsubmit', 'Delete contact'),
	$q->submit('bsubmit', 'Reset')),	
	
#end form
$q->end_form;

#end html page
print '</div> </div>'; #end body and content divisions
print $q->end_html;

#======================================================================================================
#Data::Password qw(IsBadPassword);  assess password quality
#Crypt::Password::Util - Crypt password utilities
#Data::Password::Manager generate, check, manage crypt - des passwords