[interchange-cvs] interchange - ramoore modified code/UI_Tag/dump_session.coretag
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Tue Dec 24 09:47:00 2002
User: ramoore
Date: 2002-12-24 14:46:47 GMT
Modified: code/UI_Tag dump_session.coretag
Log:
Added ability to dump sessions stored in DBI to UI.
Revision Changes Path
1.4 +90 -31 interchange/code/UI_Tag/dump_session.coretag
rev 1.4, prev_rev 1.3
Index: dump_session.coretag
===================================================================
RCS file: /var/cvs/interchange/code/UI_Tag/dump_session.coretag,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- dump_session.coretag 27 Sep 2002 06:58:19 -0000 1.3
+++ dump_session.coretag 24 Dec 2002 14:46:47 -0000 1.4
@@ -5,38 +5,97 @@
my ($name, $opt) = @_;
my $joiner = $opt->{joiner} || ' ';
return "Cannot dump or find sessions with session type $Vend::Cfg->{SessionType}."
- if $Vend::Cfg->{SessionType} ne 'File';
- if($opt->{find}) {
- require File::Find;
- my $expire = $Vend::Cfg->{SessionExpire};
- if( int($::Variable->{ACTIVE_SESSION_MINUTES}) ) {
- $expire = $::Variable->{ACTIVE_SESSION_MINUTES} * 60;
- }
- my $now = time();
- $expire = $now - $expire;
- my @files;
- my $wanted = sub {
- return unless -f $_;
- return if (stat(_))[9] < $expire;
- return if /\.lock$/;
- push @files, $_;
- };
- File::Find::find($wanted, $Vend::Cfg->{SessionDatabase});
- return join $joiner, @files;
- }
- elsif (! $name) {
- return "dump-session: Nothing to do.";
+ if ($Vend::Cfg->{SessionType} ne 'File' && $Vend::Cfg->{SessionType} ne 'DBI');
+
+
+ if ($Vend::Cfg->{SessionType} eq 'File') {
+ if($opt->{find}) {
+ require File::Find;
+ my $expire = $Vend::Cfg->{SessionExpire};
+ if( int($::Variable->{ACTIVE_SESSION_MINUTES}) ) {
+ $expire = $::Variable->{ACTIVE_SESSION_MINUTES} * 60;
+ }
+ my $now = time();
+ $expire = $now - $expire;
+ my @files;
+ my $wanted = sub {
+ return unless -f $_;
+ return if (stat(_))[9] < $expire;
+ return if /\.lock$/;
+ push @files, $_;
+ };
+ File::Find::find($wanted, $Vend::Cfg->{SessionDatabase});
+ return join $joiner, @files;
+ }
+ elsif (! $name) {
+ return "dump-session: Nothing to do.";
+ }
+ else {
+ my $fn = Vend::Util::get_filename($name, 2, 1, $Vend::Cfg->{SessionDatabase});
+ return '' unless -f $fn;
+ my $ref = Vend::Util::eval_file($fn);
+ my $out = '';
+ eval {
+ $out = Vend::Util::uneval($ref);
+ };
+ return uneval($ref) if $@;
+ return $out;
+ }
}
- else {
- my $fn = Vend::Util::get_filename($name, 2, 1, $Vend::Cfg->{SessionDatabase});
- return '' unless -f $fn;
- my $ref = Vend::Util::eval_file($fn);
- my $out = '';
- eval {
- $out = Vend::Util::uneval($ref);
- };
- return uneval($ref) if $@;
- return $out;
+
+ if ($Vend::Cfg->{SessionType} eq 'DBI') {
+ if($opt->{find}) {
+ my $expire = $Vend::Cfg->{SessionExpire};
+ if( int($::Variable->{ACTIVE_SESSION_MINUTES}) ) {
+ $expire = $::Variable->{ACTIVE_SESSION_MINUTES} * 60;
+ }
+ my $now = time();
+ $expire = $now - $expire;
+ my @sesscodes;
+
+ my $db = Vend::Data::database_exists_ref($Vend::Cfg->{SessionDB})
+ or return errmsg("Table %s is not available", $Vend::Cfg->{SessionDB});
+ my $dbh = $db->dbh();
+ my $tname = $db->name();
+ my $sql = "select code from $tname where UNIX_TIMESTAMP(last_accessed) >= ?";
+
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($expire) || return $DBI::errstr;
+ my $code;
+ $sth->bind_columns( undef, \$code);
+
+ while($sth->fetch) {
+ push @sesscodes, $code;
+ }
+ $sth->finish;
+ return join $joiner, @sesscodes;
+ }
+ elsif (! $name) {
+ return "dump-session: Nothing to do.";
+ }
+ else {
+ my $db = Vend::Data::database_exists_ref($Vend::Cfg->{SessionDB})
+ or return errmsg("Table %s is not available", $Vend::Cfg->{SessionDB});
+ my $dbh = $db->dbh();
+ my $tname = $db->name();
+ my $sql = "select session from $tname where code=?";
+
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($name);
+ my $session;
+ $sth->bind_columns( undef, \$session);
+ $sth->fetch;
+ $sth->finish;
+
+ my $out = '';
+ my $ref = Vend::Util::evalr($session);
+ eval {
+ $out = Vend::Util::uneval($ref);
+ };
+ return uneval($ref) if $@;
+ return $out;
+ }
}
+
}
EOR