#!/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;