Serializer.pm 4.24 KB
Newer Older
1 2
package Lemonldap::NG::Common::Conf::Serializer;

Yadd's avatar
Yadd committed
3 4
use strict;
use utf8;
Yadd's avatar
Yadd committed
5
use Encode;
Yadd's avatar
Yadd committed
6
use JSON::MaybeXS qw(JSON to_json from_json);
Yadd's avatar
Yadd committed
7
use Lemonldap::NG::Common::Conf::Constants;
8

Clément OUDOT's avatar
Clément OUDOT committed
9
our $VERSION = '1.9.0';
10

11
BEGIN {
12 13
    *Lemonldap::NG::Common::Conf::normalize   = \&normalize;
    *Lemonldap::NG::Common::Conf::unnormalize = \&unnormalize;
Yadd's avatar
Yadd committed
14
    *Lemonldap::NG::Common::Conf::serialize   = \&serialize;
15
    *Lemonldap::NG::Common::Conf::unserialize = \&unserialize;
Yadd's avatar
Yadd committed
16
    *Lemonldap::NG::Common::Conf::oldUnserialize = \&oldUnserialize;
17 18
}

19 20 21 22 23
## @method string normalize(string value)
# Change quotes, spaces and line breaks
# @param value Input value
# @return normalized string
sub normalize {
Yadd's avatar
Yadd committed
24
    my ( $self, $value ) = @_;
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

    # 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 {
Yadd's avatar
Yadd committed
47
    my ( $self, $value ) = @_;
48 49 50 51 52 53 54 55

    # 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;

Yadd's avatar
Yadd committed
56 57 58
    # Keep number as numbers
    $value += 0 if ( $value =~ /^(?:0|(?:\-[0-9]|[1-9])[0-9]*)(?:\.[0-9]+)?$/ );

59 60 61 62 63 64 65
    return $value;
}

## @method hashref serialize(hashref conf)
# Parse configuration and convert it into fields
# @param conf Configuration
# @return fields
66
sub serialize {
Yadd's avatar
Yadd committed
67
    my ( $self, $conf ) = @_;
68
    my $fields;
69 70

    # Parse configuration
71
    while ( my ( $k, $v ) = each(%$conf) ) {
72 73

        # 1.Hash ref
74
        if ( ref($v) ) {
75
            $fields->{$k} = JSON->encode($v);
76
        }
77
        else {
78
            $fields->{$k} = $v;
79 80
        }
    }
81

82 83 84
    return $fields;
}

85 86 87 88
## @method hashref unserialize(hashref fields)
# Convert fields into configuration
# @param fields Fields
# @return configuration
89
sub unserialize {
Yadd's avatar
Yadd committed
90
    my ( $self, $fields ) = @_;
91
    my $conf;
92

93
    # Parse fields
94 95
    foreach my $k (keys %$fields) {
        my $v = $fields->{$k};
96 97 98 99
        if ( $k =~ $hashParameters ) {
            unless ( utf8::is_utf8($v) ) {
                $v = encode( 'UTF-8', $v );
            }
Yadd's avatar
Yadd committed
100
            $conf->{$k} = ( $v =~ /./ ? eval { from_json($v) } : {} );
101 102
            if ($@) {
                $Lemonldap::NG::Common::Conf::msg .=
Yadd's avatar
Yadd committed
103
                  "Unable to decode $k, switching to old format.\n";
Yadd's avatar
Yadd committed
104
                return $self->oldUnserialize($fields);
105 106 107 108 109 110 111 112 113 114 115 116
            }
        }
        else {
            $conf->{$k} = $v;
        }
    }
}

sub oldUnserialize {
    my ( $self, $fields ) = @_;
    my $conf;

117
    # Parse fields
118
    while ( my ( $k, $v ) = each(%$fields) ) {
119 120

        # Remove surrounding quotes
121
        $v =~ s/^'(.*)'$/$1/s;
122 123

        # Manage hashes
Yadd's avatar
Yadd committed
124

Yadd's avatar
Yadd committed
125
        if ( $k =~ $hashParameters and $v ||= {} and not ref($v) ) {
126
            $conf->{$k} = {};
127 128

            # Value should be a Data::Dumper, else this is an old format
129
            if ( defined($v) and $v !~ /^\$/ ) {
130

Yadd's avatar
Yadd committed
131
                $Lemonldap::NG::Common::Conf::msg .=
132 133
" Warning: configuration is in old format, you've to migrate!";

134 135
                eval { require Storable; require MIME::Base64; };
                if ($@) {
Yadd's avatar
Yadd committed
136
                    $Lemonldap::NG::Common::Conf::msg .= " Error: $@";
137 138 139 140
                    return 0;
                }
                $conf->{$k} = Storable::thaw( MIME::Base64::decode_base64($v) );
            }
141 142

            # Convert Data::Dumper
143 144 145
            else {
                my $data;
                $v =~ s/^\$([_a-zA-Z][_a-zA-Z0-9]*) *=/\$data =/;
146 147 148
                $v = $self->unnormalize($v);

                # Evaluate expression
149
                eval $v;
150 151

                if ($@) {
Yadd's avatar
Yadd committed
152 153
                    $Lemonldap::NG::Common::Conf::msg .=
                      " Error: cannot read configuration key $k: $@";
154 155 156
                }

                # Store value in configuration object
157 158 159
                $conf->{$k} = $data;
            }
        }
160 161

        # Other fields type
162
        else {
163
            $conf->{$k} = $self->unnormalize($v);
164 165
        }
    }
166

167 168 169 170 171
    return $conf;
}

1;
__END__