Skip to content
GitLab
Commit 9b562c6b authored by IKEDA Soji's avatar IKEDA Soji
Browse files

Refactoring Config_XML. Added tests.

parent 122e1b12
Hide whitespace changes
Inline Side-by-side
Makefile.am
View file @ 9b562c6b
......@@ -34,6 +34,7 @@ check_SCRIPTS = \
t/compile_modules.t \
t/compile_executables.t \
t/compile_scenarios.t \
t/Config_XML.t \
t/Database_LDAP.t \
t/parse_templates.t \
t/pod-syntax.t \
......
src/lib/Sympa/Config_XML.pm
View file @ 9b562c6b
......@@ -30,252 +30,126 @@ package Sympa::Config_XML;
use strict;
use warnings;
use Encode qw();
use English qw(-no_match_vars);
use XML::LibXML;
use Sympa::Log;
my $log = Sympa::Log->instance;
#########################################
# new
#########################################
# constructor of the class Config_XML :
# Constructor of the class Config_XML :
# parse the xml file
#
# IN : -$class
# -$fh : file handler on the xml file
#########################################
# -$file : path of XML file or file handle on the XML file.
sub new {
$log->syslog('debug2', '(%s, %s)', @_);
my $class = shift;
my $path = shift;
my $file = shift;
my $fh;
unless (open $fh, '<', $path) {
$log->syslog('err', 'Can\'t open %s: $m', $path);
return bless {} => $class;
if (ref $file) {
$fh = $file;
} else {
unless (open $fh, '<', $file) {
$log->syslog('err', 'Can\'t open %s: $m', $file);
return bless {} => $class;
}
}
my $self = {};
my $parser = XML::LibXML->new();
my $parser = XML::LibXML->new;
$parser->line_numbers(1);
my $doc = $parser->parse_fh($fh);
my $doc = eval { $parser->parse_fh($fh) };
unless ($doc) {
$log->syslog('err', '%s',
(ref $EVAL_ERROR) ? $EVAL_ERROR->as_string : $EVAL_ERROR);
return bless {} => $class;
}
$self->{'root'} = $doc->documentElement();
my $root = $doc->documentElement;
my $config;
if ($root) {
unless ($root->nodeName eq 'list') {
$log->syslog('err', 'The root element must be called "list"');
} elsif (not _checkRequiredSingle($root, 'listname')) {
;
} else {
my $hash = _getChildren($root);
if (ref $hash eq 'HASH' and %$hash) {
$config = $hash;
}
}
}
if ($config) {
# Compatibility: single topic on 6.2.24 or earlier.
$config->{topics} ||= $config->{topic};
# In old documentation "moderator" was single or multiple editors.
my $mod = $config->{moderator};
$config->{editor} ||=
(ref $mod eq 'ARRAY') ? $mod : (ref $mod eq 'HASH') ? [$mod] : [];
}
return bless $self => $class;
return bless {config => $config} => $class;
}
# Returns the hash structure.
sub as_hashref {
$log->syslog('debug2', '(%s)', @_);
my $self = shift;
return undef unless $self->{root};
return undef unless $self->_createHash;
my $phash = {%{$self->{config} || {}}};
# Compatibility: single topic on 6.2.24 or earlier.
$phash->{topics} ||= $phash->{topic};
# In old documentation "moderator" was single or multiple editors.
my $mod = $phash->{moderator};
$phash->{editor} ||=
(ref $mod eq 'ARRAY') ? $mod : (ref $mod eq 'HASH') ? [$mod] : [];
return $phash;
return shift->{config} || undef;
}
# Create a hash used to create a list. Check elements unicity when their are
# not declared multiple.
# Old name: Sympa::Config_XML::createHash().
sub _createHash {
my $self = shift;
unless ($self->{'root'}->nodeName eq 'list') {
$log->syslog('err', 'The root element must be called "list"');
return undef;
}
unless (defined $self->_getRequiredElements()) {
$log->syslog('err', 'Error in required elements');
return undef;
}
if ($self->{'root'}->hasChildNodes()) {
my $hash = _getChildren($self->{'root'});
unless ($hash) {
$log->syslog('err', 'Error in list elements');
return undef;
} elsif (ref $hash eq 'HASH') {
$self->{config} = {%{$self->{config} || {}}, %$hash};
} else { # a string
$log->syslog('err', 'The list\'s children are not homogeneous');
return undef;
}
}
return 1;
}
# Deprecated: No longer used.
#sub _createHash;
# Deprecated: No longer used.
#sub getHash;
#################################################################
# _getRequiredElements
#################################################################
# get all obligatory elements and store them :
# single : listname
# remove it in order to the later recursive call
#
# IN : -$self
# OUT : -1 or undef
#################################################################
sub _getRequiredElements {
$log->syslog('debug3', @_);
my $self = shift;
# listname element is obligatory
unless ($self->_getRequiredSingle('listname')) {
return undef;
}
return 1;
}
####################################################
# _getMultipleAndRequiredChild : no used anymore
####################################################
# get all nodes with name $nodeName and check if
# they contain the child $childName and store them
#
# IN : -$self
# -$nodeName
# -$childName
# OUT : - the number of node with the name $nodeName
####################################################
sub _getMultipleAndRequiredChild {
my $self = shift;
my $nodeName = shift;
my $childName = shift;
$log->syslog('debug3', '(%s, %s)', $nodeName, $childName);
my @nodes = $self->{'root'}->getChildrenByTagName($nodeName);
unless (defined _verify_single_nodes(\@nodes)) {
return undef;
}
foreach my $o (@nodes) {
my @child = $o->getChildrenByTagName($childName);
if ($#child < 0) {
$log->syslog('err',
'Element "%s" is required for element "%s", line: %s',
$childName, $nodeName, $o->line_number());
return undef;
}
my $hash = _getChildren($o);
unless (defined $hash) {
$log->syslog('err', 'Error on _getChildren(%s)', $o->nodeName);
return undef;
}
# Deprecated: No longer used.
#sub _getRequiredElements;
push @{$self->{'config'}{$nodeName}}, $hash;
$self->{'root'}->removeChild($o);
}
return ($#nodes + 1);
}
# No longer used.
#sub _getMultipleAndRequiredChild;
############################################
# _getRequiredSingle
############################################
# get the node with name $nodeName and check
# its unicity and store it
#
# IN : -$self
# -$nodeName
# OUT : -1 or undef
############################################
sub _getRequiredSingle {
my $self = shift;
# Old name: Sympa::Config_XML::_getRequiredSingle().
sub _checkRequiredSingle {
$log->syslog('debug3', '(%s, %s, %s)', @_);
my $root = shift;
my $nodeName = shift;
$log->syslog('debug3', '(%s)', $nodeName);
my @nodes = $self->{'root'}->getChildrenByTagName($nodeName);
unless (_verify_single_nodes(\@nodes)) {
return undef;
}
if ($#nodes < 0) {
my @nodes = $root->getChildrenByTagName($nodeName);
unless (@nodes) {
$log->syslog('err', 'Element "%s" is required for the list',
$nodeName);
return undef;
}
if ($#nodes > 0) {
my @error;
foreach my $i (@nodes) {
push(@error, $i->line_number());
}
} elsif (1 < scalar @nodes) {
my @error = map { $_->line_number } @nodes;
$log->syslog('err',
'Only one element "%s" is allowed for the list, lines: %s',
$nodeName, join(", ", @error));
return undef;
}
my $node = shift(@nodes);
if ($node->getAttribute('multiple')) {
} elsif ($nodes[0]->getAttribute('multiple')) {
$log->syslog('err',
'Attribute multiple=1 not allowed for the element "%s"',
$nodeName);
'Attribute multiple not allowed for the element "%s"', $nodeName);
return undef;
}
if ($nodeName eq 'type') {
## the list template creation without family context
my $value = $node->textContent;
$value =~ s/^\s*//;
$value =~ s/\s*$//;
$self->{$nodeName} = $value;
} else {
my $values = _getChildren($node);
unless (defined $values) {
$log->syslog('err', 'Error on _getChildren(%s)', $node->nodeName);
return undef;
}
if (ref($values) eq "HASH") {
foreach my $k (keys %$values) {
$self->{'config'}{$nodeName}{$k} = $values->{$k};
}
} else {
$self->{'config'}{$nodeName} = $values;
}
my $values = _getChildren($nodes[0]);
if (not $values or ref $values) {
return undef;
}
$self->{'root'}->removeChild($node);
return 1;
}
##############################################
# _getChildren
##############################################
# get $node's children (elements, text,
# cdata section) and their values
# it is a recursive call
#
# Gets $node's children (elements, text, cdata section) and their values
# recursively.
# IN : -$node
# OUT : -$hash : hash of children and
# their contents if elements
# or
# $string : value of cdata section
# or of text content
##############################################
# OUT : -$hash : hash of children and their contents if elements, or
# $string : value of cdata section or of text content
sub _getChildren {
$log->syslog('debug3', '(%s)', @_);
my $node = shift;
$log->syslog('debug3', '(%s)', $node->nodeName);
# return value
my $hash = {};
......@@ -287,28 +161,30 @@ sub _getChildren {
my @nodeList = $node->childNodes();
unless (_verify_single_nodes(\@nodeList)) {
return undef;
}
foreach my $child (@nodeList) {
my $type = $child->nodeType;
my $childName = $child->nodeName;
# ELEMENT_NODE
if ($type == 1) {
# ELEMENT_NODE
my $values = _getChildren($child);
unless (defined $values) {
$log->syslog('err', 'Error on _getChildren(%s)', $childName);
return undef;
}
return undef unless $values;
## multiple
if ($child->getAttribute('multiple')) {
push @{$multiple_nodes->{$childName}}, $values;
## single
} else {
# Verify single nodes.
my @sisters = $node->getChildrenByTagName($childName);
if (1 < scalar @sisters) {
$log->syslog(
'err',
'Element "%s" is not declared in multiple but it is: lines %s',
$childName,
join(', ', map { $_->line_number } @sisters)
);
return undef;
}
if (ref($values) eq "HASH") {
foreach my $k (keys %$values) {
$hash->{$childName}{$k} = $values->{$k};
......@@ -322,9 +198,8 @@ sub _getChildren {
$error = 1;
}
$return = "hash";
# TEXT_NODE
} elsif ($type == 3) {
# TEXT_NODE
my $value = Encode::encode_utf8($child->nodeValue);
$value =~ s/^\s+//;
unless ($value eq "") {
......@@ -334,9 +209,8 @@ sub _getChildren {
}
$return = "string";
}
# CDATA_SECTION_NODE
} elsif ($type == 4) {
# CDATA_SECTION_NODE
$string = $string . Encode::encode_utf8($child->nodeValue);
if ($return eq "hash") {
$error = 1;
......@@ -369,68 +243,10 @@ sub _getChildren {
}
}
##################################################
# _verify_single_nodes
##################################################
# check the uniqueness(in a node list) for a node not
# declared multiple.
# (no attribute multiple = "1")
#
# IN : -$nodeList : ref on the array of nodes
# OUT : -1 or undef
##################################################
sub _verify_single_nodes {
my $nodeList = shift;
$log->syslog('debug3', '');
my $error = 0;
my %error_nodes;
my $nodeLines = _find_lines($nodeList);
foreach my $node (@$nodeList) {
if ($node->nodeType == 1) { # ELEMENT_NODE
unless ($node->getAttribute("multiple")) {
my $name = $node->nodeName;
if ($#{$nodeLines->{$name}} > 0) {
$error_nodes{$name} = 1;
}
}
}
}
foreach my $node (keys %error_nodes) {
my $lines = join ', ', @{$nodeLines->{$node}};
$log->syslog('err',
'Element %s is not declared in multiple but it is: lines %s',
$node, $lines);
$error = 1;
}
if ($error) {
return undef;
}
return 1;
}
# Deprecated: No longer used.
#sub _verify_single_nodes;
###############################################
# _find_lines
###############################################
# make a hash : keys are node names, values
# are arrays of their line occurrences
#
# IN : - $nodeList : ref on a array of nodes
# OUT : - $hash : ref on the hash defined
###############################################
sub _find_lines {
my $nodeList = shift;
$log->syslog('debug3', '');
my $hash = {};
foreach my $node (@$nodeList) {
if ($node->nodeType == 1) { # ELEMENT_NODE
push @{$hash->{$node->nodeName}}, $node->line_number();
}
}
return $hash;
}
# Deprecated: No longer used.
#sub _find_lines;
1;
t/Config_XML.t 0 → 100644
View file @ 9b562c6b
# -*- indent-tabs-mode: nil; -*-
# # vim:ft=perl:et:sw=4
use strict;
use warnings;
use FindBin qw($Bin);
use IO::Scalar;
use Test::More;
BEGIN {
use_ok('Sympa::Config_XML');
}
my @in = do { local $/ = ''; <DATA> };
is_deeply(
Sympa::Config_XML->new(IO::Scalar->new(\(shift @in)))->as_hashref,
{ 'owner' => [
{ 'email' => 'admin.etulistes@example.fr',
'gecos' => 'Administrateur listes etudiants'
}
],
'topics' => 'fst/etulistes',
'editor' => [],
'subject' => 'FST Licence 1e annee Informatique-groupe 1',
'listname' => '1liai1-1-s1-in-1',
'ldap' => {
'select2' => 'first',
'scope2' => 'sub',
'suffix1' => 'ou=groups,dc=example,dc=fr',
'suffix2' => '[attrs1]',
'attrs1' => 'member',
'user' => 'XXX',
'select1' => 'all',
'filter2' => '(mail=*)',
'timeout1' => '30',
'attrs2' => 'mail',
'scope1' => 'sub',
'host' => 'XXX',
'use_ssl' => 'yes',
'passwd' => 'XXX',
'filter1' => '(uhaGroupeMail=1LIAI1-1-S1-IN-1@example.fr)',
'timeout2' => '30',
'ssl_version' => 'sslv3'
}
}
);
is_deeply(
Sympa::Config_XML->new(IO::Scalar->new(\(shift @in)))->as_hashref,
{ 'owner' => [{'email' => 'bruno.malaval@example.fr'}],
'topics' => undef,
'editor' => [],
'subject' => 'test-etc',
'listname' => 'di-test-xml',
'type' => 'intranet_list'
}
);
is(Sympa::Config_XML->new(IO::Scalar->new(\(shift @in)))->as_hashref, undef);
is(Sympa::Config_XML->new(IO::Scalar->new(\(shift @in)))->as_hashref, undef);
done_testing();
__END__
<?xml version="1.0" ?>
<list>
<listname>1liai1-1-s1-in-1</listname>
<subject>FST Licence 1e annee Informatique-groupe 1</subject>
<owner multiple="1">
<email>admin.etulistes@example.fr</email>
<gecos>Administrateur listes etudiants</gecos>
</owner>
<ldap>
<host>XXX</host>
<user>XXX</user>
<passwd>XXX</passwd>
<use_ssl>yes</use_ssl>
<ssl_version>sslv3</ssl_version>
<suffix1>ou=groups,dc=example,dc=fr</suffix1>
<timeout1>30</timeout1>
<attrs1>member</attrs1>
<filter1>(uhaGroupeMail=1LIAI1-1-S1-IN-1@example.fr)</filter1>
<scope1>sub</scope1>
<select1>all</select1>
<suffix2>[attrs1]</suffix2>
<timeout2>30</timeout2>
<attrs2>mail</attrs2>
<filter2>(mail=*)</filter2>
<scope2>sub</scope2>
<select2>first</select2>
</ldap>
<topics>fst/etulistes</topics>
</list>
<?xml version="1.0" ?>
<list>
<listname>di-test-xml</listname>
<type>intranet_list</type>
<subject>test-etc</subject>
<owner multiple="1">
<email>bruno.malaval@example.fr</email>
</owner>
</list>
<?xml version="1.0" ?>
<list>
<listname>di-test-xml</listname>
<type>intranet_list</type>
<subject>test-etc</subject>
<owner>
<email>bruno.malaval@example.fr</email>
</owner>
<owner>
<email>bruno.malaval@example.fr</email>
</owner>
</list>
<?xml version="1.0" ?>
<list>
<listname multiple="1">di-test-xml</listname>
<listname multiple="1">di-test-xml</listname>
<type>intranet_list</type>
<subject>test-etc</subject>
<owner multiple="1">
<email>bruno.malaval@example.fr</email>
</owner>
</list>
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment