use strict;
our $VERSION = '1.2.9';
our @ISA = qw(Apache::Session);
sub populate {
my $self = shift;
$self->{object_store} =
new Apache::Session::Browseable::Store::Postgres $self;
$self->{lock_manager} = new Apache::Session::Lock::Null $self;
$self->{generate} = \&Apache::Session::Generate::SHA256::generate;
$self->{validate} = \&Apache::Session::Generate::SHA256::validate;
$self->{serialize} = \&Apache::Session::Serialize::JSON::serialize;
$self->{unserialize} = \&Apache::Session::Serialize::JSON::unserialize;
return $self;
}
sub searchOn {
my ( $class, $args, $selectField, $value, @fields ) = @_;
$selectField =~ s/'/''/g;
my $query =
{ query => "a_session ->> '$selectField' =?", values => [$value] };
return $class->_query( $args, $query, @fields );
}
sub searchOnExpr {
my ( $class, $args, $selectField, $value, @fields ) = @_;
$selectField =~ s/'/''/g;
$value =~ s/\*/%/g;
my $query =
{ query => "a_session ->> '$selectField' like ?", values => [$value] };
return $class->_query( $args, $query, @fields );
}
sub _query {
my ( $class, $args, $query, @fields ) = @_;
my %res = ();
my $dbh = $class->_classDbh($args);
my $table_name = $args->{TableName}
|| $Apache::Session::Store::DBI::TableName;
my $sth;
my $fields =
@fields
? join( ',', 'id', map { s/'//g; "a_session ->> '$_' AS $_" } @fields )
: '*';
$sth =
$dbh->prepare("SELECT $fields from $table_name where $query->{query}");
$sth->execute( @{ $query->{values} } );
# In this case, PostgreSQL change field name in lowercase
my $res = $sth->fetchall_hashref('id') or return {};
if (@fields) {
foreach (@fields) {
if ( $_ ne lc($_) ) {
foreach my $s ( keys %$res ) {
$res->{$s}->{$_} = delete $res->{$s}->{ lc $_ };
}
}
}
}
else {
my $self = eval "&${class}::populate();";
my $sub = $self->{unserialize};
foreach my $s ( keys %$res ) {
my $tmp = &$sub( { serialized => $res->{$s}->{a_session} } );
$res->{$s} = $tmp;
}
}
return $res;
}
sub deleteIfLowerThan {
my ( $class, $args, $rule ) = @_;
my $query;
if ( $rule->{or} ) {
$query = join ' OR ',
map { "cast(a_session ->> '$_' as bigint) < $rule->{or}->{$_}" } keys %{ $rule->{or} };
}
elsif ( $rule->{and} ) {
$query = join ' AND ',
map { "cast(a_session ->> '$_' as bigint) < $rule->{or}->{$_}" } keys %{ $rule->{or} };
}
if ( $rule->{not} ) {
$query = "($query) AND "
. join( ' AND ',
map { "a_session ->> '$_' <> '$rule->{not}->{$_}'" } keys %{ $rule->{not} } );
}
return 0 unless ($query);
my $dbh = $class->_classDbh($args);
my $table_name = $args->{TableName}
|| $Apache::Session::Store::DBI::TableName;
my $sth = $dbh->do("DELETE FROM $table_name WHERE $query");
return 1;
}
sub get_key_from_all_sessions {
my ( $class, $args, $data ) = @_;
my $table_name = $args->{TableName}
|| $Apache::Session::Store::DBI::TableName;
my $dbh = $class->_classDbh($args);
my $sth;
# Special case if all wanted fields are indexed
if ( $data and ref($data) ne 'CODE' ) {
$data = [$data] unless ( ref($data) );
my $fields = join ',', map { s/'//g; "a_session ->> '$_' AS $_" } @$data;
$sth = $dbh->prepare("SELECT $fields from $table_name");
$sth->execute;
return $sth->fetchall_hashref('id');
}
$sth = $dbh->prepare_cached("SELECT id,a_session from $table_name");
$sth->execute;
my %res;
while ( my @row = $sth->fetchrow_array ) {
no strict 'refs';
my $self = eval "&${class}::populate();";
my $sub = $self->{unserialize};
my $tmp = &$sub( { serialized => $row[1] } );
if ( ref($data) eq 'CODE' ) {
$tmp = &$data( $tmp, $row[0] );
$res{ $row[0] } = $tmp if ( defined($tmp) );
}
elsif ($data) {
$data = [$data] unless ( ref($data) );
$res{ $row[0] }->{$_} = $tmp->{$_} foreach (@$data);
}
else {
$res{ $row[0] } = $tmp;
}
}
return \%res;
}
sub _classDbh {
my ( $class, $args ) = @_;
my $datasource = $args->{DataSource} or die "No datasource given !";
my $username = $args->{UserName};
my $password = $args->{Password};
my $dbh =
DBI->connect_cached( $datasource, $username, $password,
{ RaiseError => 1, AutoCommit => 1 } )
|| die $DBI::errstr;
$dbh->{pg_enable_utf8} = 1;
return $dbh;
}
1;
__END__
=head1 NAME
Apache::Session::Browseable::PgJSON - Hstore type support for
L<Apache::Session::Browseable::Postgres>
=head1 SYNOPSIS
Create table:
CREATE UNLOGGED TABLE sessions (
id varchar(64) not null primary key,
a_session jsonb,
);
Optionally, add indexes on some fields. Example for Lemonldap::NG:
CREATE INDEX uid1 ON sessions USING BTREE ( (a_session ->> '_whatToTrace') );
CREATE INDEX s1 ON sessions ( (a_session ->> '_session_kind') );
CREATE INDEX u1 ON sessions ( ( cast(a_session ->> '_utime' AS bigint) ) );
CREATE INDEX ip1 ON sessions USING BTREE ( (a_session ->> 'ipAddr') );
Use it like L<Apache::Session::Browseable::Postgres> except that you don't
need to declare indexes
=head1 DESCRIPTION
Apache::Session::Browseable provides some class methods to manipulate all
sessions and add the capability to index some fields to make research faster.
Apache::Session::Browseable::PgJSON implements it for PosqtgreSQL databases
using "json" or "jsonb" type to be able to browse sessions.
=head1 SEE ALSO
L<http://lemonldap-ng.org>, L<Apache::Session::Postgres>
=head1 AUTHOR
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
=head1 COPYRIGHT AND LICENSE
=encoding utf8
Copyright (C) 2009-2017 by Xavier Guimard
2013-2017 by Clément Oudot
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.1 or,
at your option, any later version of Perl 5 you may have available.
=cut