#!/usr/bin/perl

#       .Copyright (C)  1999-2001 TUCOWS.com Inc.
#       .Created:       11/19/1999
#       .Contactid:     <admin@opensrs.org>
#       .Url:           http://www.opensrs.org
#       .Originally Developed by:
#                       VPOP Technologies, Inc. for Tucows/OpenSRS
#       .Authors:       Joe McDonald, Tom McDonald, Matt Reimer, Brad Hilton,
#                       Daniel Manley, Evgeniy Pirogov
#
#
#       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., 675 Mass Ave, Cambridge, MA 02139, USA.

use vars qw(
	    %in $cgi $path_templates %actions $action %cc_types $XML_Client
	    %contact_keys %data %cc_mons @cc_types
	   );
(      %in, $cgi, $path_templates, %actions, $action, %cc_mons, %cc_types, $XML_Client,
        %contact_keys, %data ) = ();

# pull in conf file with defined values
# XXX NOTE XXX Update this configuration file
BEGIN {
      do "/www/data_storage/OpenSRS.conf";
}

use strict;
use lib $PATH_LIB;
use CGI ':cgi-lib';
use RACE;
RACE::Initialise(%RACESETTINGS);
RACE::UseRace($USE_RACE);

use OpenSRS::XML_Client qw(:default);
use OpenSRS::ClientCommon qw(send_email);

# global defines
$cgi = $ENV{SCRIPT_NAME};
$path_templates = "$PATH_TEMPLATES/reg_system";
%in = ();

# list of valid actions to execute
%actions = (
	    bulk_start => undef, # reljr
	    bulk_transfer_start => undef, # reljr
	    bulk_verify => undef, # reljr
		 

	    lookup => undef,
	    check_transfer => undef,
	    
	    setup_profile => undef,
	    do_setup_profile => undef,
	    
	    verify_order => undef,
	    register => undef,
	    
	    bulk_order => undef,
	    bulk_order_ca => undef,
	    bulk_transfer => undef,
	    do_bulk_transfer => undef,

	    purchase_webcert => undef,
	    verify_purchase_webcert => undef,
	    do_purchase_webcert => undef,
	   );

%cc_types = (
	     visa => "Visa",
	     mastercard => "Mastercard",
	     amex => "American Express",
	     discover => "Discover",
	    );

@cc_types = qw (visa mastercard amex discover);
 
%cc_mons = (1=>"01", 2=>"02", 3=>"03", 4=>"04", 5=>"05", 6=>"06", 7=>"07",
		8=>"08",9=>"09",10=>"10",11=>"11",12=>"12",);

%contact_keys = (
    	    	 first_name => undef,
    	    	 last_name => undef,
    	    	 address1 => undef,
    	    	 address2 => undef,
    	    	 address3 => undef,
    	    	 city => undef,
    	    	 state => undef,
    	    	 postal_code => undef,
    	    	 country => undef,
    	    	 email => undef,
    	    	 url => undef,
    	    	 fax => undef,
    	    	 phone => undef,
    	    	 org_name => undef,
    	    	);

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

print "Content-type:  text/html\n\n";

# set debugging level
start_up();

# create a client object which we will use to connect to the OpenSRS server
$XML_Client = new OpenSRS::XML_Client(%OPENSRS);
$XML_Client->login;

# read in the form data
ReadParse(\%in);
##########start flux prep 
#
# reljr adjustments to the order processing begins here up to RELJR END
#

use Data::Dumper;
    
unlink grep {-M > 1.0} glob "$AU_FIELDS{DATA_DIRECTORY}/[0-9]*[0-9].data"; # Clean up old data files.

sub bulk_start
{
    $in{reg_type} = 'new';
    bulk_init();
}

sub bulk_transfer_start
{
    $in{reg_type} = 'transfer';
    bulk_init();
}

sub bulk_init
{
    my (%HTML);
    my $options;

    $HTML{reg_type} = $in{reg_type};

    if ($HTML{reg_type} eq 'new') {
	$HTML{PERIOD_LIST} = build_select_menu(\%REG_PERIODS,1);
	$HTML{WHAT} = 'Order';
	$options = join "\n", map { qq(<option value="$_">.$_) } @{$AU_FIELDS{AVAILABLE_BULK_DOMAINS}};
    } else {
	$HTML{PERIOD_LIST} = build_select_menu(\%TRANSFER_PERIODS);
	$HTML{WHAT} = 'Transfer';
	$options = join "\n", map { qq(<option value="$_">.$_) } @{$AU_FIELDS{AVAILABLE_TRANSFER_DOMAINS}};
    }

    foreach my $num (0..30) {
	$HTML{DOMAIN_LIST} .= qq(<tr bgcolor="e0e0e0">
				 <TD align=right >
				 <INPUT TYPE=text NAME="domain_${num}" SIZE="30">
				 </TD>
				 <TD align=left>
				 <select name="domain_ext_${num}">
				    <option value="ALL">ALL
				    $options
				 </select>
				 </TD>
				 </tr>
				 );
    }
    
    $HTML{bulk_order} = 1;
    $HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};
    
    print_form("$path_templates/bulk_start.html",\%HTML);
}

sub bulk_verify
{
    my %domainlist;
    my $html_text;
    my @root_doms = $in{reg_type} eq 'new' ? @{$AU_FIELDS{AVAILABLE_BULK_DOMAINS}} : @{$AU_FIELDS{AVAILABLE_TRANSFER_DOMAINS}};
    my %domains;
    my %HTML;

    $HTML{reg_type} = $in{reg_type};
    $HTML{bulk_order} = $in{bulk_order};
    $HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};
    $HTML{period} = $in{period};
    
    foreach my $key (%in) {
	$domains{lc $in{"domain_$1"}} = $in{$key} if $key =~ m/^domain_ext_(\d+)$/ and $in{"domain_$1"};
    }

    if (not keys %domains) {
	print <<EOT; # make the user try, try again!
<BODY bgcolor="white">
<CENTER><BR><BR><BR><H1>You must request at least one domain.</H1>
<BR><font color="909090">Press the Back button on your browser.</font>
<script language="JavaScript">
<!--
document.bgColor = '909090';
document.write('<BR>You will be automatically returned to the order form.');
setTimeout('history.go(-1)', 6000);
// -->
</script>
EOT
        return;
    }
    
    foreach my $domain (keys %domains) {
	if ($domains{$domain} eq 'ALL') {
	    foreach my $dom (@root_doms) {
		$domainlist{$domain}{$dom} = 1;
	    }
	} else {
	    $domainlist{$domain}{$domains{$domain}} = 1;
	}
    }

    foreach my $domain (keys %domainlist) {
	foreach my $root_domain (keys %{$domainlist{$domain}}) {
	    my $domain_name = "${domain}.${root_domain}";
	    $domainlist{$domain}{$root_domain} = 0;

	    check_domain_syntax($domain_name) and next;

	    # check availability
	    my $lookup_data = {
			       action => "lookup",
			       object => "domain",
			       attributes => {
				   domain => $domain_name,
				   affiliate_id => $in{affiliate_id},
				   }
			      };

	    if ($in{reg_type} eq 'new') {
		my $lookup_results = $XML_Client->send_cmd( $lookup_data );
		$lookup_results->{attributes}->{status} eq 'taken' and next;
		$lookup_results->{attributes}->{status} eq 'invalid' and next;
	    } else {
		$lookup_data->{action} = "check_transfer";
		$lookup_data->{object} = "domain";
		my $lookup_results = $XML_Client->send_cmd( $lookup_data );
		if ($lookup_results && $lookup_results->{is_success} == 1) {
		    $lookup_results->{attributes}->{transferrable} != 1 and next;
		} else {
		    next;
		}
	    }

	    $domainlist{$domain}{$root_domain} = 1;
	    $domainlist{$domain}{MARK} = 1;
	}
    }
    
    foreach my $dom (@root_doms) {
	$HTML{ROOT_DOMAINS} .= "<th>.${dom}</th>";
    }

    foreach my $domain (sort {$domainlist{$b}{MARK} <=> $domainlist{$a}{MARK} or $a cmp $b} keys %domainlist) {
	if ($domainlist{$domain}{MARK}) {
	    $HTML{DOMAIN_TABLE} .= "<tr><td align=right><H1>${domain}</td>";
	} else {
	    $HTML{DOMAIN_TABLE} .= "<tr><td align=right><em>${domain}</em></td>";
	}
	foreach my $dom (@root_doms) {
	    if ($domainlist{$domain}{$dom}) {
		$HTML{DOMAIN_TABLE} .= "<td align=center bgcolor=green><input type=checkbox name=domains value=\"${domain}.${dom}\"></td>\n";
	    } else {
		$HTML{DOMAIN_TABLE} .= "<td bgcolor=black>&nbsp</td>";
	    }
	}
	$HTML{DOMAIN_TABLE} .= "</tr>\n";
    }
    print_form("$path_templates/bulk_verify.html",\%HTML);
}

#sub calculate_price{
#    my ($domain_ref, $period) = @_;
#    my $domain_discount = 0;
#    my $period_discount = 0;
#    my $final_discount = 0;
#    my $price = 0;
#    my %domain_group;
#    my %regex;
    
#    PRICING => { # domain => [single_price, transfer_price, period_restriction bulk_discount_flag period_discount_flag]
#		'US' => [4.0, 14.0, 0, 'BULK_DISCOUNT', 'PERIOD_DISCOUNT'],
#		'UK' => [4.0,  0.0, 2, 'NO_BULK_DISCOUNT', 'NO_PERIOD_DISCOUNT'],
#		'CA' => [35.0,  0.0, 0, 'NO_BULK_DISCOUNT', 'NO_PERIOD_DISCOUNT'],
#	       },

#    GROUP => {
#	      US => [ ".com", ".net", ".org" ],
#	      UK => [ ".co.uk", ".org.uk" ],
#	      CA => [ ".ca", ".(bc|ab|sk|mb|on|qc|nb|ns|pe|nb|nf|nt|nu|yk).ca" ],
#	     },

