2009-10-20 15:20:53 +02:00
|
|
|
package Lemonldap::NG::Common::Conf::Serializer;
|
|
|
|
|
2016-01-07 13:34:27 +01:00
|
|
|
use strict;
|
|
|
|
use utf8;
|
2016-01-11 14:41:46 +01:00
|
|
|
use Encode;
|
2016-01-13 20:47:56 +01:00
|
|
|
use JSON;
|
2016-01-11 07:27:20 +01:00
|
|
|
use Lemonldap::NG::Common::Conf::Constants;
|
2009-10-20 15:20:53 +02:00
|
|
|
|
2016-03-17 23:19:44 +01:00
|
|
|
our $VERSION = '2.0.0';
|
2011-06-10 14:23:15 +02:00
|
|
|
|
2009-10-20 15:20:53 +02:00
|
|
|
BEGIN {
|
2016-01-22 17:53:41 +01:00
|
|
|
*Lemonldap::NG::Common::Conf::normalize = \&normalize;
|
|
|
|
*Lemonldap::NG::Common::Conf::unnormalize = \&unnormalize;
|
|
|
|
*Lemonldap::NG::Common::Conf::serialize = \&serialize;
|
|
|
|
*Lemonldap::NG::Common::Conf::unserialize = \&unserialize;
|
2016-01-11 14:41:46 +01:00
|
|
|
*Lemonldap::NG::Common::Conf::oldUnserialize = \&oldUnserialize;
|
2009-10-20 15:20:53 +02:00
|
|
|
}
|
|
|
|
|
2010-06-25 15:51:09 +02:00
|
|
|
## @method string normalize(string value)
|
|
|
|
# Change quotes, spaces and line breaks
|
|
|
|
# @param value Input value
|
|
|
|
# @return normalized string
|
|
|
|
sub normalize {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $value ) = @_;
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# trim white spaces
|
|
|
|
$value =~ s/^\s*(.*?)\s*$/$1/;
|
|
|
|
|
|
|
|
# Convert carriage returns (\r) and line feeds (\n)
|
|
|
|
$value =~ s/\r/%0D/g;
|
|
|
|
$value =~ s/\n/%0A/g;
|
|
|
|
|
|
|
|
# Convert simple quotes
|
|
|
|
$value =~ s/'/'/g;
|
|
|
|
|
|
|
|
# Surround with simple quotes
|
|
|
|
$value = "'$value'" unless ( $self->{noQuotes} );
|
|
|
|
|
|
|
|
return $value;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method string unnormalize(string value)
|
|
|
|
# Revert quotes, spaces and line breaks
|
|
|
|
# @param value Input value
|
|
|
|
# @return unnormalized string
|
|
|
|
sub unnormalize {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $value ) = @_;
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# Convert simple quotes
|
|
|
|
$value =~ s/&#?39;/'/g;
|
|
|
|
|
|
|
|
# Convert carriage returns (\r) and line feeds (\n)
|
|
|
|
$value =~ s/%0D/\r/g;
|
|
|
|
$value =~ s/%0A/\n/g;
|
|
|
|
|
2015-05-11 06:20:10 +02:00
|
|
|
# Keep number as numbers
|
|
|
|
$value += 0 if ( $value =~ /^(?:0|(?:\-[0-9]|[1-9])[0-9]*)(?:\.[0-9]+)?$/ );
|
|
|
|
|
2010-06-25 15:51:09 +02:00
|
|
|
return $value;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method hashref serialize(hashref conf)
|
|
|
|
# Parse configuration and convert it into fields
|
|
|
|
# @param conf Configuration
|
|
|
|
# @return fields
|
2009-10-20 15:20:53 +02:00
|
|
|
sub serialize {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $conf ) = @_;
|
2009-10-20 15:20:53 +02:00
|
|
|
my $fields;
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# Parse configuration
|
2016-02-17 11:12:19 +01:00
|
|
|
foreach my $k ( keys %$conf ) {
|
2016-02-13 11:06:48 +01:00
|
|
|
my $v = $conf->{$k};
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# 1.Hash ref
|
2009-10-20 15:20:53 +02:00
|
|
|
if ( ref($v) ) {
|
2016-01-19 14:47:44 +01:00
|
|
|
$fields->{$k} = to_json($v);
|
2009-10-20 15:20:53 +02:00
|
|
|
}
|
2010-06-25 15:51:09 +02:00
|
|
|
else {
|
2016-01-11 12:59:54 +01:00
|
|
|
$fields->{$k} = $v;
|
2009-10-20 15:20:53 +02:00
|
|
|
}
|
|
|
|
}
|
2010-06-25 15:51:09 +02:00
|
|
|
|
2009-10-20 15:20:53 +02:00
|
|
|
return $fields;
|
|
|
|
}
|
|
|
|
|
2010-06-25 15:51:09 +02:00
|
|
|
## @method hashref unserialize(hashref fields)
|
|
|
|
# Convert fields into configuration
|
|
|
|
# @param fields Fields
|
|
|
|
# @return configuration
|
2009-10-20 15:20:53 +02:00
|
|
|
sub unserialize {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $fields ) = @_;
|
2009-10-20 15:20:53 +02:00
|
|
|
my $conf;
|
2010-06-25 15:51:09 +02:00
|
|
|
|
2016-01-11 12:59:54 +01:00
|
|
|
# Parse fields
|
2016-01-22 17:53:41 +01:00
|
|
|
foreach my $k ( keys %$fields ) {
|
2016-01-12 23:04:07 +01:00
|
|
|
my $v = $fields->{$k};
|
2016-01-11 12:59:54 +01:00
|
|
|
if ( $k =~ $hashParameters ) {
|
|
|
|
unless ( utf8::is_utf8($v) ) {
|
|
|
|
$v = encode( 'UTF-8', $v );
|
|
|
|
}
|
2017-09-28 14:52:14 +02:00
|
|
|
$conf->{$k} =
|
|
|
|
( $v =~ /./
|
|
|
|
? eval { from_json( $v, { allow_nonref => 1 } ) }
|
|
|
|
: {} );
|
2016-01-11 12:59:54 +01:00
|
|
|
if ($@) {
|
|
|
|
$Lemonldap::NG::Common::Conf::msg .=
|
2016-01-12 22:00:09 +01:00
|
|
|
"Unable to decode $k, switching to old format.\n";
|
2016-01-11 14:41:46 +01:00
|
|
|
return $self->oldUnserialize($fields);
|
2016-01-11 12:59:54 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$conf->{$k} = $v;
|
|
|
|
}
|
|
|
|
}
|
2016-01-18 19:40:47 +01:00
|
|
|
return $conf;
|
2016-01-11 12:59:54 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub oldUnserialize {
|
|
|
|
my ( $self, $fields ) = @_;
|
|
|
|
my $conf;
|
|
|
|
|
2010-06-25 15:51:09 +02:00
|
|
|
# Parse fields
|
2009-10-20 15:20:53 +02:00
|
|
|
while ( my ( $k, $v ) = each(%$fields) ) {
|
2010-02-08 13:20:37 +01:00
|
|
|
|
|
|
|
# Remove surrounding quotes
|
2009-10-20 15:20:53 +02:00
|
|
|
$v =~ s/^'(.*)'$/$1/s;
|
2010-02-08 13:20:37 +01:00
|
|
|
|
|
|
|
# Manage hashes
|
2015-05-11 06:20:10 +02:00
|
|
|
|
2016-01-11 07:27:20 +01:00
|
|
|
if ( $k =~ $hashParameters and $v ||= {} and not ref($v) ) {
|
2009-10-20 15:20:53 +02:00
|
|
|
$conf->{$k} = {};
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# Value should be a Data::Dumper, else this is an old format
|
2009-10-20 15:20:53 +02:00
|
|
|
if ( defined($v) and $v !~ /^\$/ ) {
|
2010-06-25 15:51:09 +02:00
|
|
|
|
2016-01-07 13:34:27 +01:00
|
|
|
$Lemonldap::NG::Common::Conf::msg .=
|
2010-06-25 15:51:09 +02:00
|
|
|
" Warning: configuration is in old format, you've to migrate!";
|
|
|
|
|
2009-10-20 15:20:53 +02:00
|
|
|
eval { require Storable; require MIME::Base64; };
|
|
|
|
if ($@) {
|
2016-01-07 13:34:27 +01:00
|
|
|
$Lemonldap::NG::Common::Conf::msg .= " Error: $@";
|
2009-10-20 15:20:53 +02:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
$conf->{$k} = Storable::thaw( MIME::Base64::decode_base64($v) );
|
|
|
|
}
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# Convert Data::Dumper
|
2009-10-20 15:20:53 +02:00
|
|
|
else {
|
|
|
|
my $data;
|
|
|
|
$v =~ s/^\$([_a-zA-Z][_a-zA-Z0-9]*) *=/\$data =/;
|
2010-06-25 15:51:09 +02:00
|
|
|
$v = $self->unnormalize($v);
|
|
|
|
|
|
|
|
# Evaluate expression
|
2009-10-20 15:20:53 +02:00
|
|
|
eval $v;
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
if ($@) {
|
2016-01-11 07:27:20 +01:00
|
|
|
$Lemonldap::NG::Common::Conf::msg .=
|
|
|
|
" Error: cannot read configuration key $k: $@";
|
2010-06-25 15:51:09 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# Store value in configuration object
|
2009-10-20 15:20:53 +02:00
|
|
|
$conf->{$k} = $data;
|
|
|
|
}
|
|
|
|
}
|
2010-06-25 15:51:09 +02:00
|
|
|
|
|
|
|
# Other fields type
|
2009-10-20 15:20:53 +02:00
|
|
|
else {
|
2010-06-25 15:51:09 +02:00
|
|
|
$conf->{$k} = $self->unnormalize($v);
|
2009-10-20 15:20:53 +02:00
|
|
|
}
|
|
|
|
}
|
2010-06-25 15:51:09 +02:00
|
|
|
|
2009-10-20 15:20:53 +02:00
|
|
|
return $conf;
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|
|
__END__
|