#!/usr/bin/env perl
@ISA
= (
'Exporter'
);
@EXPORT
= (
'createEndPointL4'
,
'createSubjectL4'
,
'createSubjectL3'
,
'createParameters'
);
our
$VERSION
= 0.08;
our
$logger
=
&get_logger
(
"perfSONAR_PS::XML::Base"
);
sub
createEndPointL4
{
my
$doc
=
shift
;
my
$ns
=
shift
;
my
$hash
=
shift
;
my
$role
=
shift
;
my
$protocol
=
shift
;
my
$endPoint
=
$doc
->createElement(
'endPoint'
);
$endPoint
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$endPoint
->setAttribute(
'role'
,
$role
)
if
defined
$role
;
$endPoint
->setAttribute(
'protocol'
,
$protocol
)
if
defined
$protocol
;
my
$interface
=
$doc
->createElement(
'interface'
);
$interface
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$endPoint
->appendChild(
$interface
);
while
(
my
(
$k
,
$v
) =
each
%$hash
) {
my
$key
=
$doc
->createElement(
$k
);
$key
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
my
$text
= XML::LibXML::Text->new(
$v
);
$key
->appendChild(
$text
);
$interface
->appendChild(
$key
);
}
return
$endPoint
;
}
sub
createSubjectL4
{
my
$doc
=
shift
;
my
$ns
=
shift
;
my
$baseNS
=
shift
;
my
$protocol
=
shift
;
my
$sourceAddress
=
shift
;
my
$destinationAddress
=
shift
;
my
$sourceIP
=
shift
;
my
$destinationIP
=
shift
;
my
$subj
=
$doc
->createElement(
'subject'
);
$subj
->setNamespace(
$ns
->{
$baseNS
},
$baseNS
);
my
$endPoint
=
$doc
->createElement(
'endPointPair'
);
$endPoint
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$subj
->appendChild(
$endPoint
);
my
$source
=
&createEndPointL4
(
$doc
,
$ns
, {
'ifHostName'
=>
$sourceAddress
,
'ipAddress'
=>
$sourceIP
},
'src'
,
$protocol
);
$endPoint
->appendChild(
$source
);
my
$dest
=
&createEndPointL4
(
$doc
,
$ns
, {
'ifHostName'
=>
$destinationAddress
,
'ipAddress'
=>
$destinationIP
},
'dst'
,
$protocol
);
$endPoint
->appendChild(
$dest
);
return
$subj
;
}
sub
createSubjectL3
{
my
$doc
=
shift
;
my
$ns
=
shift
;
my
$baseNS
=
shift
;
my
$protocol
=
shift
;
my
$sourceAddress
=
shift
;
my
$destinationAddress
=
shift
;
my
$subj
=
$doc
->createElement(
'subject'
);
$subj
->setNamespace(
$ns
->getNsByKey(
$baseNS
),
$baseNS
);
my
$endPoint
=
$doc
->createElement(
'endPointPair'
);
$endPoint
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$subj
->appendChild(
$endPoint
);
my
$source
=
$doc
->createElement(
'endPoint'
);
$source
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$source
->setAttribute(
'role'
,
'src'
);
$source
->setAttribute(
'protocol'
,
$protocol
);
$endPoint
->appendChild(
$source
);
my
$sourceNode
=
$doc
->createElement(
'address'
);
$sourceNode
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$sourceNode
->setAttribute(
'value'
,
$sourceAddress
);
$source
->appendChild(
$sourceNode
);
my
$dest
=
$doc
->createElement(
'endPoint'
);
$dest
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$dest
->setAttribute(
'role'
,
'dst'
);
$dest
->setAttribute(
'protocol'
,
$protocol
);
$endPoint
->appendChild(
$dest
);
my
$destNode
=
$doc
->createElement(
'address'
);
$destNode
->setNamespace(
$ns
->getNsByKey(
'nmwgt'
),
'nmwgt'
);
$destNode
->setAttribute(
'value'
,
$destinationAddress
);
$dest
->appendChild(
$destNode
);
return
$subj
;
}
sub
createParameters
{
my
$doc
=
shift
;
my
$ns
=
shift
;
my
$baseNS
=
shift
;
my
$hash
=
shift
;
my
$param
=
$doc
->createElement(
'parameters'
);
$param
->setNamespace(
$ns
->getNsByKey(
$baseNS
),
$baseNS
);
while
(
my
(
$k
,
$v
) =
each
%{
$hash
} ) {
next
if
$k
=~ /^test/ ||
$k
=~ /^dest/ ||
$k
=~ /^src/ ;
my
$p
=
$doc
->createElement(
'parameter'
);
$p
->setNamespace(
$ns
->getNsByKey(
'nmwg'
),
'nmwg'
);
$p
->setAttribute(
'name'
,
$k
);
my
$text
= XML::LibXML::Text->new(
$v
);
$p
->appendChild(
$text
);
$param
->appendChild(
$p
);
}
return
$param
;
}
1;