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
|
package Apache::Session::Store::MongoDB;
use 5.010;
use strict;
our $VERSION = '0.21';
use MongoDB;
our $default = {
host => 'localhost:27017',
db_name => 'sessions',
collection => 'sessions',
};
sub new {
my $class = shift;
return bless {}, $class;
}
sub connection {
my ( $self, $session ) = splice @_;
return
if ( defined $self->{collection} );
my $conn_args;
foreach my $w (
qw(host auth_mechanism auth_mechanism_properties bson_codec
connect_timeout_ms db_name heartbeat_frequency_ms j local_threshold_ms
max_time_ms password port read_pref_mode read_pref_tag_sets
replica_set_name server_selection_timeout_ms server_selection_try_once
socket_check_interval_ms socket_timeout_ms ssl username w wtimeout
read_concern_level)
)
{
$conn_args->{$w} = $session->{args}->{$w} || $default->{$w};
delete $conn_args->{$w} unless ( defined $conn_args->{$w} );
}
my $s =
MongoDB->connect( $session->{args}->{host} || $default->{host},
$conn_args )
or die('Unable to connect to MongoDB server');
$self->{collection} =
$s->get_database( $session->{args}->{db_name} || $default->{db_name} )
->get_collection( $session->{args}->{collection}
|| $default->{collection} );
}
sub insert {
my ( $self, $session ) = splice @_;
$self->connection($session);
die('no id') unless ( $session->{data}->{_session_id} );
$session->{data}->{_id} = $session->{data}->{_session_id};
$self->{collection}->insert_one( $session->{data} );
}
sub update {
my ( $self, $session ) = splice @_;
$self->remove($session);
$self->insert($session);
}
sub materialize {
my ( $self, $session ) = splice @_;
$self->connection($session);
$session->{data} = $self->{collection}
->find_one( { _id => $session->{data}->{_session_id} } );
if ( $session->{data}->{_session_id} ) {
$session->{data}->{_session_id} = $session->{data}->{_id};
}
else {
die "Object does not exist in data store";
}
}
sub remove {
my ( $self, $session ) = splice @_;
$self->connection($session);
$self->{collection}->delete_one( { _id => $session->{data}->{_session_id} } );
}
sub DESTROY {
my $self = shift;
$self->{collection} = undef;
}
1;
__END__
=head1 NAME
Apache::Session::MongoDB - An implementation of Apache::Session
=head1 SYNOPSIS
use Apache::Session::MondoDB;
# Using localhost server
tie %hash, 'Apache::Session::MongoDB', $id, {};
# Example with default values
tie %hash, 'Apache::Session::MongoDB', $id, {
host => 'locahost:27017',
db_name => 'sessions',
collection => 'sessions',
};
=head1 DESCRIPTION
This module is an implementation of Apache::Session. It uses the MongoDB
backing store and no locking.
=head1 SEE ALSO
L<Apache::Session::MongoDB>, L<Apache::Session>
=head1 AUTHOR
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2015-2016 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
=cut
|