#    for my $group (keys %{$AU_FIELDS{GROUP}}) {
#	my $regex = join '|', sort { length $b <=> length $a }
#	    map { my $copy = $_; $copy =~ s/\./\\./g; $copy } @{$AU_FIELDS{GROUP}{$group}};
#	$regex{$group} = "(" . $regex . ")\$";
#    }
#
#    for my $domain (@{$domain_ref}) {
#	for my $group_name (keys %regex) {
#	    $domain =~ m/$regex{$group_name}/ and ++$domain_group{$group_name};
#	}
#    }
#
#    for my $group (keys %domain_group) {
#	my $total_domains = $AU_FIELDS{MIXED_GROUP_BULK_FLAG} ? scalar @{$domain_ref} : $domain_group{$group};
#
#	if ($in{reg_type} eq 'new') {
#
#	    my $group_period = $AU_FIELDS{PRICING}{$group}[2] ? $AU_FIELDS{PRICING}{$group}[2] : $period;
#	    if (exists $AU_FIELDS{BULK_ORDER_DISCOUNT} and $AU_FIELDS{PRICING}{$group}[3] eq 'BULK_DISCOUNT') {
#		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{BULK_ORDER_DISCOUNT}}) {
#		    if ($key <= $total_domains) {
#			$domain_discount = $AU_FIELDS{BULK_ORDER_DISCOUNT}{$key};
#			last;
#		    }
#		}
#	    }
#
#	    if (exists $AU_FIELDS{PERIOD_DISCOUNT} and $AU_FIELDS{PRICING}{$group}[4] eq 'PERIOD_DISCOUNT') {
#		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{PERIOD_DISCOUNT}}) {
#		    if ($key <= $group_period) {
#			$period_discount = $AU_FIELDS{PERIOD_DISCOUNT}{$key};
#			last;
#		    }
#		}
#	    }
#
#	    if ($AU_FIELDS{CUMULATIVE_DISCOUNT} == 1) {
#		$final_discount = $period_discount + $domain_discount - ($domain_discount * $period_discount);
#	    } else {
#		$final_discount = $domain_discount > $period_discount ? $domain_discount : $period_discount;
#	    }
#	
#	    $price += ($AU_FIELDS{PRICING}{$group}[0] - ($AU_FIELDS{PRICING}{$group}[0] * $final_discount))
#	        * $group_period * $domain_group{$group};
#	    
#	} elsif ($AU_FIELDS{PRICING}{$group}[1]) {
#	    if (exists $AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}) {
#		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}}) {
#		    if ($key <= $total_domains) {
#			$domain_discount = $AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}{$key};
#			last;
#		    }
#		}
#	    }
#
#	    $final_discount = $domain_discount;
#	
#	    $price += ($AU_FIELDS{PRICING}{$group}[1] - ($AU_FIELDS{PRICING}{$group}[1] * $final_discount))
#	        * $domain_group{$group};
#	}
#    }
#    return ($price);
#}

sub emergency_exit
{
    my ($message) = @_;
    defined $message and error_out($message);
    
    $XML_Client->logout;
    exit;
}

