use
vars
qw($STATUS_CODE $STATUS $HEADER $CONTENT $POST $GET)
;
$POST
=
'POST'
;
$GET
=
'GET'
;
$STATUS_CODE
=
'status_code'
;
$STATUS
=
'status'
;
$HEADER
=
'header'
;
$CONTENT
=
'content'
;
sub
new {
my
(
$class
) =
shift
;
my
(
$this
) = {};
bless
$this
,
$class
;
}
sub
post {
my
(
$this
) =
shift
;
if
(
@_
< 6) {
return
""
;
}
my
(
$post_addr
,
$post_port
,
$method
,
$path
,
$add_header
,
$req_content
) =
@_
;
my
(
$post_sockaddr
,
$req_content_len
,
$add_header_name
,
$add_header_value
,
$req_header
,
$res_status
,
$res_header_cnt
,
$res_header
,
$res_content_len
,
$res_content
,
$res
,
);
$req_content_len
=
length
(
$req_content
);
$req_header
=
<<"REQUEST_HEADER";
$method $path HTTP/1.0
Host: $post_addr:$post_port
Content-Length: $req_content_len
REQUEST_HEADER
if
(
ref
$add_header
) {
while
( (
$add_header_name
,
$add_header_value
) =
each
%{
$add_header
}) {
$req_header
.=
"$add_header_name: $add_header_value\n"
;
}
}
$req_header
.=
"\n"
;
$req_header
=~ s/\r//g;
$req_header
=~ s/\n/\r\n/g;
$post_sockaddr
= sockaddr_in(
$post_port
, inet_aton(
$post_addr
));
socket
(HTTP_SOCK, PF_INET, SOCK_STREAM,
getprotobyname
(
'tcp'
));
connect
(HTTP_SOCK,
$post_sockaddr
);
select
(HTTP_SOCK); $|=1;
select
(STDOUT);
if
(
$Net::UPnP::DEBUG
) {
print
$req_header
;
print
$req_content
;
}
print
HTTP_SOCK
$req_header
;
print
HTTP_SOCK
$req_content
;
$res_status
=
""
;
$res_header
=
""
;
$res_header_cnt
= 0;
while
(<HTTP_SOCK>) {
if
(m/^\r\n$/) {
last
;
}
$res_header_cnt
++;
if
(
$res_header_cnt
== 1) {
$res_status
.=
$_
;
next
;
}
$res_header
.=
$_
;
}
$res_content_len
= 0;
if
(
$res_header
=~ m/^Content-Length[: ]*(\d+)/i ) {
$res_content_len
= $1
}
$res_content
=
""
;
if
(
$res_content_len
) {
read
(HTTP_SOCK,
$res_content
,
$res_content_len
);
}
else
{
while
(<HTTP_SOCK>) {
$res_content
.=
$_
;
}
}
close
(HTTP_SOCK);
$res
= Net::UPnP::HTTPResponse->new();
$res
->setstatus(
$res_status
);
$res
->setheader(
$res_header
);
$res
->setcontent(
$res_content
);
if
(
$Net::UPnP::DEBUG
) {
print
$res_status
;
print
$res_header
;
print
$res_content
;
}
return
$res
;
}
sub
postsoap {
my
(
$this
) =
shift
;
my
(
$post_addr
,
$post_port
,
$path
,
$action_name
,
$action_content
) =
@_
;
my
(
%soap_header
,
$name
,
$value
);
%soap_header
= (
'Content-Type'
=>
"text/xml; charset=\"utf-8\""
,
'SOAPACTION'
=>
$action_name
,
);
$this
->post(
$post_addr
,
$post_port
,
$Net::UPnP::HTTP::POST
,
$path
, \
%soap_header
,
$action_content
);
}
sub
xmldecode {
my
(
$str
);
if
(
ref
$_
[0]) {
$str
=
$_
[1];
}
else
{
$str
=
$_
[0];
}
$str
=~ s/\
>
;/>/g;
$str
=~ s/\
<
;/</g;
$str
=~ s/\
"
;/\"/g;
$str
=~ s/\
&
;/\&/g;
$str
;
}
1;