File: Hstore.pm

package info (click to toggle)
libapache-session-browseable-perl 1.3.11-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 332 kB
  • sloc: perl: 1,716; makefile: 2
file content (127 lines) | stat: -rw-r--r-- 3,040 bytes parent folder | download | duplicates (3)
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
package Apache::Session::Serialize::Hstore;

use strict;
use JSON qw(to_json from_json);

our $VERSION = '1.2.5';

sub serialize {
    my ($session) = @_;
    $session->{serialized} = {};
    my $data = $session->{data};
    my $res  = '';
    if ( ref $data and %$data ) {
        foreach ( keys %$data ) {
            my $v;
            if ( ref $data->{$_} ) {
                $v = '_json://' . to_json( $data->{$_} );
            }
            else {
                $v = $data->{$_};
            }
            $v =~ s/"/#%22/g;
            $res .= qq'"$_" => "$v",';
        }
    }
    $res =~ s/,$//;
    $session->{serialized} = $res;
}

sub unserialize {
    my ($session) = @_;

    my $data = _unserialize( $session->{serialized} );
    die "Session could not be unserialized" unless defined $data;
    $session->{data} = $data;
}

sub _unserialize {
    my ( $serialized, $next ) = @_;
    my $res = {};
    while ( $serialized =~ s/\s*"([^"]*)"\s*=>\s*"([^"]*)"\s*,?// ) {
        my ( $k, $v ) = ( $1, $2 );
        $v =~ s/#%22/"/g;
        if ( $v =~ s#^_json://## ) {
            my $tmp;
            eval { $tmp = from_json($v) };
            if ($@) {
                print STDERR "JSON error: $@\n";
                return undef;
            }
            $v = $tmp;
        }
        $res->{$k} = $v;
    }
    return $res;
}

1;

=pod

=head1 NAME

=encoding utf8

Apache::Session::Serialize::Hstore - Serialize/unserialize datas for PostgreSQL
"hstore" storage.

=head1 SYNOPSIS

 use Apache::Session::Serialize::Hstore;

 $zipped = Apache::Session::Serialize::Hstore::serialize($ref);
 $ref = Apache::Session::Serialize::Hstore::unserialize($zipped);

=head1 DESCRIPTION

This module fulfills the serialization interface of Apache::Session.
It serializes only ref data value for PostgreSQL "hstore" fields.

=head1 SEE ALSO

L<JSON>, L<Apache::Session>

=head1 AUTHORS

=over

=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>

=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>

=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=item Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt>

=back

=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
L<http://jira.ow2.org>

=head1 COPYRIGHT AND LICENSE

=over

=item Copyright (C) 2015-2017 by Clément Oudot, E<lt>clem.oudot@gmail.comE<gt>

=item Copyright (C) 2015-2017 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=back

This library 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, 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, see L<http://www.gnu.org/licenses/>.

=cut