if (exists $in{orderid}) {
   foreach my $key (qw(status orderid)) {
    #foreach my $key (qw(status Success Bankres orderid total Cardname NameonCard Cardstreet Cardcity Cardstate Cardzip Cardcountry)) {#flux
	!exists $in{$key} and emergency_exit("No $key field.");
    }

	#if($in{status} eq 'Approved'){
	#foreach my $key (qw(approval_code cardnumber)) {!exists $in{$key} and emergency_exit("No $key field.");}
	
	#$in{cardnumber} =~ s/(\d{4,4})(\d+)/$1/g;
	#}#flux
	
    $in{orderid} =~ s/\D//g;
    $in{cardnumber}=~s/(\d{4,4})(.+)/$1 .../ if($in{cardnumber});
    my $data_file_name = "$AU_FIELDS{DATA_DIRECTORY}/$in{orderid}.data";
    
    if ($in{status} !~/^approved$/i) {
	-e $data_file_name and unlink $data_file_name;
	print <<EOT; # make the user try, try again!
<script language="JavaScript">
<!--
history.go(-4);
// -->
</script>
EOT
	emergency_exit();
    }

    -e $data_file_name or emergency_exit("No data file.");
    
    open DATA, "<$data_file_name"
       or die "Can't open file $data_file_name";

    no strict 'vars';
    eval join ('', <DATA>);

    exists $VAR1->{NOTHING} and emergency_exit("Your order has already been processed.");
    
    close DATA;
    
    open DATA, ">$data_file_name"
       or die "Can't create file $data_file_name";
    
    my %nothing = (NOTHING => 'nothing');
    print DATA Dumper(\%nothing);
    close DATA;

    $in{chargetotal} != $VAR1->{total_dollars} and emergency_exit("There was a processing error on total.");

    exists $VAR1->{NAMESERVER_INFO} or $VAR1->{NAMESERVER_INFO} = '';

    foreach my $line (
		      split (/\n/, $VAR1->{domain_string}),
		      split (/\n/, $VAR1->{BILLING_INFO}),
		      split (/\n/, $VAR1->{CONTACT_INFO}),
		      split (/\n/, $VAR1->{NAMESERVER_INFO}),
		      split (/\n/, $VAR1->{SPECIAL_DOMAIN_INFO} ? $VAR1->{SPECIAL_DOMAIN_INFO} : "\n")
		     )
    {
	my ($name, $value);
	
	($line =~ m/name=\"([^\"]*)/ or $line =~ m/name=(\S+)/) and $name = $1;
	($line =~ m/value=\"([^\"]*)/ or $line =~ m/value=(\S+)/) and $value = $1;
	if (defined $name and defined $value and $value =~ m/\S/) {
	    if (exists $in{$name}) {
		$in{$name} .= "\0$value";
	    } else {
		$in{$name} = $value;
	    }
	}
    }

    $in{affiliate_id} = $VAR1->{affiliate_id};
    $in{reg_username} = $VAR1->{reg_username};
    $in{reg_password} = $VAR1->{reg_password};
    $in{reg_domain}   = $VAR1->{reg_domain};
    $in{reg_type}     = $VAR1->{reg_type};
    $in{bulk_order}   = $VAR1->{bulk_order};
    $in{period}       = $VAR1->{period};
    $in{action}       = $VAR1->{action};

    $in{p_cc_type} = $in{Cardname};
}









#
# RELJR END
#
##########end flux prep
$action = $in{action};


# no action was supplied, so use the default
if (not $action) {
    main_menu();

# they passed a valid action
} elsif (exists $actions{$action}) {
    no strict "refs";
    &$action();
    use strict;

# they passed an invalid action
} else {
    main_menu("Invalid action: $action");
}

# close connection to the server
$XML_Client->logout;

exit;

####################################################################
### Begin subroutines
###################################################################

######################################################
## First, subroutines you may wish to adjust...
#####################################################

sub start_up {

    if ($REG_SYSTEM{debug}) {
	# print error to the page
	select (STDOUT); $| = 1;
	open (STDERR, ">&STDOUT") or die "Can't dump stdout: $!\n";
	select (STDERR); $| = 1;
	select (STDOUT);
    }
}

sub main_menu {

    my (%HTML, $mldns);
    # no action was specified, so print main page
    
    $HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};

    #
    # MLDNS requires extra stuff...
    #
    #createMLDNSHTMLLink (\%HTML);

    print_form("$path_templates/main_menu.html",\%HTML);
}

sub verify_order {
    
    # check fields for proper data

    my ($key,$cleaned_value,$error_msg,$domain_string,$domain,@domains);
	
    ###start flux
	#my($mightyMouse);
	#my $rawCookie = $ENV{'HTTP_COOKIE'};
	#my($cookieName,$cookieValue) = split(/=/,$rawCookie);
	#my($cookieName,$cookieValue) = split(/-/,$cookieValue);
	#error_out("Do not get cute with me.\n") unless($cookieValue=~/^\d+$/);
	#print "rawCookie $cookieName $cookieValue $rawCookie";#remove
	###end flux
	
	
	
    my (%good_domains,%bad_domains,%domains,$type,$field,$num,$fqdn,$nameservers);
    my ($raceObj, $originalDomain, $formCountry);
    my %converted_good_domains;
    my ($lookup_data);
    
    my $cc_num = $in{p_cc_num};
    my $cc_type = $in{p_cc_type};
    my $cc_exp_mon = $in{p_cc_exp_mon};
    my $cc_exp_yr = $in{p_cc_exp_yr};
    
    ##################################################################
    # here we check the validity of the cc_number, both its length
    # and its validity
    
    # only run this test if you set F_VERIFY_CC in conf file
    if ($REG_SYSTEM{F_VERIFY_CC}) {

	# check the cc number
	if (not cc_verify($cc_num)) {
	    error_out("Invalid credit card number.\n");
	    exit;
	}

	# check the expiration date
	if (not cc_exp_verify($cc_exp_mon,$cc_exp_yr)) {
	    error_out("Invalid credit card expiration: $cc_exp_mon/$cc_exp_yr.\n");
	    exit;
	}
    }

    # check for reg_username and reg_password
    if (not $in{reg_username}) {
	error_out("No username supplied");
	exit;
    } elsif (not $in{reg_password}) {
	error_out("No password supplied");
	exit;
    } elsif (defined $in{reg_password_confirm} and $in{reg_password} ne $in{reg_password_confirm}) {
	error_out("Password mismatch");
	exit;
    }

    
    ##################################################################
    ##################################################################
    
    ###################################
    # check syntax on domains given if this is a bulk order
    my ($gtld,$ca,$uk);


    if ($in{bulk_order}) {	# this is a bulk order
	
	my $domains = $in{domains};
	my $syntaxError = undef;
	$domains =~ s/\r//g;
	$domains =~ s/\n/ /g;
	$domains =~ s/,/ /g;
	@domains = split /\s+/, $domains;
    
	$error_msg = "";

	foreach $domain (@domains) {

            #
	    # check for duplicates
            #
	    if (exists $domains{$domain}) {
		$bad_domains{$domain} = "Duplicate domain.";
		next;
	    }	

            $raceObj = RACE::DoRACE (Domain => $domain, EncodingType => $UNIVERSAL_ENCODING_TYPE);

	    $raceObj->{ConvertedDomain} = lc $raceObj->{ConvertedDomain};
	
	    
	    $gtld = $gtld || $raceObj->{ConvertedDomain} =~ /(com|net|org)$/i;
	    $ca   = $ca   || $raceObj->{ConvertedDomain} =~ /ca$/i;
	    $uk   = $uk   || $raceObj->{ConvertedDomain} =~ /uk$/i;

            #
            # Check syntax.
            #
            if ($syntaxError = check_domain_syntax($raceObj->{ConvertedDomain}))
            {
               $bad_domains{$originalDomain} = $syntaxError;
               next;
            }

	    if ( $raceObj->{ConvertedDomain} =~ /\.tv$/i ) {
		$bad_domains{$originalDomain} = '.tv domains are not supported for bulk orders.';
		next;
	    }

	    $lookup_data = {
			    action => "lookup",
			    object => "domain",
			    attributes => {
				domain => $raceObj->{ConvertedDomain},
				affiliate_id => $in{affiliate_id},
				}
			   };


	    # add the domain to the hash to check for duplicates
	    $domains{$domain} = 1;

	    if ($in{reg_type} eq 'new') {
		my $lookup_results = $XML_Client->send_cmd( $lookup_data );
		if ($lookup_results->{attributes}->{status} eq 'taken') {
		    $bad_domains{$domain} = "Domain taken.";
		    next;
		}
		if ($lookup_results->{attributes}->{status} eq 'invalid') {
		    $bad_domains{$domain} = "Error checking domain [".$lookup_results->{response_text}."].";
		    next;
		}
	    } else {
		$lookup_data->{action} = "check_transfer";
		$lookup_data->{object} = "domain";
		my $lookup_results = $XML_Client->send_cmd( $lookup_data );
		if ($lookup_results && $lookup_results->{is_success} == 1) {
		    if ($lookup_results->{attributes}->{transferrable} != 1) {
			$bad_domains{$domain} = "Domain not transferable: $lookup_results->{attributes}->{reason}.";
			next;
		    }
		} else {
		    $bad_domains{$domain} = "Domain not transferable: Error in check transfer [$lookup_results->{response_text}].";
		    next;
		}
		
	    }

	    $good_domains{$domain} = 1;

	}

	if ($ca and ($gtld or $uk)){
	    $error_msg = "You can't mix .ca with gTLD or .uk domains in bulk_registration";
	}

	if ($ca and $in{reg_domain} !~ /ca$/i and $in{reg_type} eq 'new'){
	    $error_msg = "Bulk registration for .ca must be based on a previously registered .ca domain";
	}

	# if they didn't provide any good domains, error out now
	if (not keys %good_domains and keys %bad_domains) {
	    $error_msg = join("", map { "$_: $bad_domains{$_}<br>\n" } keys %bad_domains);
	}

	if ($error_msg) {
	    error_out($error_msg);
	    exit;
	}

    } else {			
	# this isn't a bulk order, but we still need to allow for a person
	# registering multiple domains with different tlds
	%good_domains = map { $_, 1 } split /\0/, $in{domain};
	map {	    $gtld = $gtld || $_ =~ /(com|net|org)$/i;
		    $ca   = $ca   || $_   =~ /ca$/i;
		    $uk   = $uk   || $_   =~ /uk$/i;
		} keys %good_domains;

	if ($ca and ($gtld or $uk)){
	    error_out("You can't mix .ca with gTLD or .uk domains in bulk_registration");
	    exit;
	} elsif ( $ca ) {
	    # for .ca domains, ensure a valid legal type was given
	    if ( $in{ legal_type } eq '' ) {
		error_out( 'No legal type selected' );
		exit;
	    }

	    if ( not exists $CA_LEGAL_TYPES{ $in{ legal_type } } ) {
		error_out( 'Invalid legal type selected.' );
		exit;
	    }
	}
    }
	foreach $domain (keys %good_domains) {
	$domain_string .= "<input type=hidden name=domain value=\"$domain\">\n";
	}
	my %HTML = %in;
    
    unless ( $in{reg_type} eq 'transfer' and $ca) {
	# copy over the normal contact info to 'billing' and/or 'tech' info 
	# if they had that flag set
	if (defined $in{flag_use_contact_info}) {
	    foreach $key (keys %in) {
		if ($key =~ /^billing_(.+)$/) {
		    $HTML{$key} = $in{"owner_$1"};
		}
	    }
	}
	if (defined $in{flag_tech_use_contact_info}) {
	    foreach $key (keys %in) {
		if ($key =~ /^tech_(.+)$/) {
		    $HTML{$key} = $in{"owner_$1"};
		}
	    }
	}

	# use library to verify the supplied data
	my ($custom_nameservers);
	if ($in{reg_type} eq 'new' and $REG_SYSTEM{custom_nameservers}) {
	    $custom_nameservers = 1;
	} else {
	    $custom_nameservers = 0;
	}
	
	# insert the domains into $HTML{domain} for the validation code below
	foreach my $dom (keys %good_domains)
	{
	    my $hashRef = RACE::DoRACE (Domain => $dom, EncodingType => $UNIVERSAL_ENCODING_TYPE);
	    if (! defined $hashRef->{ConvertedDomain})
	    {
		error_out ("Domain $dom contains illegal characters.");
		exit;
	    }
	    
	    $converted_good_domains{$hashRef->{ConvertedDomain}} = 1;
	}
	$HTML{domain} = join "\0", keys %converted_good_domains;
	
	my %verify_results = $XML_Client->validate(\%HTML, custom_tech_contact => $REG_SYSTEM{custom_tech_contact}, custom_nameservers => $custom_nameservers);
	
	if (not $verify_results{is_success}) {
	    # there were problems with submitted data...
	    $error_msg = $verify_results{error_msg};
	    error_out($error_msg);
	    exit;
	}

	# everything looks in order... so far...
    
	# pass along the tech contact info if the conf file tells us to
	# use %HTML so that "flag_tech_use_contact_info" is applied
	if ($REG_SYSTEM{custom_tech_contact}) {
	    $HTML{TECH_CONTACT} = build_tech_verify(\%HTML);
	}
	
	# add 'tech' as a contact type if the conf file has that defined
	my @contact_types = ('owner','billing');
	if ($REG_SYSTEM{custom_tech_contact}) {
	    push @contact_types, 'tech';
	}
	
	# encode the contact info and pass it to the next form
	foreach $type (@contact_types) {
	    foreach $field (qw(first_name last_name org_name address1 address2 address3 city state postal_code country email phone fax)) {
		$HTML{CONTACT_INFO} .= "<input type=hidden name=\"${type}_$field\" value=\"" . encode($HTML{"${type}_$field"}) . "\">\n";
		}
	}
	
		
	# encode the nameserver info and pass it to the next form
	if ($custom_nameservers) {
	    foreach $num (1..6) {
		$fqdn = $in{"fqdn$num"};
		if ($fqdn) {
		    $nameservers .= "$fqdn <br>\n";
		    $HTML{NAMESERVER_INFO} .= "<input type=hidden name=\"fqdn$num\" value=\"" . encode(RACE::DoRACE(Domain => $fqdn, EncodingType => $UNIVERSAL_ENCODING_TYPE)->{ConvertedDomain}) . "\">\n";
		
		
		}
	    }
	    
	    $HTML{NAMESERVERS} = <<EOF;
	    <tr><td colspan=2 align=center><b>Nameserver Information</b></td></tr>
	    <tr><td colspan=2 align=center>$nameservers</td></tr>
EOF
	}

	# encode the billing info and pass it to the next form
	$HTML{BILLING_INFO} .= "<input type=hidden name=\"p_cc_num\" value=\"" . encode($cc_num) . "\">\n";
	$HTML{BILLING_INFO} .= "<input type=hidden name=\"p_cc_type\" value=\"" . encode($cc_type) . "\">\n";
	$HTML{BILLING_INFO} .= "<input type=hidden name=\"p_cc_exp_mon\" value=\"" . encode($cc_exp_mon) . "\">\n";
	$HTML{BILLING_INFO} .= "<input type=hidden name=\"p_cc_exp_yr\" value=\"" . encode($cc_exp_yr) . "\">\n";

	if ($REG_SYSTEM{allow_auto_renew}) {
	    $HTML{BILLING_INFO} .= "<input type=hidden name=\"auto_renew\" value=\"" . encode($in{auto_renew}) . "\">\n";
	}
    }
    
    # display the cc_type using our %cc_types hash at the top of the
    # script
    $HTML{p_cc_type} = $cc_types{$in{p_cc_type}};
    
    $HTML{domains} = join("<br>\n", keys %good_domains);
    if (keys %bad_domains) {
	$HTML{bad_domains} = "<b>Invalid Domains:</b><br>\n" . join("", map { "<font color=red>$_: $bad_domains{$_}</font><br>\n" } keys %bad_domains) . "<br>\n";;
    }

    $HTML{domain_string} = $domain_string;
	### start flux
	#$HTML{domain_string} .="<input type=hidden name=order value=\"order-$cookieValue\">\n";
    ### end flux
    
	$HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};
    $HTML{period_text} = $REG_PERIODS{$in{period}};
    $HTML{reg_username} = encode($in{reg_username});
    $HTML{reg_password} = encode($in{reg_password});
    $HTML{reg_domain} = encode($in{reg_domain});
    $HTML{reg_type} = $in{reg_type};

    if ($REG_SYSTEM{allow_auto_renew}) {
	my $renew_value = $in{auto_renew} ? 'Yes':'No';
	$HTML{auto_renew_section} = <<EOF;
<tr>
<td align=right><b>Auto-renew:</b></td>
<td>$renew_value</td>
</tr>
EOF
    }

    if ($in{reg_type} eq 'new') {
	$HTML{reg_type_text} = 'New Domain';
	$HTML{action} = 'register';
    } else {
	if ($in{bulk_order}) {
	    $HTML{reg_type_text} = 'Batch Transfer';
	    $HTML{action} = 'do_bulk_transfer';
	} else {
	    $HTML{reg_type_text} = 'Transfer';
	    $HTML{action} = 'register';
	}
    }

    if ( $ca and $in{reg_type} eq 'transfer') {
	print_form("$path_templates/verify_ca_transfer.html",\%HTML);
	return;
    }

    if ( $ca ) {
    	$formCountry = "_ca";
	
	$HTML{isa_trademark} = $in{isa_trademark} ? "Yes" : "No";
	$HTML{want_cira_member} = $in{cira_member} eq 'Y'  ? "Yes" : "No";
	$HTML{domain_description} = $in{domain_description} ? $in{domain_description} : "<I>-none-</I>";
	$HTML{domain_description} =~ s/\n/<BR>/g;

    	$HTML{legal_type} = $CA_LEGAL_TYPES{$in{legal_type}};
	$HTML{lang_pref} = ( $in{lang_pref} eq "EN" ) ? "English" : "Français";

	$HTML{SPECIAL_DOMAIN_INFO} .= '<input type=hidden name="lang_pref" value="' . $in{lang_pref} . "\">\n";
	$HTML{SPECIAL_DOMAIN_INFO} .= '<input type=hidden name="cira_member" value="' . $in{cira_member} . "\">\n";
	$HTML{SPECIAL_DOMAIN_INFO} .= '<input type=hidden name="isa_trademark" value="' . ( $in{isa_trademark} ? $in{isa_trademark} : "0" ) . "\">\n";
	$HTML{SPECIAL_DOMAIN_INFO} .= '<input type=hidden name="legal_type" value="' . $in{legal_type} . "\">\n";
	$HTML{SPECIAL_DOMAIN_INFO} .= '<input type=hidden name="domain_description" value="' . $in{domain_description} . "\">\n";
	
    } else {
    	$formCountry = "";
    }
	
	#
    # reljr adjustments to the order processing begins here up to RELJR END
    #

    if (!$formCountry or !$in{ca_reg_type}) {
	my %csi_fields;
	
	foreach $field (qw(first_name last_name org_name address1 address2 address3 city state postal_code country email phone fax)) {
	    $in{"billing_${field}"} and $in{"billing_${field}"} =~ s/^\s+//;
	    $csi_fields{$field} = $in{"billing_${field}"} ? $in{"billing_${field}"} : $in{"owner_${field}"}
	}
	
	srand(time() ^ ($$ + ($$ << 15)));
    
	my $rand_num;
	my $rand_file_name;
	my $cc_num = $HTML{p_cc_num};
    
	while (1) {
	    $rand_num = int(rand(999999999) + 1) . int(rand(999999999) + 1);
	    $rand_file_name = "$AU_FIELDS{DATA_DIRECTORY}/${rand_num}.data";
		#$rand_file_name = "$AU_FIELDS{DATA_DIRECTORY}/".$cookieValue.".data";#flux
	    #if(-e $rand_file_name){unlink($rand_file_name);};#flux for cookies only
		last unless -e $rand_file_name;
	}

	$HTML{p_cc_num} = $rand_num;
	$HTML{BILLING_INFO} =~ s/$cc_num/$rand_num/gs;

	$HTML{total_dollars} = sprintf "%.2f",  calculate_price([keys %good_domains], $in{period}); 
    open DATA, ">$rand_file_name"||print "Can't create file $rand_file_name";
	print DATA Dumper(\%HTML);
	close DATA;

	$HTML{CGI} = $AU_FIELDS{FINANCIAL_URL};
	###start flux
	if($AU_FIELDS{TEST_PAYMENT} eq 'TRUE'){
	$HTML{TEST_MODE}="<input type=\"hidden\" name=\"txnmode\" value=\"test\">\n";}
	else{$HTML{TEST_MODE}='';}
	###end flux
	
	#$HTML{reply_url} = $AU_FIELDS{REPLY_URL};
	$HTML{unique_id} = $rand_num;
	#$formCountry and $formCountry .= '_cc';
    }

    #
    # RELJR END
    #

	# make the display of this data look a little better
	if ($HTML{owner_address2}) { $HTML{owner_address2} .= "<br>\n" }
	if ($HTML{owner_address3}) { $HTML{owner_address3} .= "<br>\n" }
	if ($HTML{billing_address2}) { $HTML{billing_address2} .= "<br>\n" }
	if ($HTML{billing_address3}) { $HTML{billing_address3} .= "<br>\n" }
	
	
    
    print_form("$path_templates/verify$formCountry.html",\%HTML);
}#end verify_order flux

