[ic] HTTP POSTing to another server from IC

[Marc Brevoort]

On Wed, 2003-08-20 at 23:46, Grant wrote:
> I need to POST HTTP requests to another server from IC.  I've been all over
> this thread (
> http://www.icdevgroup.org/pipermail/interchange-users/2003-February/031565.h
> tml ) and an example I have of it being done in Perl and I can't seem to
> figure out how to make it happen in IC after working on it for most of the
> day.  What I need to do is pass certain headers and an XML request to a
> certain URL.  Can anyone help?  Am I making sense?
> 
> - Grant

Try if these get you started. The posttourl tag should be able to handle
regular http without ssl.

###############################
Usertag posttourl Order url params
Usertag posttourl Interpolate 1
Usertag posttourl Routine <<EOR
sub {
require HTTP::Request;
require HTTP::Headers;
require LWP::UserAgent; # SSL cabable if Crypt::SSLeay installed
        my $url=shift; my $params=shift;
        $ENV{'HTTPS_VERSION'} = '3';
        $ENV{'HTTPS_CERT_FILE'}='xxx.pem';       
	$ENV{'HTTPS_KEY_FILE'}='xxx.key';

        my $page="";
        my $request=new HTTP::Request 'POST' => $url;
        $request->content_type('application/x-www-form-urlencoded');
        $request->content($params);
        $request->content_length(length($params));

        my $ua=LWP::UserAgent->new;
        my $response = $ua->request($request);
        $page.=$response->as_string,"\n\n\n";
        $page.=$response->code,"\n";
        $page.=$response->message,"\n";
        return $page;
}
EOR
####################################

#####################################
Usertag parsexml hasEndTag
Usertag parsexml Interpolate 1
Usertag parsexml Routine <<EOR
#######################################################
# This usertag takes a block of XML and parses it.
# The found variables will be stored in $CGI.
# Return value of the tag is the list of parsed 
# variables.
# Currently, the tree structure of the XML document 
# is not preserved.
######################################################
sub {
##############################################
# This part sets up the XML parser for
# processing the result of the POST operation
##############################################

# This part only declares/initalizes some stuff 
# for them to be in scope to the subs defined
# next

        my ($xml)=@_;
        require XML::Parser;
        my @field=();
        my $tag="";
        my $result="";

sub cleanupxml {
##################################################
# This sub attempts to remove some non-xml trash 
# from the returned result of the post operation
# to prevent confusing the XML parser.
# Also, it wraps the xml in tags <XMLDOC_WRAPPER>
# to make the parser tolerate empty xml.
##################################################
        my ($xmltoclean)=@_;
        my $cleanedxml="";
        my $returnxml="";
        my $start="";
        my $line="";
        my $x=substr($xmltoclean,1,6);
        if (index($xmltoclean,"\<\?xml")<0) {
                $cleanedxml="<\?xml version=\"1.0\"
encoding=\"UTF-8\"\?\>"
                ."\n"
#               ."\<temp\>".$x."\<\/temp\>" # for debugging
                .$xmltoclean;
        } else {
               
$cleanedxml=substr($xmltoclean,index($xmltoclean,"\<\?xml"));
        }
        my @xmllines=split("\n",$cleanedxml);
        foreach $line (@xmllines) {
                next if (($line eq "")||($line eq "\n")||($line eq
"\r")||($line eq "\s"));
                if ($start ne "") {
                        $returnxml.=$line."\n";
                        next;
                }
                next if lc(substr($line,0,5)) ne "\<\?xml";

                $returnxml.=$line."\n\<XMLDOC_WRAPPER\>\n";
                $start="x";
        }

        if ($returnxml eq "") {
                return $returnxml
                ."\<\?xml version=\"1.0\"
encoding=\"UTF\-8\"?>\n\<XMLDOC_WRAPPER\>\<\/XMLDOC_WRAPPER\>";
        }
        return $returnxml."\<\/XMLDOC_WRAPPER\>";
}

sub Start_Handler {
# Called when a xml tag start has been found.
        my $p=shift;
        my $el=shift;
        $tag=$el;
        while (my $key=shift) {
                my $val=shift;
        }
}

sub End_Handler {
#       Called when a xml tag is closed,
#       we do not use it for anything much.
        my $p=shift;
        my $el=shift;
}

sub Default_Handler {
#       Called when content of a xml tag has been found.
        my $p=shift;
        my $el=shift;

        if (($el eq "")||($tag eq "")) {
                return;
        }
        if ($tag eq "XMLDOC_WRAPPER") {
                return;
        }
        $CGI->{$tag}=$el;
        $result.=$tag."=".$el."\n";
        push @field,$tag;$tag="";
}

#####################################
# Tag's executable code starts here
#####################################

        my $parser=new XML::Parser(ErrorContext=>2);

        $parser->setHandlers(
                Start=>\&Start_Handler,
                End =>\&End_Handler,
                Default=>\&Default_Handler
        );

#       $result.="--cleanup--<br>\n"; # for debugging
        my $cleanxml=cleanupxml($xml);
#       return $cleanxml; # Preliminary exit for debugging purposes

#       $result.="cleanxml=<br>\n".$cleanxml."<br>\n"; # for debugging
        my $parseresult=$parser->parse($cleanxml);

        my $fieldname="";

#       $result.=substr($cleanxml,1,8); # for debugging

        foreach $fieldname (@field) {
                next if $fieldname eq "";
                next if $fieldname eq "XMLDOC_WRAPPER";
                $result.=$fieldname.'='.$CGI->{$fieldname}."\n";
        }
        return $result;
}
EOR


###################################
Regards,

Marc Brevoort
-- 
e-mail:	marc.brevoort at armazemdedados.com
web:	http://www.armazemdedados.com

Armazem de Dados, Informatica, Lda
Dep. Desenvolvimento
Tel. +351 21 910 83 10 / Fax. +351- 21 910 83 19