SL/Auth/SessionValue.pm

   1 package SL::Auth::SessionValue;
   2
   3 use strict;
   4
   5 # Classes that overload stringification must be known before
   6 # YAML::Load() is called.
   7 use SL::Locale::String ();
   8
   9 use Scalar::Util qw(weaken);
  10
  11 use SL::DBUtils;
  12 use SL::YAML;
  13
  14 sub new {
  15   my ($class, %params) = @_;
  16
  17   my $self = bless {}, $class;
  18
  19   map { $self->{$_} = $params{$_} } qw(auth key value auto_restore modified);
  20
  21   $self->{fetched} =                  exists $params{value};
  22   $self->{parsed}  = !$params{raw} && exists $params{value};
  23
  24   # delete $self->{auth};
  25   # $::lxdebug->dump(0, "NEW", $self);
  26   # $self->{auth} = $params{auth};
  27
  28   weaken $self->{auth};
  29
  30   return $self;
  31 }
  32
  33 sub get {
  34   my ($self) = @_;
  35   return $self->_fetch->_parse->{value};
  36 }
  37
  38 sub get_dumped {
  39   my ($self) = @_;
  40   no warnings 'once';
  41   local $YAML::Stringify = 1;
  42   return SL::YAML::Dump($self->get);
  43 }
  44
  45 sub _fetch {
  46   my ($self) = @_;
  47
  48   return $self if $self->{fetched};
  49   return $self if !$self->{auth}->session_tables_present;
  50
  51   my $dbh          = $self->{auth}->dbconnect;
  52   my $query        = qq|SELECT sess_value FROM auth.session_content WHERE (session_id = ?) AND (sess_key = ?)|;
  53   ($self->{value}) = selectfirst_array_query($::form, $dbh, $query, $self->{auth}->get_session_id, $self->{key});
  54   $self->{fetched} = 1;
  55
  56   return $self;
  57 }
  58
  59 sub _parse {
  60   my ($self) = @_;
  61
  62   $self->{value}  = SL::YAML::Load($self->{value}) unless $self->{parsed};
  63   $self->{parsed} = 1;
  64
  65   return $self;
  66 }
  67
  68 sub _load_value {
  69   my ($self, $value) = @_;
  70
  71   return { simple => 1, data => $value } if $value !~ m/^---/;
  72
  73   my %params = ( simple => 1 );
  74   eval {
  75     my $data = SL::YAML::Load($value);
  76
  77     if (ref $data eq 'HASH') {
  78       map { $params{$_} = $data->{$_} } keys %{ $data };
  79       $params{simple} = 0;
  80
  81     } else {
  82       $params{data}   = $data;
  83     }
  84
  85     1;
  86   } or $params{data} = $value;
  87
  88   return \%params;
  89 }
  90
  91 1;