########################################################
# dynamically build all .ca legal types.
sub build_ca_domain_legal_types
{
   my $type	= shift;
   my ($selected, $key);

   $selected = $type ? "" : "selected";
   my $string	= qq(   <option value="" $selected>select legal type\n);

   foreach $key (@CA_LEGAL_TYPES_ORDER)
   {
      $selected	= "";
      $selected	= " selected " if ($type =~ /$key/i);
      $string	.= "   <option value=\"$key\" $selected>$CA_LEGAL_TYPES{$key}\n";
   }

   return $string;
}


sub register {
    
    my (%HTML,$key,$xcp_request,$register_results,$error);
    my ($domain,$status,$id,$link_domains,$reg_type);
    my ($raceObj, $revDomain);

    $xcp_request = {
    		action => "sw_register",
		object => "domain",
		attributes => { 
#Uncomment one of the string or pass a specific value of parameter
#If not passed or value not save|process then settings from RSP profile will be used
#		    handle => 'save',  #save order only regardless RSP settings
#		    handle => 'process', #process order always regardless RSP settings 

		    contact_set => {},
		    nameserver_list => [],
		    },
    		};

    # clean up data that was posted, stick it in %data
    foreach $key (keys %in) {
	$in{$key} = unencode($in{$key});
    }

    my $sortorder = 1;
    # clean up data that was posted, stick it in %data
    foreach $key ( sort keys %in) {

	next if $key eq "domain";
	next if $key eq "handle";  #to prevent hacking from form

    	if ( $key =~ /^(owner|billing|tech|admin)_/i )
	{
	    my $contact_type = $1;
	    my $contact_key = $key;
	    $contact_key =~ s/^(owner|billing|tech|admin)_//i;
	    if  ( exists $contact_keys{$contact_key} )
	    {
    	    	$xcp_request->{attributes}->{contact_set}->{$contact_type}->{$contact_key} =
		    	$in{$key};
	    }
	    next;
	}
    	
        #
        # Push the name servers list.
        #
    	if ( $key =~ /^fqdn\d+$/i )
	{
	    if  ( defined $in{$key} )
	    {
				# ikolomiets: Bug #1179
		$raceObj = RACE::DoRACE (Domain => $in{$key}, EncodingType => $UNIVERSAL_ENCODING_TYPE);
    	    	push @{$xcp_request->{attributes}->{nameserver_list}},
		    	{ name => $raceObj->{ConvertedDomain}, sortorder => $sortorder };
		$sortorder++;
	    }
	    next;
	}

	$xcp_request->{attributes}->{$key} = $in{$key};
    }

    #
    # Get a list of the domains and stick them into the list. This RACE
    # converts the name which in turn gets set off to the registrar.
    my @domains;
    my %domain_converted;
    foreach (split /\0/, $in{domain})
    {
       my $hashRef = RACE::DoRACE (Domain => $_, EncodingType => $UNIVERSAL_ENCODING_TYPE);
       if (! defined $hashRef->{ConvertedDomain})
       {
          error_out ("Domain $_ contains illegal characters.");
          exit;
       }
	if( defined $hashRef->{Error})
	{
		 error_out ($hashRef->{Error});
		exit;
	}
	if($hashRef->{DomainConverted})
	{
		$domain_converted{$hashRef->{ConvertedDomain}} = 1;
	}

       push (@domains, $hashRef->{ConvertedDomain});
    }

    # if multiple domains are being registered based on a new profile,
    # send the necessary flag down to the server so they stay under the
    # same profile
    if (scalar @domains > 1 and not $xcp_request->{attributes}->{reg_domain}) {
	$link_domains = 1;
    }

    if($xcp_request->{attributes}->{reg_domain})
    {
	my $hr2 = RACE::DoRACE (Domain => $xcp_request->{attributes}->{reg_domain}, EncodingType => $UNIVERSAL_ENCODING_TYPE);
	if (! defined $hr2->{ConvertedDomain})
        {
          error_out ("Domain $_ contains illegal characters.");
          exit;
        }
        if( defined $hr2->{Error})
        {
                 error_out ($hr2->{Error});
                exit;
        }
        if($hr2->{DomainConverted})
        {
                $xcp_request->{attributes}->{reg_domain} = $hr2->{ConvertedDomain};
        }
    }

    # tell the server whether or not we should override the reseller's
    # default tech contact info and nameserver info
    $xcp_request->{attributes}->{custom_tech_contact} = $REG_SYSTEM{custom_tech_contact};
    if ($in{reg_type} eq 'new' and $REG_SYSTEM{custom_nameservers}) {
	$xcp_request->{attributes}->{custom_nameservers} = 1;
    } else {
	$xcp_request->{attributes}->{custom_nameservers} = 0;
    }

    # add auto_renew option
    $xcp_request->{ attributes }{ auto_renew } = $in{ auto_renew };

    # attempt to register the domains one at a time...
    my $count = 1;
    foreach $domain (@domains) {

	#we can now have a mix of different encodings and english	
        if ($domain_converted{$domain})
        {
	      $xcp_request->{attributes}->{encoding_type} = $UNIVERSAL_ENCODING_TYPE;
        }
        else
        {
	      undef $xcp_request->{attributes}->{encoding_type} ;
        }

        #
        # Undo the race for display purposes.
        #
        $raceObj	= RACE::UndoRACE (Domain => pack('A*',$domain), EncodingType => $UNIVERSAL_ENCODING_TYPE);
        $revDomain	= sprintf("%s" , $raceObj->{OriginalDomain});

    	# need to set the actio and object to lower case because
	# send_cmd() transforms them up.
	$xcp_request->{action} = lc $xcp_request->{action};
    	$xcp_request->{object} = lc $xcp_request->{object};

	$xcp_request->{attributes}->{domain} = $domain;

	# if this is the first of several domains based on a new profile
	# tell the server that this domain should be the primary domain for
	# the group of domains being processed
	if ($count == 1 and $link_domains) {
	    $xcp_request->{attributes}->{link_domains} = 1;
	} else {
	    $xcp_request->{attributes}->{link_domains} = 0;
	}
	
	# register the domain
	$register_results = $XML_Client->send_cmd( $xcp_request );
    
	if ($register_results->{is_success}) {
	
	    $id = $register_results->{attributes}->{id};

	    # if this is the first of several domains based on a new profile
	    # set its id as master_order_id so that when the other domains
	    # are inserted they are linked against the primary domain
	    if ($count == 1 and $link_domains) {
		$xcp_request->{attributes}->{master_order_id} = $id;
	    }
	    # only increment the count for successful orders
	    $count++;

            #
            # KLUDGE ALERT!!!!!!!!
            # Perl, for some reason, hacks and coughs on high-8 chars when performing an
            # append to a string. We perform the sprintf to avoid it. Change this and the
            # MLDN which appears on the screen will not be the one the user is requesting.
            # 
            my $x = sprintf ("%s processed with order # %d.<BR>\n", $revDomain, $id);
            $status .= $x;

	    ############################################################
	    # sample routine to send message to admin with billing info
	    
	    if ($REG_SYSTEM{F_SEND_ORDERS}) {
		if ($in{reg_type} eq 'new') {
		    $reg_type = "New Domain";
		} else {
		    $reg_type = "Transfer";
		}
		
                #
	        # sample routine to send message to customer
                # THINK: Email & RACE...
		send_email("$path_templates/message.txt",
			  {
			   %in,
			   domain =>  $domain,
			   mailfrom => $in{owner_email}||$ADMIN_EMAIL,
			   mailto => $ADMIN_EMAIL,
			   id => $id,
			   period_text => $REG_PERIODS{$in{period}},
			   reg_type => $reg_type,
			   });
	    }
	    

            #
	    # sample routine to send message to customer
            # THINK: Email & RACE...
	    if (not ( $in{reg_type} eq 'transfer' and 
		      $in{domain} =~ /\.ca/ )
		){
		if ($REG_SYSTEM{F_SEND_THANKYOU}) {
		    send_email("$path_templates/thankyou.txt",
			       {
				   %in,
				   domain =>  $domain,
				   mailto => $in{owner_email},
				   mailfrom => $ADMIN_EMAIL,
				   id => $id,
			       });
		}
	    }
	    ################################################################
	
	} else {

            #
            # KLUDGE ALERT!!!!!!!!
            # Perl, for some reason, hacks and coughs on high-8 chars when performing an
            # append to a string. We perform the sprintf to avoid it. Change this and the
            # MLDN which appears on the screen will not be the one the user is requesting.
            #
            my $x = sprintf ("Domain: %s Registration attempt failed: %s.", $revDomain, $register_results->{response_text});
            $status .= $x;
	
	    if ($register_results->{attributes}->{error}) {
		$register_results->{attributes}->{error} =~ s/\n/<br>\n/g;
		$status .= " $register_results->{attributes}->{error}";
		if ( $register_results->{response_code} == 486 )
		{
		    $status .= '&nbsp;&nbsp;&nbsp; Please retry in a minute or two.<BR>';
		}
	    }
	    
	    $status .= "<br>\n";
	}
    }

    $HTML{status} = $status;
    $HTML{partner_email} = $ADMIN_EMAIL;
    $HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};

    print_form("$path_templates/thankyou.html",\%HTML);
}

