/usr/share/perl5/Lemonldap/NG/Common/Conf/Serializer.pm is in liblemonldap-ng-common-perl 1.9.16-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 | package Lemonldap::NG::Common::Conf::Serializer;
use strict;
use utf8;
use Encode;
use JSON;
use Lemonldap::NG::Common::Conf::Constants;
our $VERSION = '1.9.13';
BEGIN {
*Lemonldap::NG::Common::Conf::normalize = \&normalize;
*Lemonldap::NG::Common::Conf::unnormalize = \&unnormalize;
*Lemonldap::NG::Common::Conf::serialize = \&serialize;
*Lemonldap::NG::Common::Conf::unserialize = \&unserialize;
*Lemonldap::NG::Common::Conf::oldUnserialize = \&oldUnserialize;
}
## @method string normalize(string value)
# Change quotes, spaces and line breaks
# @param value Input value
# @return normalized string
sub normalize {
my ( $self, $value ) = @_;
# 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 {
my ( $self, $value ) = @_;
# 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;
# Keep number as numbers
$value += 0 if ( $value =~ /^(?:0|(?:\-[0-9]|[1-9])[0-9]*)(?:\.[0-9]+)?$/ );
return $value;
}
## @method hashref serialize(hashref conf)
# Parse configuration and convert it into fields
# @param conf Configuration
# @return fields
sub serialize {
my ( $self, $conf ) = @_;
my $fields;
# Parse configuration
foreach my $k ( keys %$conf ) {
my $v = $conf->{$k};
# 1.Hash ref
if ( ref($v) ) {
$fields->{$k} = to_json($v);
}
else {
$fields->{$k} = $v;
}
}
return $fields;
}
## @method hashref unserialize(hashref fields)
# Convert fields into configuration
# @param fields Fields
# @return configuration
sub unserialize {
my ( $self, $fields ) = @_;
my $conf;
# Parse fields
foreach my $k ( keys %$fields ) {
my $v = $fields->{$k};
if ( $k =~ $hashParameters ) {
unless ( utf8::is_utf8($v) ) {
$v = encode( 'UTF-8', $v );
}
$conf->{$k} = (
$v =~ /./
? eval { from_json( $v, { allow_nonref => 1 } ) }
: {}
);
if ($@) {
$Lemonldap::NG::Common::Conf::msg .=
"Unable to decode $k, switching to old format.\n";
return $self->oldUnserialize($fields);
}
}
else {
$conf->{$k} = $v;
}
}
return $conf;
}
sub oldUnserialize {
my ( $self, $fields ) = @_;
my $conf;
# Parse fields
while ( my ( $k, $v ) = each(%$fields) ) {
# Remove surrounding quotes
$v =~ s/^'(.*)'$/$1/s;
# Manage hashes
if ( $k =~ $hashParameters and $v ||= {} and not ref($v) ) {
$conf->{$k} = {};
# Value should be a Data::Dumper, else this is an old format
if ( defined($v) and $v !~ /^\$/ ) {
$Lemonldap::NG::Common::Conf::msg .=
" Warning: configuration is in old format, you've to migrate!";
eval { require Storable; require MIME::Base64; };
if ($@) {
$Lemonldap::NG::Common::Conf::msg .= " Error: $@";
return 0;
}
$conf->{$k} = Storable::thaw( MIME::Base64::decode_base64($v) );
}
# Convert Data::Dumper
else {
my $data;
$v =~ s/^\$([_a-zA-Z][_a-zA-Z0-9]*) *=/\$data =/;
$v = $self->unnormalize($v);
# Evaluate expression
eval $v;
if ($@) {
$Lemonldap::NG::Common::Conf::msg .=
" Error: cannot read configuration key $k: $@";
}
# Store value in configuration object
$conf->{$k} = $data;
}
}
# Other fields type
else {
$conf->{$k} = $self->unnormalize($v);
}
}
return $conf;
}
1;
__END__
|