kivitendo/SL/Auth/SessionValue.pm @ 912e5eff
| e0ba33ff | Moritz Bunkus | package SL::Auth::SessionValue;
|
||
use strict;
|
||||
| e50a9622 | Moritz Bunkus | # Classes that overload stringification must be known before
|
||
# YAML::Load() is called.
|
||||
use SL::Locale::String ();
|
||||
| e0ba33ff | Moritz Bunkus | use Scalar::Util qw(weaken);
|
||
use SL::DBUtils;
|
||||
| 65b2387a | Moritz Bunkus | use SL::YAML;
|
||
| e0ba33ff | Moritz Bunkus | |||
sub new {
|
||||
my ($class, %params) = @_;
|
||||
my $self = bless {}, $class;
|
||||
| 9b294bec | Sven Schöling | map { $self->{$_} = $params{$_} } qw(auth key value auto_restore modified);
|
||
| e0ba33ff | Moritz Bunkus | |||
$self->{fetched} = exists $params{value};
|
||||
$self->{parsed} = !$params{raw} && exists $params{value};
|
||||
# delete $self->{auth};
|
||||
# $::lxdebug->dump(0, "NEW", $self);
|
||||
# $self->{auth} = $params{auth};
|
||||
weaken $self->{auth};
|
||||
return $self;
|
||||
}
|
||||
sub get {
|
||||
my ($self) = @_;
|
||||
return $self->_fetch->_parse->{value};
|
||||
}
|
||||
sub get_dumped {
|
||||
my ($self) = @_;
|
||||
| 5fed92b8 | Sven Schöling | no warnings 'once';
|
||
| e50a9622 | Moritz Bunkus | local $YAML::Stringify = 1;
|
||
| 65b2387a | Moritz Bunkus | return SL::YAML::Dump($self->get);
|
||
| e0ba33ff | Moritz Bunkus | }
|
||
sub _fetch {
|
||||
my ($self) = @_;
|
||||
return $self if $self->{fetched};
|
||||
| caa629de | Moritz Bunkus | return $self if !$self->{auth}->session_tables_present;
|
||
| e0ba33ff | Moritz Bunkus | |||
my $dbh = $self->{auth}->dbconnect;
|
||||
my $query = qq|SELECT sess_value FROM auth.session_content WHERE (session_id = ?) AND (sess_key = ?)|;
|
||||
($self->{value}) = selectfirst_array_query($::form, $dbh, $query, $self->{auth}->get_session_id, $self->{key});
|
||||
$self->{fetched} = 1;
|
||||
return $self;
|
||||
}
|
||||
sub _parse {
|
||||
my ($self) = @_;
|
||||
| 65b2387a | Moritz Bunkus | $self->{value} = SL::YAML::Load($self->{value}) unless $self->{parsed};
|
||
| e0ba33ff | Moritz Bunkus | $self->{parsed} = 1;
|
||
return $self;
|
||||
}
|
||||
sub _load_value {
|
||||
my ($self, $value) = @_;
|
||||
return { simple => 1, data => $value } if $value !~ m/^---/;
|
||||
my %params = ( simple => 1 );
|
||||
eval {
|
||||
| 65b2387a | Moritz Bunkus | my $data = SL::YAML::Load($value);
|
||
| e0ba33ff | Moritz Bunkus | |||
if (ref $data eq 'HASH') {
|
||||
map { $params{$_} = $data->{$_} } keys %{ $data };
|
||||
$params{simple} = 0;
|
||||
} else {
|
||||
$params{data} = $data;
|
||||
}
|
||||
1;
|
||||
} or $params{data} = $value;
|
||||
return \%params;
|
||||
}
|
||||
1;
|