sub do_bulk_transfer {

    my (%HTML,%data,@params,$order_ids,$order_errors);
    my ($domain,$status,$id,$xcp_request);
    
    my @domains = split /\0/, $in{domain};

    $xcp_request = {
	action => "bulk_transfer",
	object => "domain",
	attributes => {
	    domain_list => \@domains,
	},
    };
		
    # clean up data that was posted, stick it in %data
    foreach my $key (keys %in) {
	$in{$key} = unencode($in{$key});
    }


    # clean up data that was posted, stick it in %data
    foreach my $key (keys %in) {

	next if $key eq "domain";

    	if ( $key =~ /^(owner|billing|tech|admin)_/i )
	{
	    my $contact_type = $1;
	    my $contact_key = $key;
	    $contact_key =~ s/^(owner|billing|tech|admin)_//i;
	    if  ( exists $contact_keys{$contact_key} )
	    {
    	    	$xcp_request->{attributes}->{contact_set}->{$contact_type}->{$contact_key} =
		    	$in{$key};
	    }
	    next;
	}
    	
	$xcp_request->{attributes}->{$key} = $in{$key};
    }

    # tell the server whether or not we should override the reseller's
    # default tech contact info and nameserver info
    $xcp_request->{attributes}->{custom_tech_contact} = $REG_SYSTEM{custom_tech_contact};
    $xcp_request->{attributes}->{custom_nameservers} = 0;

    my $register_results = $XML_Client->send_cmd( $xcp_request );

    # get the results for the entire transaction
    if ($register_results->{is_success}) {
	
	# get the results for each domain
	
	$status = $register_results->{response_text}."<BR><BR>";
	$status .= "Batch transfer order #".
	    	    $register_results->{attributes}->{bulk_transfer_id}.
		    "<BR>"; 
	foreach my $key ( @{$register_results->{attributes}->{successful_domains}}) {
	    my $domain = $key->{domain};
	    my $order_id = $key->{order_id};
	    
	    $status .= "$domain processed with order # $order_id.<br>\n";
	    $order_ids .= "$domain processed: order # $order_id\n";
	    
	}
	
	foreach my $key ( @{$register_results->{attributes}->{failure_domains}}) {
	    my $domain = $key->{domain};
	    my $reason = $key->{reason};
	    
	    $status .= "Unable to process transfer request for $domain: $reason<br>\n";
	    $order_errors .= "$domain failed: $reason\n";
	    
	}
	
	############################################################
	# sample routine to send message to admin with billing info
	
	if ($REG_SYSTEM{F_SEND_ORDERS}) {
	    send_email("$path_templates/bulk_transfer_message.txt",
		       {
			%in,
			bulk_transfer_id => $register_results->{attributes}->{bulk_transfer_id},
			mailfrom => $in{owner_email},
			mailto => $ADMIN_EMAIL,
			order_ids => $order_ids,
			order_errors => $order_errors,
		       });
	}
	
	# sample routine to send message to customer
	if ($REG_SYSTEM{F_SEND_THANKYOU}) {
	    send_email("$path_templates/bulk_transfer_thankyou.txt",
		       {
			%in,
			bulk_transfer_id => $register_results->{attributes}->{bulk_transfer_id},
			mailto => $in{owner_email},
			mailfrom => $ADMIN_EMAIL,
			order_ids => $order_ids,
		       });
	}
	
    } else {
	
	$status .= "Batch transfer attempt failed.<br><br>\n";
	$status .= "<menu>$register_results->{response_text}<br>\n";
	
	if ($register_results->{attributes}->{error}) {
	    $register_results->{attributes}->{error} =~ s/\n/<br>\n/g;
	    $status .= " $register_results->{attributes}->{error}";
	    if ( $register_results->{response_code} == 486 )
	    {
		$status .= '&nbsp;&nbsp;&nbsp; Please retry in a minute or two';
	    }
	}
	$status .= "</menu>\n";
	
	$status .= <<EOF;
<br><br>
If you would like to retry the order please hit your browser\'s 'Back' button
and re-submit the request.
EOF
	error_out($status);
	exit;
	
    }

    $HTML{status} = $status;
    $HTML{partner_email} = $ADMIN_EMAIL;
    $HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};
    $HTML{bulk_transfer_id} = $register_results->{bulk_transfer_id};
    print_form("$path_templates/bulk_transfer_thankyou.html",\%HTML);

}

###############################################################
###############################################################
### the rest of the subroutines should not need modification
###############################################################
###############################################################

sub lookup {
    
    my (%HTML,$status,$match_string,$matches);
    my ($xcp_request,$lookup_results,$match,$error_msg);
    my ($matchRef);
    
    my $domain		= $in{domain};
    my $affiliate_id	= $in{affiliate_id};

    #
    # RACE encode the domain name.
    #
    my $hashRef	= RACE::DoRACE (Domain => $domain, EncodingType => $UNIVERSAL_ENCODING_TYPE);
    if ($hashRef->{DomainConverted} == 1)
    {
       $xcp_request = {
    	    	action => "lookup",
		object => "domain",
		attributes => {
		    domain => $hashRef->{ConvertedDomain},
                    encoding_type => $UNIVERSAL_ENCODING_TYPE,
		    affiliate_id => $affiliate_id,
		    },
		};
    }
    else
    {
       $xcp_request = {
    	    	action => "lookup",
		object => "domain",
		attributes => {
		    domain => $domain,
		    affiliate_id => $affiliate_id,
		    },
		};

       #
       # The domain was not converted, force back to standard domain reg path.
       #
#       $in{encoding_type}	= "";
    }
    
    $lookup_results = $XML_Client->send_cmd( $xcp_request );
    if ($lookup_results->{is_success}) {
	
	$status = $lookup_results->{attributes}->{status};
	if ($status eq 'available') {
	    
	    $matches = $lookup_results->{attributes}->{matches};
	    $match_string = <<EOF;
<center>
<input type=checkbox name=domain value="$domain" checked> $domain&nbsp;&nbsp;
EOF
	    my $counter = 1;
	    foreach $match (@$matches) {
		if ( $counter >= 3 )
		{
		    $match_string .= "<BR>";
		    $counter = 0;
		}

                #
                # Undo the race for display purposes.
                #
                $matchRef = RACE::UndoRACE (Domain => pack('A*',$match), EncodingType => $UNIVERSAL_ENCODING_TYPE);
                $match = $matchRef->{OriginalDomain};

		$match_string .= <<EOF;
<input type=checkbox name=domain value="$match"> $match&nbsp;&nbsp;
EOF
	    	$counter++;
	    }
	    $match_string .= "</center>\n";

	    $HTML{matches}	= $match_string;
	    $HTML{domain}	= $domain;
	    $HTML{CGI}		= $cgi;
	    $HTML{OrderCGI}     = $cgi;
	    $HTML{method}	= 'POST';
	    $HTML{affiliate_id}	= $in{affiliate_id};
	    if  ($lookup_results->{response_code} == 246) { #blocker
		$HTML{notes}='Domain names of other level exist.';
	    }
	    elsif ($lookup_results->{response_code} == 247){ #municipal
		$HTML{notes}='Domain name is restricted to municipal government';
	    }
		
		 

            #createMLDNSHTMLLink (\%HTML);

	    my ( $tld ) = $domain =~ m/$OPENSRS_TLDS_REGEX$/i;
	    if ( exists $REG_SYSTEM{ post_lookup }{ $tld } ) {
		my $hr = $REG_SYSTEM{ post_lookup }{ $tld };
    
		no strict 'refs';
		&{$hr->{sub}}(\%HTML, $hr, $lookup_results);
		use strict;
	    }

	    print_form("$path_templates/avail.html",\%HTML);
	    
	} elsif ($status eq 'invalid') {
	    my $error_msg = "Your domain name: $domain was in an invalid format.\n";
	    error_out($error_msg);
	    exit;
	    
	} elsif ($status eq 'taken') {
	    # domain was taken
	    $matches = $lookup_results->{attributes}->{matches};

	    # only show order button if there were other available matches
	    if ( $matches ) {
		$match_string = "<b>The following similar domains are available:</b> <br><br><center>\n";
    	    	my $tempCounter = 0;
		foreach $match (@$matches) {
		    if ( $tempCounter >= 3 )
		    {
		    	$match_string .= "<BR>";
			$tempCounter = 0;
		    }
                my $matchRef2 = RACE::UndoRACE (Domain => pack('A*',$match), EncodingType => $UNIVERSAL_ENCODING_TYPE);
                $match = $matchRef2->{OriginalDomain};
		    $match_string .= <<EOF;
<input type=checkbox name=domain value="$match"> $match&nbsp;&nbsp;
EOF
		    $tempCounter++;
		}
		$match_string .= "</center>\n";

		$HTML{matches} = <<EOF;
<FORM method="post" ACTION="$cgi" >
<input type=hidden name=affiliate_id value="$in{affiliate_id}">
<input type=hidden name=action value="setup_profile">

<TABLE  BORDER=0 CELLPADDING=0>
<TR><TD>
$match_string
<BR>
</TD>
</TR>

<TR><TD>
<CENTER>
<HR SIZE=1 width=80%>
</CENTER>

Proceed to the order form by clicking on the button below<BR>
or skip to the bottom of the page to check on another name.
<BR>
</TD></TR>

<TR><TD ALIGN=center valign=bottom colspan=3>
<INPUT TYPE="submit" VALUE="Reserve Now!">
</TD></TR></TABLE>
</FORM>
EOF

	    }

	    $HTML{domain}	= $domain;
	    $HTML{CGI}		= $cgi;
	    $HTML{affiliate_id}	= $in{affiliate_id};

            #createMLDNSHTMLLink (\%HTML);

	    print_form("$path_templates/taken.html",\%HTML);
	    

    	} else {
	    $error_msg = $lookup_results->{response_text};
	    error_out($error_msg);
	}
	
    } else {
	$error_msg = $lookup_results->{response_text};
	error_out($error_msg);
	exit;
    }
    
}


sub info_tv {
    my ( $rHTML, $hr, $lookup_results ) = @_;

    my $domain = $in{ domain };

    # get the domain price
    if ( $lookup_results->{ attributes }{ price_status } eq 'AUCTION' ) {

	my %INFO = ( domain => $domain,
		     split( /\&|=/, substr( $hr->{ url }, 1 + index( $hr->{ url }, '?' ))));
	$INFO{price} = get_price($domain);

	$rHTML->{OrderCGI} = $hr->{ url } . "&domain=$domain";
	$rHTML->{post_lookup} = get_content( $hr->{ template }, \%INFO);
	$rHTML->{method} = 'GET';
    }
}

sub get_price {
    my ($domain) = @_;

    my $xcp_request = {
	action => 'get_price',
        object => 'domain',
        attributes => {
            domain => $domain,
            period => 1,
        }
    };

    my $price_results = $XML_Client->send_cmd( $xcp_request );
    return $price_results->{attributes}{price};
}

sub check_transfer {

    my ($xcp_request,$domain_string,%HTML,$error_msg);

    my $domain = $in{domain};
    my $affiliate_id = $in{affiliate_id};

    $xcp_request = {
    	    	action => "check_transfer",
		object => "domain",
		attributes => {
		    domain => $domain,
		    affiliate_id => $affiliate_id,
		    },
	    	};
    
    my $transfer_check = $XML_Client->send_cmd( $xcp_request );
    if ($transfer_check->{is_success}) {
	if ($transfer_check->{attributes}->{transferrable} == 1) {
	    $domain_string = "<input type=hidden name=domain value=\"$domain\">\n";

	    $HTML{domain_string} = $domain_string;
	    $HTML{CGI} = $cgi;
	    $HTML{affiliate_id} = $affiliate_id;
	    $HTML{reg_type} = "transfer";
	    $HTML{bulk_order} = 0; # eg, not bulk
	    $HTML{title} = "Domain Transfer for $domain";
	    print_form("$path_templates/setup_profile.html",\%HTML);
	} else {
	    error_out("The domain $domain is not currently transferable:  $transfer_check->{attributes}->{reason}.\n");
	    exit;
	}
    } else {
	$error_msg = $transfer_check->{response_text};
	error_out($error_msg);
	exit;
    }

}

