#!/usr/bin/perl -w
use 5.008;
use strict;
use diagnostics;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use Data::Dumper;
$Data::Dumper::Sortkeys = \&dumper_filter;
sub dumper_filter {
	my ($hash) = @_;
	return [(sort {lc $a cmp lc $b} keys %$hash)];
}
$| ++;
my $iban_wsdl_getform = 'http://dev.iban-bic.com/Riban/soap2/';

my %account = (
	'acc_user'	=> 'test',
	'acc_pass'	=> 'test',
);

my $cgi = CGI -> new;
$cgi -> autoEscape(0); # don't escape & because Data from Server is correct!
print $cgi -> header;
print $cgi -> start_html ('Test Escape SOAP Content');
print $cgi -> p ('- Begin of script -');

my $modul = 1;
eval "use SOAP::Lite; 1;" or $modul = 0;
if ($modul) {
	my $version = SOAP::Lite -> VERSION;
	print $cgi -> p ("SOAP::Lite $version detected");
	my $soap = SOAP::Lite -> new ();

	# get input mask
	$soap -> proxy ($iban_wsdl_getform);
	my ($hash_ref,@params);

	my %parameter = (
		'country'	=> 'NL',
	);

	foreach my $key (%parameter) {
		push @params,
			\SOAP::Data -> value (
				SOAP::Data -> name ('key' => $key) -> type ('xsd:string'),
				SOAP::Data -> name ('value' => $parameter{$key}) -> type ('xsd:string'),
			);
	}
	print $cgi -> p ('SENDE:<br><pre>' . Dumper (\@params) . '</pre>');
	eval {
		# do it in eval because smallest errors always cause hard abort in SOAP::Lite
		# !!ATTENTION!! The SOAP map always must be the first parameter,
		# username und password always have to be second and third parameter!
		$hash_ref = $soap -> get_form (
			SOAP::Data -> name ('params' => \@params) -> type ('tns:Map'),
			SOAP::Data -> name ('user' => $account{'acc_user'}) -> type ('xsd:string'),
			SOAP::Data -> name ('password' => $account{'acc_pass'}) -> type ('xsd:string'),
		);
	};
	if (defined $hash_ref) {
		my $result = $hash_ref -> result;
		print $cgi -> p ("ERHALTE:<br><pre>" . Dumper (\$result) . "</pre>");
		if (lc ($result -> {'done'}) eq 'no') {
			# prepare next step
			if (
				defined $result -> {'fields'}
					&&
				ref ($result -> {'fields'}) eq 'ARRAY'
					&&
				scalar (@{$result -> {'fields'}})
			) {
				my $error = 0;
				my $form_fields = '';
				for my $i (0 .. scalar (@{$result -> {'fields'}}) - 1) {
					my $field = build_formfield ($result -> {'fields'} -> [$i]);
					if ($field ne '') {
						$form_fields .= $field;
					}
					else {
						$error = $i + 1;
						last;
					}
				}
				if (!$error) {
					print $cgi -> start_form ();
					print $form_fields;
					print $cgi -> hidden ('acc_user',$account{'acc_user'});
					print $cgi -> hidden ('acc_pass',$account{'acc_pass'});
					print $cgi -> end_form ();
				}
				else {
					print $cgi -> p ("Sorry, unexpected value(s) in 'field' array # " . ($error - 1) . " in server response IBAN Method get_form!");
					print "<pre>" . Dumper (\$result) . "</pre>";
				}

				sub build_formfield {
					# function to build form field for next step
					my %deref = %{$_[0]};
					my $ref_hidden = $_[1];
					my $return = '';
					if (
						ref (\%deref) eq 'HASH'
							&&
						defined $deref{'type'}
							&&
						defined $deref{'id'}
							&&
						$deref{'id'} ne ''
							&&
						defined $deref{'value'}
							&&
						defined $deref{'length'}
							&&
						defined $deref{'label'}
					) {
						if (lc ($deref{'type'}) eq 'hidden') {
							$return .= $cgi -> hidden ($deref{'id'},$deref{'value'});
							# The following line should be $return .= $cgi -> hidden ('IBAN_KEY',$deref{'id'});
							# but CGI module doesn't build it right, takes everytime the wrong value for field
							# Perhaps a bug? I don't know and do it manually:
							$return .= '<input type="hidden" name="IBAN_KEY" value="' . $deref{'id'} . '"  />';
						}
						elsif (lc ($deref{'type'}) eq 'text') {
							if ($deref{'label'} ne '') {
								$return .= '<p>' . $deref{'label'} . ':&nbsp;';
							}
							$return .= $cgi -> textfield ($deref{'id'},$deref{'value'},$deref{'length'},$deref{'length'});
							if (defined $deref{'newline'} && $deref{'newline'} eq 'yes') {
								$return .= '</p>';
							}
							$return .= '<input type="hidden" name="IBAN_KEY" value="' . $deref{'id'} . '"  />';
						}
						elsif (lc ($deref{'type'}) eq 'submit') {
							$return .= $cgi -> submit ('',$deref{'label'});
						}
						elsif (lc ($deref{'type'}) eq 'select') {
							if ($deref{'label'} ne '') {
								$return .= '<p>' . $deref{'label'} . ':&nbsp;';
							}
							my %hash_for_popup;
							my @labels = @{$deref{'options'}};
							my @values = @{$deref{'optionids'}};
							@hash_for_popup{@values} = @labels;
							$return .= $cgi -> popup_menu (
								-name		=> $deref{'id'},
								-values		=> $deref{'optionids'},
								-labels		=> \%hash_for_popup,
							);
							if (defined $deref{'newline'} && $deref{'newline'} eq 'yes') {
								$return .= '</p>';
							}
						}
					}
					return $return;
				}
			}
			else {
				print $cgi -> p ("Sorry, unexpected value(s) of 'fields' in server response IBAN Method get_form!");
				print "<pre>" . Dumper (\$result) . "</pre>";
			}
		}
	}
	else {
		print $cgi -> p (
			"Sorry, one or more internal errors occurred!"
			. "<br>Do you perform your request in correct order, first=map, second=user, third=password?"
		);
	}
}
else {
	print $cgi -> p ("Sorry, can't find SOAP::Lite!");
}
print $cgi -> p ('- End of script -');
print $cgi -> end_html;