204 lines
6.1 KiB
Perl
204 lines
6.1 KiB
Perl
# ==========================================================================
|
|
#
|
|
# ZoneMinder ONVIF Client module
|
|
# Copyright (C) 2014 Jan M. Hochstein
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 2
|
|
# of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# This module contains the base class for the SOAP serializers
|
|
#
|
|
|
|
package ONVIF::Serializer::Base;
|
|
use strict;
|
|
use warnings;
|
|
|
|
# =========================================================================
|
|
|
|
use Class::Std::Fast::Storable;
|
|
use Scalar::Util qw(blessed);
|
|
|
|
require SOAP::WSDL::Factory::Serializer;
|
|
|
|
## require SOAP::Constants;
|
|
use constant URI_1999_SCHEMA_XSD => "http://www.w3.org/1999/XMLSchema";
|
|
use constant URI_1999_SCHEMA_XSI => "http://www.w3.org/1999/XMLSchema-instance";
|
|
use constant URI_2000_SCHEMA_XSD => "http://www.w3.org/2000/10/XMLSchema";
|
|
use constant URI_2000_SCHEMA_XSI => "http://www.w3.org/2000/10/XMLSchema-instance";
|
|
use constant URI_2001_SCHEMA_XSD => "http://www.w3.org/2001/XMLSchema";
|
|
use constant URI_2001_SCHEMA_XSI => "http://www.w3.org/2001/XMLSchema-instance";
|
|
use constant URI_LITERAL_ENC => "";
|
|
use constant URI_SOAP11_ENC => "http://schemas.xmlsoap.org/soap/encoding/";
|
|
use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/";
|
|
use constant URI_SOAP11_NEXT_ACTOR => "http://schemas.xmlsoap.org/soap/actor/next";
|
|
use constant URI_SOAP12_ENC => "http://www.w3.org/2003/05/soap-encoding";
|
|
use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope";
|
|
use constant URI_SOAP12_NOENC => "http://www.w3.org/2003/05/soap-envelope/encoding/none";
|
|
use constant URI_SOAP12_NEXT_ACTOR => "http://www.w3.org/2003/05/soap-envelope/role/next";
|
|
|
|
|
|
my %soap_version_of :ATTR( :default<()>);
|
|
|
|
my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance';
|
|
|
|
sub soap_version
|
|
{
|
|
my ($self) = @_;
|
|
$soap_version_of{ident $self};
|
|
}
|
|
|
|
sub set_soap_version
|
|
{
|
|
my ($self, $version) = @_;
|
|
if(! (($version eq '1.1') or ($version eq '1.2')) ) {
|
|
warn "Undefined SOAP version \'$version\'";
|
|
return;
|
|
}
|
|
#print "using SOAP $version\n";
|
|
$soap_version_of{ident $self} = $version;
|
|
}
|
|
|
|
|
|
sub serialize {
|
|
my ($self, $args_of_ref) = @_;
|
|
|
|
my $SOAP_NS;
|
|
if($self->soap_version() eq '1.2') {
|
|
$SOAP_NS = URI_SOAP12_ENV;
|
|
}
|
|
else {
|
|
$SOAP_NS = URI_SOAP11_ENV;
|
|
}
|
|
|
|
my $opt = $args_of_ref->{ options };
|
|
|
|
if (not $opt->{ namespace }->{ $SOAP_NS })
|
|
{
|
|
$opt->{ namespace }->{ $SOAP_NS } = 'SOAP-ENV';
|
|
}
|
|
|
|
if (not $opt->{ namespace }->{ $XML_INSTANCE_NS })
|
|
{
|
|
$opt->{ namespace }->{ $XML_INSTANCE_NS } = 'xsi';
|
|
}
|
|
|
|
my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS };
|
|
|
|
# XML starts with header
|
|
my $xml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
|
|
|
|
# envelope starts with namespaces
|
|
$xml .= "<$soap_prefix\:Envelope ";
|
|
|
|
while (my ($uri, $prefix) = each %{ $opt->{ namespace } })
|
|
{
|
|
$xml .= "xmlns:$prefix=\"$uri\" ";
|
|
}
|
|
#
|
|
# add namespace for user-supplied prefix if needed
|
|
$xml .= "xmlns:$opt->{prefix}=\"" . $args_of_ref->{ body }->get_xmlns() . "\" "
|
|
if $opt->{prefix};
|
|
|
|
# TODO insert encoding
|
|
$xml.='>';
|
|
$xml .= $self->serialize_header($args_of_ref->{ method }, $args_of_ref->{ header }, $opt);
|
|
$xml .= $self->serialize_body($args_of_ref->{ method }, $args_of_ref->{ body }, $opt);
|
|
$xml .= '</' . $soap_prefix .':Envelope>';
|
|
|
|
return $xml;
|
|
}
|
|
|
|
sub serialize_header {
|
|
my ($self, $method, $data, $opt) = @_;
|
|
|
|
my $SOAP_NS;
|
|
if($self->soap_version() eq '1.2') {
|
|
$SOAP_NS = URI_SOAP12_ENV;
|
|
}
|
|
else {
|
|
$SOAP_NS = URI_SOAP11_ENV;
|
|
}
|
|
|
|
# header is optional. Leave out if there's no header data
|
|
return q{} if not $data;
|
|
return join ( q{},
|
|
"<$opt->{ namespace }->{ $SOAP_NS }\:Header>",
|
|
blessed $data ? $data->serialize_qualified : (),
|
|
"</$opt->{ namespace }->{ $SOAP_NS }\:Header>",
|
|
);
|
|
}
|
|
|
|
sub serialize_body {
|
|
my ($self, $method, $data, $opt) = @_;
|
|
|
|
my $SOAP_NS;
|
|
if($self->soap_version() eq '1.2') {
|
|
$SOAP_NS = URI_SOAP12_ENV;
|
|
}
|
|
else {
|
|
$SOAP_NS = URI_SOAP11_ENV;
|
|
}
|
|
|
|
# TODO This one wipes out the old class' XML name globally
|
|
# Fix in some more appropriate place...
|
|
$data->__set_name("$opt->{prefix}:" . $data->__get_name() ) if $opt->{prefix};
|
|
|
|
# Body is NOT optional. Serialize to empty body
|
|
# if we have no data.
|
|
return join ( q{},
|
|
"<$opt->{ namespace }->{ $SOAP_NS }\:Body>",
|
|
defined $data
|
|
? ref $data eq 'ARRAY'
|
|
? join q{}, map { blessed $_ ? $_->serialize_qualified() : () } @{ $data }
|
|
: blessed $data
|
|
? $opt->{prefix}
|
|
? $data->serialize()
|
|
: $data->serialize_qualified()
|
|
: ()
|
|
: (),
|
|
"</$opt->{ namespace }->{ $SOAP_NS }\:Body>",
|
|
);
|
|
}
|
|
|
|
# =========================================================================
|
|
|
|
|
|
1;
|
|
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
Copy of SOAP:WSDL::Serializer::XSD adapted
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
This file was adapted from a part of SOAP-WSDL. You may
|
|
distribute/modify it under the same terms as perl itself
|
|
|
|
=head1 REPOSITORY INFORMATION
|
|
|
|
$Rev: 851 $
|
|
$LastChangedBy: kutterma $
|
|
$Id: XSD.pm 851 2009-05-15 22:45:18Z kutterma $
|
|
$HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $
|
|
|
|
=cut
|
|
|