sub purchase_webcert {
    my (%HTML);
    
    if (%in) {
	%HTML = %in;
    }	
    $HTML{errors} = shift;
    $HTML{CGI} = $cgi;
    my $expmonth = (exists $in{p_cc_exp_mon}) ? $in{p_cc_exp_mon} : 1; 
    $HTML{CC_TYPES} = build_select_menu3(\%cc_types, \@cc_types, $in{p_cc_type});
    $HTML{CC_MONS} = build_select_menu(\%cc_mons, $expmonth);
    my $expyear = (exists $in{p_cc_exp_yr}) ? $in{p_cc_exp_yr} : (localtime)[5] + 1900;
    $HTML{CC_YEARS} = build_select_menu(get_cc_years(),$expyear);
    print_form("$path_templates/purchase_webcert.html", \%HTML);
}

sub verify_purchase_webcert {
    my %HTML = %in;
    my $cc_num = $in{p_cc_num};
    my $cc_type = $in{p_cc_type};
    my $cc_exp_mon = $in{p_cc_exp_mon};
    my $cc_exp_yr = $in{p_cc_exp_yr};
    my ($error_msg);
    
    ##################################################################
    # here we check the validity of the cc_number, both its length
    # and its validity
    
    # only run this test if you set F_VERIFY_CC in conf file
    if ($REG_SYSTEM{F_VERIFY_CC}) {

	# check the cc number
	if (not cc_verify($cc_num)) {
	    purchase_webcert("Invalid credit card number.\n");
	    exit;
	}

	# check the expiration date
	if (not cc_exp_verify($cc_exp_mon,$cc_exp_yr)) {
	    purchase_webcert("Invalid credit card expiration: $cc_exp_mon/$cc_exp_yr.\n");
	    exit;
	}
    }
    my %verify_results = $XML_Client->validate_cert(\%HTML);
    if (not $verify_results{is_success}) {
	$error_msg = $verify_results{error_msg};
	purchase_webcert($error_msg);
	exit;
    }
    $HTML{CGI} = $cgi;
    print_form("$path_templates/confirm_purchase_webcert.html", \%HTML);
}

sub do_purchase_webcert {
    if ($in{'submit'} !~ /Order/) {
		purchase_webcert();
		exit;
    }
    my $purchase_req = {
	request_type	=> "WebCert",
	action		=> "Buy",
	object		=> "webcert",
	Action		=> "Buy",
	Email		=> $in{owner_email},
	Quantity	=> $in{quantity_ordered},
	Phone		=> $in{owner_phone},
	Contact		=> $in{contact},	
	Org		=> $in{owner_org_name},
	needs_reseller	=> 1,
    };
    my $response = $XML_Client->send_cmd($purchase_req);

    send_email(
	"$path_templates/cert_message.txt",
	{
	    success	=> ( $response->{is_success} ? "successful" : "failed"),
	    mailto	=> $ADMIN_EMAIL,
	    mailfrom    => $in{owner_email},
	    number	=> $in{quantity_ordered},
	    phone	=> $in{owner_phone},
	    contact	=> $in{contact},
	    org		=> $in{owner_org_name},
	    res_text    => $response->{response_text},
	    affiliate   => $in{affiliate_id} || "none",
	}
    );
    
    if (not $response->{is_success}) {
	error_out("Error $response->{response_text}\n");
	exit;
    } else {
	my %HTML;
	$HTML{CGI} = $cgi;
	$HTML{purchase_text} = $response->{response_text};
	print_form("$path_templates/cert_thanks.html", \%HTML);
    }
}

sub setup_profile {
    
    my (%HTML,$domain,$domain_string,$must_match);
 
    my @domains = split /\0/, $in{domain};
	
	###start flux
	#srand(time);
	#my $orderFlux = int(rand(1000000));
	#print "Set-Cookie: NAME=order-$orderFlux\n";# expires=1h
	#print "Content-type:  text/html\n\n";
	###end flux
	
	
	
    if (not @domains) {
	error_out("You need to select at least one domain to register.\n");
	exit;
    }

    foreach $domain (@domains) {
	$domain_string .= "<input type=hidden name=domain value=\"$domain\">\n";
    }

    $HTML{domain_string} = $domain_string;
	
	### start flux
	#$HTML{domain_string} .="<input type=hidden name=order value=\"order-$orderFlux\">\n";
    ### end flux
	
	$HTML{CGI} = $cgi;
    $HTML{affiliate_id} = $in{affiliate_id};
    $HTML{reg_type} = "new";

    if ( $in{must_match_profile} )
    {
    	$must_match = "_must_match";
	if ( $in{domain} =~ /\.ca/ )
	{
	    $HTML{message} = <<EOF
This .ca domain is restricted and can only be registered if it is linked to an<BR>
an already active .ca domain with the same CIRA registrant.
EOF
	}
	else
	{
	    $HTML{message} = <<EOF
The registration of this domain is conditional on its registration being linked<BR>
with another existing active domain.
EOF
	}
    }
    $HTML{bulk_order} = 0;	# eg, not bulk
    my $domains = join ", ", @domains;
    $HTML{title} = "Domain Registration for $domains";
    print_form("$path_templates/setup_profile${must_match}.html",\%HTML);
}

sub do_setup_profile {

    my (%HTML,$domain,$domain_string,@domains,$domain_info,$race,$field,
        $htmlForm,$domainCountry);
		
		
	###start flux
	#my $rawCookie = $ENV{'HTTP_COOKIE'};
	#my($cookieName,$cookieValue) = split(/=/,$rawCookie);
	#my($cookieName,$cookieValue) = split(/-/,$cookieValue);
	#print "rawCookie $cookieName $cookieValue $rawCookie";#remove
	#error_out("You have no cookies capabilities, I cannot process your order.\n") unless($cookieValue);
	#error_out("Do not get cute with me.\n") unless($cookieValue=~/^\d+$/);
	###end flux

    my $reg_username = $in{reg_username};
    my $reg_password = $in{reg_password};
    my $confirm_password = $in{confirm_password};
    my $flag_get_userinfo = $in{flag_get_userinfo};
    my $reg_domain = $in{reg_domain};
    my $tmp_encoding_type;
    my $legal_type='';
	
    if($reg_username =~ /^\s*$/){error_out("Please provide a username.\n");exit;}
    if(length($reg_username) > 20){error_out("Please choose a shorter username up to 20 characters.\n");exit;}
    if(lc($reg_username) !~ /^[a-z0-9]+$/){error_out("Please choose a new username - username may only contain alphanumeric characters.\n");exit;}

    #
    # Check the passwords. 
    #
    if($reg_password ne $confirm_password){error_out ("Password mismatch.\n");exit;}

    if(not $reg_password){error_out("Please provide a password.\n");exit;}

    #
    # RACE convert the domain name.
    #
    if ((defined $reg_domain) && ($reg_domain ne "") )
    {
       $race = RACE::DoRACE (Domain => $reg_domain, EncodingType => $UNIVERSAL_ENCODING_TYPE);
       if (defined $race->{Error})
       {
          error_out ("Domain name contains illegal characters.");
          exit;
       }

	if ($race->{DomainConverted} ==1)
	{
		$tmp_encoding_type = $UNIVERSAL_ENCODING_TYPE;
	}
    }

    if ( ( $flag_get_userinfo ) &&
	 ( not $reg_domain )
	 ){
	error_out("Please provide a domain's profile to retrieve.\n");
	exit;
    }


    #bulk .ca must be on the previous profile only
    if ( $in{bulk_order} and 
	 $in{domain_country} eq 'ca' and 
	 $reg_domain  !~/ca$/i and
	 $in{reg_type} eq 'new') {
	error_out("Please provide a .ca domain's profile to retrieve.\n");
	exit;
    }

    if ($flag_get_userinfo) {
	# base registration on existing profile
	# get profile based on domain/username/password
	my $xcp_request = {
			action => "get",
			object => "domain",
			attributes => {
			    type => "all_info",
			    affiliate_id => $in{affiliate_id},
			    reg_username => $reg_username,
			    reg_password => $reg_password,
			    domain => $race->{ConvertedDomain},
                            encoding_type => $tmp_encoding_type,
			}
		       };
    
	$HTML{reg_profile} = "Based on $reg_domain/$reg_username";
	if ($reg_domain  =~/ca$/i){
	    $HTML{reg_profile}.="<i> - a CIRA registrant profile will be used </i>";
	}
	
	
        #
        # Send the domain lookup off. The RACE converted name is being sent.
        #
	$domain_info = $XML_Client->send_cmd( $xcp_request );
	if (not $domain_info->{is_success}) {
	    error_out("Failed attempt: $domain_info->{response_text}");
	    exit;
	}
	$legal_type=$domain_info->{attributes}{legal_type} if $domain_info->{attributes}{legal_type};

	# process this through escape() to account for " and ' in the data
        escape_hash_values( $domain_info );
	#%HTML = map { $_, escape($domain_info{$_}) } keys %domain_info;

    	#
	# now have to convert object format into denormalized format
	#
	foreach my $typeKey ( keys %{$domain_info->{attributes}->{contact_set}} ) {
	    foreach my $dataKey ( keys %{$domain_info->{attributes}->{contact_set}->{$typeKey}} ) {
		$HTML{$typeKey."_".$dataKey} =
	    	    $domain_info->{attributes}->{contact_set}->{$typeKey}->{$dataKey};
	    }
	}
	
	delete $domain_info->{attributes}->{contact_set};

	my $fqdnCounter = 1;
	foreach my $nameserver ( @{$domain_info->{attributes}->{nameserver_list}} ) {
	    $HTML{"fqdn".$fqdnCounter} = $nameserver->{name};
	    $fqdnCounter++;
	}

	foreach my $attrKey ( keys %{$domain_info->{attributes}} ) {
	    $HTML{$attrKey} = $domain_info->{attributes}->{$attrKey};
	}

	
	$HTML{reg_domain} = $reg_domain;
	$HTML{country_menu} = build_country_list($HTML{owner_country});
	$HTML{billing_country_menu} = build_country_list($HTML{billing_country});

    } else {
	# make a new profile
	$HTML{reg_profile} = "New";
	$HTML{country_menu} = build_country_list();
	$HTML{billing_country_menu} = $HTML{country_menu};
    }

    #
    # Check the fields; make sure non are out of bound characters.
    #
    foreach $field (keys %in)
    {
       next if $field =~ /domain/i;

    }

    $HTML{ca_domains} = $in{domain} =~ /\.ca\b/;
    $HTML{CGI} = $cgi;
    $HTML{reg_username} = $reg_username;
    $HTML{reg_password} = $reg_password;
    $HTML{affiliate_id} = $in{affiliate_id};
    $HTML{reg_type} = $in{reg_type};
    $HTML{bulk_order} = $in{bulk_order};
    $HTML{CC_YEARS} = build_select_menu(get_cc_years(),(localtime)[5] + 1900);

    if ($REG_SYSTEM{custom_tech_contact}) {
	$HTML{CUSTOM_TECH_CONTACT} = build_tech_contact(\%HTML);
    }

    # nameserver information is only relevant for new domains
    if ($in{reg_type} eq 'new' and $REG_SYSTEM{custom_nameservers}) {
	$HTML{CUSTOM_NAMESERVERS} = build_nameservers(\%HTML);
    }

    if ($in{reg_type} eq 'new') {
	# new domains
	if ($in{bulk_order}) {
	    $HTML{heading} = 'Batch Domain Registration';
	}
	$HTML{reg_text} = 'Registration';
	$HTML{reg_type_text} = 'New Domain';
    	if ( $in{domain} &&
	     $in{domain} =~ /uk$/i ) {
	    $HTML{PERIOD_LIST} = build_select_menu(\%UK_REG_PERIODS,2);
	} else {
	    $HTML{PERIOD_LIST} = build_select_menu(\%REG_PERIODS,1);
	}
    } else {
	# transfer
	if ($in{bulk_order}) {
	    $HTML{reg_type_text} = 'Batch Transfer';
	    $HTML{heading} = 'Batch Transfer';
	} else {
	    $HTML{reg_type_text} = 'Transfer';
	}
	$HTML{reg_text} = 'Transfer';
	$HTML{PERIOD_LIST} = build_select_menu(\%TRANSFER_PERIODS);
    }

    if ( ( $in{domain} &&
	   $in{domain} =~ /\.ca/i ) ||
	 ( $in{domain_country} &&
	   $in{domain_country} eq 'ca' ) )
    {
    	$domainCountry = "_ca";
	$HTML{country_menu} = build_country_list($HTML{owner_country}||'CA');
	$HTML{billing_country_menu} = build_country_list($HTML{billing_country}||'CA');



	$HTML{domain_country} = $in{domain_country};
	$HTML{ca_legal_type_menu} = build_ca_domain_legal_types($legal_type);
    }
    else
    {
    	$domainCountry = "";
    }

    my ($tld) = $in{domain} =~ /$OPENSRS_TLDS_REGEX$/i;
    if ( ( $tld &&
           $RENEW{capability}->{$tld} &&
           $REG_SYSTEM{allow_auto_renew} ) || 
         ( $in{bulk_order} && $REG_SYSTEM{allow_auto_renew} ) )
    {
    	$HTML{AUTO_RENEW} = <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#e0e0e0"><B>Auto renew:</B><BR>
	<font color=red>
	********ATTENTION********<BR>
	A payment system must be implemented before
	giving your customers access to turn auto renew
	on for a new domain.
        </font>
	</TD>
	<TD><INPUT NAME="auto_renew" TYPE="radio" value="1"> Yes 
		<INPUT NAME="auto_renew" TYPE="radio" value="0" CHECKED> No </TD>
</TR>
EOF
    }

    if ($in{bulk_order}) {
	# reljr start
	$HTML{period} = $in{period};
	$HTML{domains} = '<input type=hidden name=domains value="';
	foreach $domain (split /\0/, $in{domains}) {$HTML{domains} .= "$domain ";}
	$HTML{domains} .= '">';
	# reljr end
	$htmlForm = "$path_templates/bulk_order$domainCountry.html";
	if ( $in{reg_type} eq 'transfer' and $in{domain_country} eq 'ca'){
	    $htmlForm = "$path_templates/transfer_ca.html";
	    $HTML{domains}="<textarea name=domains cols=20 rows=5></textarea>
"
	} elsif ($in{reg_type} eq 'transfer') {
    	    $htmlForm = "$path_templates/bulk_transfer.html";
	}
    } else {
	@domains = split /\0/, $in{domain};
	foreach $domain (@domains) {
	    $domain_string .= "<input type=hidden name=domain value=\"$domain\">\n";
	}
	$HTML{domain_string} = $domain_string;
	### start flux
	#$HTML{domain_string} .="<input type=hidden name=order value=\"order-$cookieValue\">\n";
    ### end flux
	$HTML{domains} = join "<br>\n", @domains;
	if ( $in{reg_type} eq 'transfer' and
	     $in{domain} =~ /\.ca\b/) {
	    $htmlForm = "$path_templates/transfer_ca.html";
	} else {
            if ($in{reg_type} ne 'transfer') {
                $HTML{reg_period_hints} = get_content("$path_templates/reg_period_hints.html");    
            }
#######start flux			
			if ($domainCountry and !$in{ca_reg_type}) {
	    $domainCountry .= '_cc'; # reljr for canada. Pray other countries don't follow.
	}
########end flux
	    $htmlForm = "$path_templates/order$domainCountry.html";
	}
    }

    print_form($htmlForm,\%HTML);
}

