lib/CXGN/Page/Session.pm

   1 package CXGN::Page::Session;
   2 use strict;
   3 use warnings;
   4 no strict 'refs';
   5 use Carp;
   6
   7 use CXGN::Cookie;
   8 use CXGN::Login;
   9 use CXGN::DB::Connection;
  10 use URI::Escape qw/uri_escape uri_unescape/;
  11
  12 use base qw | CXGN::DB::Object |;
  13
  14 #Re-define these in your subclass:
  15 our @VALID_KEYS = ();
  16 our $COOKIE_NAME = "";
  17 our $DB_SCHEMA = "";
  18 our $DB_TABLE = "";
  19 our $DB_COLUMN = ""; #name of settings-containing column
  20 our $ID_COLUMN = ""; #name of column to match against ID
  21 our $ID = "";  #i.e:  $ID = CXGN::Login->new()->has_login();
  22 #our $DBH;
  23 #our $EXCHANGE_DBH;
  24
  25 =head1 Instance Methods
  26
  27 =head2 new([$dbh])
  28
  29  Constructor takes optional database handle, determines settings
  30  based on the following order of precedence:
  31
  32  1) Local VHost Config, overrides everything
  33  2) Cookie
  34  3) Database, 'developer_settings' in logged-in sp_person
  35
  36  Settings are not taken in whole from any one source.  A setting
  37  key from the database that doesn't exist in the cookie or VHost
  38  config will not be clobbered
  39
  40  Settings are then saved to the database and the cookie is set.
  41  Therefore the constructor and save() MUST be called BEFORE
  42  headers on a page are sent.
  43
  44 =cut
  45
  46 sub new {
  47         my $class = shift; #this should be your subclass classname
  48         my $dbh = shift or croak "must pass a dbh as second argument";
  49         my $self = $class->SUPER::new($dbh);
  50         $self->{settings} = {};
  51
  52         #Grab SubClass Package Variables
  53         #It is important to set $self->{globals}->{lc(PKG_VAR)} = $val
  54         #for the benefit of other functions, since the eval{} statements
  55         #are a pain to do twice
  56         my %valid_keys = ();
  57         my @vk = @{$class."::VALID_KEYS"};
  58         $valid_keys{$_} = 1 foreach @vk;
  59         $self->{globals}->{valid_keys} = \@vk;
  60         foreach my $var (qw/id id_column cookie_name db_table db_column db_schema/){ #scalars only
  61                 $self->{globals}->{$var} = ${$class."::".uc($var)};
  62         }
  63         my $id = $self->{globals}->{id};
  64
  65         unless($id) {
  66                 eval {
  67                         $id = CXGN::Login->new($self->get_dbh())->has_session();
  68                 };
  69         }
  70         #If ID for database is set, collect settings
  71         if($id) {
  72             #my $dbh = __PACKAGE__->DBH();
  73         #       $self->{dbh} = $dbh;
  74                 my $sth = $self->get_dbh()->prepare(
  75                         "       SELECT $self->{globals}->{db_column}
  76                                 FROM $self->{globals}->{db_schema}.$self->{globals}->{db_table}
  77                                 WHERE $self->{globals}->{id_column}=?");
  78                 $sth->execute($id);
  79                 if (my $row = $sth->fetchrow_hashref) {
  80                         $self->parse_settings_string($row->{$self->{globals}->{db_column}});
  81                 }
  82         }
  83
  84         #Stuff in your cookie will overwrite whatever is in the database
  85         my $cookie_string = CXGN::Cookie::get_cookie($self->{globals}->{cookie_name});
  86         if($cookie_string){
  87                 my $cookie_based = {};
  88                 parse_settings_string($cookie_based, $cookie_string, {validate=>0});
  89                 my ($ts) = $cookie_based->{setting}->{timestamp};
  90                 my $db_ts = $self->get_setting('timestamp');
  91                 if(($db_ts && $ts && $ts > $db_ts) || (!$db_ts) || (!$ts)){
  92                         $self->parse_settings_string($cookie_string);
  93                 }
  94                 else {
  95                     $self->d( "Time lag:\nCookie:  $ts\nDB:      $db_ts\n");
  96                 }
  97         }
  98         $self->save();
  99         return $self;
 100 }
 101
 102 sub parse_settings_string {
 103         my $self = shift;
 104         my $cookie_string = shift;
 105         my $args = shift;
 106         my %valid_keys = ();
 107         foreach(@{$self->{globals}->{valid_keys}}){
 108                 $valid_keys{$_} = 1;
 109         }
 110         $cookie_string = uri_unescape($cookie_string);
 111         my @kvs = split /:/, $cookie_string;
 112         foreach my $kv (@kvs) {
 113                 my ($k, $v) = split /=/, $kv;
 114                 $k = uri_unescape($k);
 115                 $v = uri_unescape($v);
 116                 next if $k eq "null"; #javascript cookie-setter does weird things sometimes
 117
 118                 unless(!$args->{validate} || $valid_keys{$k}){
 119                         die "$k is not a valid key, according to " . __PACKAGE__  . "\n" . $cookie_string . "\n";
 120                 }
 121                 $self->{settings}->{$k} = $v;
 122         }
 123 }
 124
 125 =head2 alter_setting($key,$value)
 126
 127  Given a key, sets the value for a developer setting.  Since key/values are uri-encoded,
 128  you can specify any kind of key or value that you want.
 129
 130 =cut
 131
 132 sub alter_setting {
 133         my $self = shift;
 134         my ($k, $v) = @_;
 135         $self->{settings}->{$k} = $v;
 136 }
 137
 138 =head2 get_setting($key)
 139
 140  Gets the value of the setting key from this object
 141
 142 =cut
 143
 144 sub get_setting {
 145         my $self = shift;
 146         my $key = shift;
 147         return $self->{settings}->{$key};
 148 }
 149
 150 sub delete_setting {
 151         my $self = shift;
 152         my $key = shift;
 153         delete($self->{settings}->{$key});
 154 }
 155
 156 =head2 save
 157
 158  Takes $this->{settings}, does uri-escaping, sets the cookie
 159  and the value in the database for $this->{sp_person_id}
 160
 161 =cut
 162
 163 sub save {
 164         my $self = shift;
 165         $self->alter_setting('timestamp', time()*1000);
 166         my @kvs = ();
 167         my $cookie_string = "";
 168         while(my($k,$v) = each %{$self->{settings}}){
 169                 $k = uri_escape($k);
 170                 $v = uri_escape($v);
 171                 push(@kvs, $k . '=' . $v);
 172         }
 173         $cookie_string = join ":", @kvs;
 174         $cookie_string = uri_escape($cookie_string);
 175         CXGN::Cookie::set_cookie($self->{globals}->{cookie_name}, $cookie_string);
 176         if($self->{dbh}){
 177                 my ($s, $t, $c, $id_c, $id) = map { $self->{globals}->{$_} } qw/ db_schema db_table db_column id_column id / ;
 178
 179                 my $sth = $self->{dbh}->prepare("UPDATE $s.$t SET $c=? WHERE $id_c=?");
 180                 $sth->execute($cookie_string, $id);
 181         }
 182 }
 183
 184 sub store { save(@_) } #alias
 185
 186 sub validate_key {
 187         my $class = shift;
 188         my $key = shift;
 189         my @vk = ();
 190         eval '@vk = @' . $class . '::VALID_KEYS';
 191         my %vk = ();
 192         $vk{$_} = 1 foreach @vk;
 193
 194         die "Key '$key' not registered with Session Module '$class' (not in its VALID_KEYS array)\n"
 195                 unless $vk{$key};
 196 }
 197
 198 1;