sub fancy_sort {

    my (@words,@ints);

    my @list = @_;
    
    foreach (@list) {
	if ($_ =~ /^\d+$/) {
	    push @ints, $_;
	} else {
	    push @words, $_;
	}
    }
    
    @words = sort @words;
    @ints = sort { $a <=> $b } @ints;
    
    return (@ints,@words);
    
}

sub build_select_menu {

    my ($key,$html);

    my $href = shift;
    my $default = shift;

    foreach $key (fancy_sort(keys %$href)) {
	if ($key eq $default) {
	    $html .= <<EOF;
<option value="$key" SELECTED> $href->{$key}
EOF
} else {
    $html .= <<EOF;
<option value="$key"> $href->{$key}
EOF
}
    }
    return $html;
}

sub build_select_menu3 {
    my ($key,$value,$html);
    my ($href,$aref,$default) = @_;

    foreach $key (@$aref) {
        $value = $href->{$key};
        if ($key eq $default) {
            $html .= <<EOF;
<option selected value="$key"> $value
EOF
        } else {
            $html .= <<EOF;
<option value="$key"> $value
EOF
        }
    }
    return $html;
}

sub build_country_list {
    
    my ($id,$title,$html);
    
    my ($default_id) = @_;

    if (not $default_id) { $default_id = 'US' }
    else {
	$default_id =~ tr/a-z/A-Z/;
    }
    
    open (FILE, "<$PATH_TEMPLATES/countries") or die "Can't open $PATH_TEMPLATES/countries: $!\n";
    while (<FILE>) {
	
	chomp;
	if (/^(\w{2})\s+(.+)/) {
	    $id = $1;
	    $title = $2;
	} else {
	    next;
	}
	
	if ($id eq $default_id) {
	    $html .= <<EOF;
<option value="$id" selected>$title
EOF
	} else {
	    $html .= <<EOF;
<option value="$id">$title
EOF
	}
    }
    close(FILE);
    return $html;
}


sub escape_hash_values {

    my $hash_ref = shift;
    foreach my $hash_key ( keys %$hash_ref )
    {
    	if ( ref( $hash_ref->{$hash_key} ) eq "HASH" )
	{
	    escape_hash_values( $hash_ref->{$hash_key} );
	}
    	elsif ( ref( $hash_ref->{$hash_key} ) eq "ARRAY" )
	{
	    escape_array_values( $hash_ref->{$hash_key} );
	}
	else
	{
    	    $hash_ref->{$hash_key} = escape( $hash_ref->{$hash_key} );
	}
    }
}

sub escape_array_values {

    my $array_ref = shift;
    foreach my $array_element ( @$array_ref )
    {
    	if ( ref( $array_element ) eq "HASH" )
	{
	    escape_hash_values( $array_element );
	}
    	elsif ( ref( $array_element ) eq "ARRAY" )
	{
	    escape_array_values( $array_element );
	}
	else
	{
    	    $array_element = escape( $array_element );
	}
    }
}

sub escape {
    my $string = shift;
    $string =~ s/\"/&quot;/g;
    return $string;
}

sub error_out {
    #print "Content-type:  text/html\n\n";#flux
    my (%HTML);
    $HTML{CGI} = $cgi;
    $HTML{ERROR} = shift;
    print_form("$path_templates/error.html",\%HTML);
    
}

##########################################################################
# substitute values on the specified template and print it to the client

# an optional 'type' arg can be passed: 'framed' specifies to pull in base.html
# as the outer frame and the given template as the inner frame
# 'single' specifies to use the given template alone
# the default behavior is 'framed'
sub print_form {
    
    my ($type,$content);

    my @args = @_;
    my ($template,$HTML) = @args[0,1];
    if ($args[2]) { $type = $args[2] }
    else { $type = 'framed' }

    #if (not $HTML->{REG_ENCODING_TYPE_LIST})
    #{
    #    my $etypes;
    #    foreach my $key13 (keys %MLDNS)
    #    {
    #            $etypes .="<OPTION VALUE=\"" . $key13 . "\">" . $MLDNS{$key13} . "\n";
    #    }
    #    $HTML->{REG_ENCODING_TYPE_LIST} = $etypes;
    #}

    if ($type eq 'framed') {
	$HTML->{CONTENT} = get_content("$template",$HTML);
    
	open (FILE, "<$path_templates/base.html") or die "Couldn't open $path_templates/base.html: $!\n";
	while (<FILE>) {
	    s/{{(.*?)}}/pack('A*',$HTML->{$1})/eg;
	    $content .= $_;
	}
	close FILE;
    } else {
	open (FILE, "<$template") or die "Couldn't open $template: $!\n";
	while (<FILE>) {
	    s/{{(.*?)}}/pack('A*',$HTML->{$1})/eg;
	    $content .= $_;
	}
	close FILE;
    }
    print $content;
}

####################################################
# grab the contents of a template, substitute any supplied values, and return
# the results
sub get_content {
    
    my $content;
    
    my ($template,$HTML) = @_;
    open (FILE, "<$template") or die "Couldn't open $template: $!\n";
    while (<FILE>) {
	s/{{(.*?)}}/pack('A*',$HTML->{$1})/eg;
	$content .= $_;
    } 
    close FILE;
    
    return $content;
    
}

###########################################################
#### sample routines for ordering domains in bulk

sub bulk_order {

    my $title = "Batch Domain Registration";
    $title = ".CA " . $title if $in{domain_country} eq 'ca';
    my %HTML = (
		CGI => $cgi,
		affiliate_id => $in{affiliate_id},
		domain_country => lc( $in{domain_country} ),
		reg_type => $in{reg_type}, # reljr
		bulk_order => 1,
		title => $title,
		);
		# reljr start

    $HTML{period} = $in{period};
    my $domain_count = 0;
    foreach my $domain (split /\0/, $in{domains}) {
	$domain =~ m/\.uk$/ and $HTML{period} = 2;
	$HTML{domains} .= qq(<input type=hidden name=domains value="$domain">\n);
	++$domain_count;
    }
    
    if ($in{reg_type} ne 'new' and $domain_count < 5) {
	print <<EOT; # make the user try, try again!
<BODY bgcolor="white">
<CENTER><BR><BR><BR><H1>You must request at least 5 domains for a transfer.</H1>
<BR><font color="909090">Press the Back button on your browser.</font>
<script language="JavaScript">
<!--
document.bgColor = '909090';
document.write('<BR>You will be automatically returned to the order form.');
setTimeout('history.go(-1)', 6000);
// -->
</script>
EOT
        return;
    }
    
    if ($domain_count == 0) {
	print <<EOT; # make the user try, try again!
<BODY bgcolor="white">
<CENTER><BR><BR><BR><H1>You must select at least one domain.</H1>
<BR><font color="909090">Press the Back button on your browser.</font>
<script language="JavaScript">
<!--
document.bgColor = '909090';
document.write('<BR>You will be automatically returned to the selection form.');
setTimeout('history.go(-1)', 6000);
// -->
</script>
EOT
        return;
    }

    # reljr end
    
    print_form("$path_templates/setup_profile.html",\%HTML);
}

sub bulk_order_ca {

    my %HTML = (
		CGI => $cgi,
		affiliate_id => $in{affiliate_id},
		domain_country => "ca",
		reg_type => 'new',
		bulk_order => 1,
		title => 'Batch Domain Registration',
		);
    print_form("$path_templates/setup_profile_ca.html",\%HTML);
}

sub bulk_transfer {

    my %HTML = (
		CGI => $cgi,
		affiliate_id => $in{affiliate_id},
		reg_type => 'transfer',
		bulk_order => 1,
		title => 'Batch Domain Transfer',
		);
    if ($in{tld} eq '.ca'){
	$HTML{domain_country}='ca';
    }
    print_form("$path_templates/setup_profile.html",\%HTML);
}

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

sub get_cc_years {

    my (%years,$i);
    my $year = (localtime)[5];
    $year += 1900;

    for ($i = 0; $i <=5; $i++) {
	$years{$year} = $year;
	$year++;
    }

    return \%years;

}

sub cc_verify {
    my ($number) = @_;
    my ($i, $sum, $weight);

    return 0 if $number =~ /[^\d\s\-]/;

    $number =~ s/\D//g;

    return 0 unless length($number) >= 13 && 0+$number;

    for ($i = 0; $i < length($number) - 1; $i++) {
    $weight = substr($number, -1 * ($i + 2), 1) * (2 - ($i % 2));
    $sum += (($weight < 10) ? $weight : ($weight - 9));
    }

    return 1 if substr($number, -1) == (10 - $sum % 10) % 10;
    return 0;
}

sub cc_exp_verify {

    my ($cc_exp_mon,$cc_exp_yr) = @_;

    my ($month,$year) = (localtime)[4,5];
    $month++;
    $year += 1900;

    my $current_month = sprintf("%04d%02d",$year,$month);
    my $cc_exp = sprintf("%04d%02d",$cc_exp_yr,$cc_exp_mon);
    if ($current_month > $cc_exp) {
	return 0;
    }
    return 1;
}

sub build_tech_contact {
    
    my $data = shift;
    my $tech_country_menu = build_country_list($data->{tech_country});

    my $tech_address = <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Street Address:</B></TD>
	<TD><input name="tech_address1" size=39 value="$data->{tech_address1}"></TD>
</TR>
EOF

    if ( not $data->{ca_domains} ) {
	$tech_address .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
		*optional*</font> <B>(eg: Suite #245):</B></TD>
	<TD><input name="tech_address2" size=39 value="$data->{tech_address2}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
		*optional*</font> <B>Address 3:</B></TD>
	<TD><input name="tech_address3" size=39 value="$data->{tech_address3}"></TD>
</TR>
EOF
    }
    my $html = <<EOF;
<TR>
	<TD COLSPAN=2 bgcolor="#90c0ff" align=center>
		<B><FONT SIZE=+1>Tech Contact Information</FONT></B>
	</TD>
</TR>
<TR>
	<TD COLSPAN=2 bgcolor="#e0e0e0" align=center>
		<B>Same as Contact Information</B>
<input type=checkbox name="flag_tech_use_contact_info" value="1" checked>
	</TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>First Name:</B></TD>
	<TD><input name="tech_first_name" size=15 value="$data->{tech_first_name}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Last Name:</B></TD>
	<TD><input name="tech_last_name" size=15 value="$data->{tech_last_name}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Organization Name:</B></TD>
	<TD><input name="tech_org_name" size=39 value="$data->{tech_org_name}"></TD>
</TR>
$tech_address
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>City:</B></TD>
	<TD><input name="tech_city" size=15 value="$data->{tech_city}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>State:</B></TD>
	<TD><input name="tech_state" size=15 value="$data->{tech_state}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Country:</B></TD>
	<TD><SELECT NAME="tech_country">
$tech_country_menu
 </SELECT></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Postal Code:</B></TD>
	<TD><input name="tech_postal_code" size=15 value="$data->{tech_postal_code}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Phone Number:</B></TD>
	<TD><input name="tech_phone" size=40 value="$data->{tech_phone}"> 
		<font size=-1> (eg. +1.4165551122)*</font>
		</TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
		*optional*</font> <B>Fax Number:</B>
	</TD>
	<TD><input name="tech_fax" size=40 value="$data->{tech_fax}"></TD>
</TR>
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Email:</B><BR>
	    <FONT color=red size=-1>Must be currently valid address</FONT>
	</TD>
	<TD><input name="tech_email" size=39 value="$data->{tech_email}"></TD>
</TR>
EOF

   return $html;					     
}

sub build_tech_verify {

    my $data = shift;

    my $tech_address2 = $data->{tech_address2};
    my $tech_address3 = $data->{tech_address3};
    if ($tech_address2) { $tech_address2 .= "<br>\n" }
    if ($tech_address3) { $tech_address3 .= "<br>\n" }

    my $html = <<EOF;
<tr><td colspan=2 align=center><b>Tech Contact Information</b></td></tr>

<tr>
<td valign=top>
$data->{tech_first_name} $data->{tech_last_name}<BR>
$data->{tech_org_name}<BR>
$data->{tech_address1}<BR>
$tech_address2
$tech_address3
$data->{tech_city}, $data->{tech_state} $data->{tech_postal_code}<BR>
$data->{tech_country}
</td>
<td valign=top>
Phone:$data->{tech_phone}<BR>
Fax:$data->{tech_fax}<BR>
E-mail:$data->{tech_email}<BR>
</td>
</tr>
EOF
    return $html;
}

sub build_nameservers {

    my (%fqdns,%nameservers,$key,$num,$fqdn_race_obj);

    my $data = shift;
    foreach $key (grep /^fqdn\d+$/, keys %$data) {

	($num) = $key =~ m/^fqdn(\d+)$/;
	$fqdns{$num} = $data->{$key};
    }

    my $count = 1;
    foreach $num (sort keys %fqdns) {
        $fqdn_race_obj	= RACE::UndoRACE (Domain => pack('A*',$fqdns{$num}),
	    	    	    	    	  EncodingType => $UNIVERSAL_ENCODING_TYPE);
        
	$nameservers{"fqdn$count"} = $fqdn_race_obj->{OriginalDomain};
	$count++;
    }

    #
    # We need to get a list of available 
    #
	

    my $html = <<EOF;
<TR>
	<TD COLSPAN=2 bgcolor="#90c0ff" align=center>
		<B><FONT SIZE=+1>DNS Information</FONT></B>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Primary DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn1" size=39 value="$nameservers{fqdn1}"><BR>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><B>Secondary DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn2" size=39 value="$nameservers{fqdn2}"><BR>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
                *optional*</font> <B>Third DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn3" size=39 value="$nameservers{fqdn3}"><BR>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
                *optional*</font> <B>Fourth DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn4" size=39 value="$nameservers{fqdn4}"><BR>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
                *optional*</font> <B>Fifth DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn5" size=39 value="$nameservers{fqdn5}"><BR>
	</TD>
</TR>
EOF
    $html .= <<EOF;
<TR>
	<TD ALIGN=right bgcolor="#90c0ff"><font color=red size=-1>
                *optional*</font> <B>Sixth DNS Hostname:</B></TD>
	<TD>
	    <input name="fqdn6" size=39 value="$nameservers{fqdn6}"><BR>
	</TD>
</TR>
EOF

    return $html;
}
####flux
sub calculate_price
{
    my ($domain_ref, $period) = @_;
    my $domain_discount = 0;
    my $period_discount = 0;
    my $final_discount = 0;
    my $price = 0;
    my %domain_group;
    my %regex;
    
#    PRICING => { # domain => [single_price, transfer_price, period_restriction bulk_discount_flag period_discount_flag]
#		'US' => [4.0, 14.0, 0, 'BULK_DISCOUNT', 'PERIOD_DISCOUNT'],
#		'UK' => [4.0,  0.0, 2, 'NO_BULK_DISCOUNT', 'NO_PERIOD_DISCOUNT'],
#		'CA' => [35.0,  0.0, 0, 'NO_BULK_DISCOUNT', 'NO_PERIOD_DISCOUNT'],
#	       },

#    GROUP => {
#	      US => [ ".com", ".net", ".org" ],
#	      UK => [ ".co.uk", ".org.uk" ],
#	      CA => [ ".ca", ".(bc|ab|sk|mb|on|qc|nb|ns|pe|nb|nf|nt|nu|yk).ca" ],
#	     },

    for my $group (keys %{$AU_FIELDS{GROUP}}) {
	my $regex = join '|', sort { length $b <=> length $a }
	    map { my $copy = $_; $copy =~ s/\./\\./g; $copy } @{$AU_FIELDS{GROUP}{$group}};
	$regex{$group} = "(" . $regex . ")\$";
    }

    for my $domain (@{$domain_ref}) {
	for my $group_name (keys %regex) {
	    $domain =~ m/$regex{$group_name}/ and ++$domain_group{$group_name};
	}
    }

    for my $group (keys %domain_group) {
	my $total_domains = $AU_FIELDS{MIXED_GROUP_BULK_FLAG} ? scalar @{$domain_ref} : $domain_group{$group};

	if ($in{reg_type} eq 'new') {

	    my $group_period = $AU_FIELDS{PRICING}{$group}[2] ? $AU_FIELDS{PRICING}{$group}[2] : $period;
	    if (exists $AU_FIELDS{BULK_ORDER_DISCOUNT} and $AU_FIELDS{PRICING}{$group}[3] eq 'BULK_DISCOUNT') {
		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{BULK_ORDER_DISCOUNT}}) {
		    if ($key <= $total_domains) {
			$domain_discount = $AU_FIELDS{BULK_ORDER_DISCOUNT}{$key};
			last;
		    }
		}
	    }

	    if (exists $AU_FIELDS{PERIOD_DISCOUNT} and $AU_FIELDS{PRICING}{$group}[4] eq 'PERIOD_DISCOUNT') {
		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{PERIOD_DISCOUNT}}) {
		    if ($key <= $group_period) {
			$period_discount = $AU_FIELDS{PERIOD_DISCOUNT}{$key};
			last;
		    }
		}
	    }

	    if ($AU_FIELDS{CUMULATIVE_DISCOUNT} == 1) {
		$final_discount = $period_discount + $domain_discount - ($domain_discount * $period_discount);
	    } else {
		$final_discount = $domain_discount > $period_discount ? $domain_discount : $period_discount;
	    }
	
#	    $price += ($AU_FIELDS{PRICING}{$group}[0] - ($AU_FIELDS{PRICING}{$group}[0] * $final_discount))
#	        * $group_period * $domain_group{$group};
	    
	    $price += (($AU_FIELDS{PRICING}{$group}[0] - $final_discount) * $group_period) * $total_domains;
	    
	} elsif ($AU_FIELDS{PRICING}{$group}[1]) {
	    if (exists $AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}) {
		foreach my $key (sort {$b <=> $a} keys %{$AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}}) {
		    if ($key <= $total_domains) {
			$domain_discount = $AU_FIELDS{TRANSFER_BULK_ORDER_DISCOUNT}{$key};
			last;
		    }
		}
	    }

	    $final_discount = $domain_discount;
	
	    $price += ($AU_FIELDS{PRICING}{$group}[1] - ($AU_FIELDS{PRICING}{$group}[1] * $final_discount))
	        * $domain_group{$group};
	}
    }
    return ($price);
}