PApp::Log - analyze and expire the state/user databases

 use PApp::Log;

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################

package PApp::Log;

use Compress::LZF;

use PApp::Storable;
use PApp::SQL;
use PApp::Config;
use PApp::Env;

use base Exporter;

$VERSION = 1.45;
@EXPORT = qw();

sub PAPP_LASTLOG (){ "PAPP_LASTLOG" }

my @cb_user;
my @cb_state;

sub for_user (&) {
   my $cb = shift;
   push @cb_user, $cb;
   warn "user loging has not been implemented yet!";
}

sub for_state (&;@) {
   my ($cb, %arg) = @_;
   push @cb_state, [$arg{app}, $arg{location}, $arg{module}, $cb];
}

my %pmod;

sub find_pmod($) {
   my $mntid = shift;
   unless ($pmod{$mntid}) {
      sql_fetch PApp::Config::DBH,
                \my($location, $appid, $config),
                "select location, appid, config from mount where id = ?",
                $mntid;

      sql_fetch PApp::Config::DBH,
                \my($app),
                "select app from app where id = ?",
                $appid;

      $pmod{$mntid}           = $app ? PApp::Storable::thaw decompress $app : die;
      $pmod{$mntid}{location} = $location;
      #FIXME# $config?
   }
   $pmod{$mntid};
}

# decode a state entry (id, unix_timestamp(ctime), previd, userid, state)
# into the meta and state hashes.
sub decode_state {
   my $row = shift;
   my $state = PApp::Storable::thaw decompress $row->[4];
   my $pmod = find_pmod $state->{papp_mntid};
   my %meta = (
         id       => $row->[0],
         ctime    => $row->[1],
         previd   => $row->[2],
         userid   => $row->[3],
         pmod     => $pmod,
         location => $pmod->{location},
   );
   (\%meta, $state);
}

sub expire_db {
   my %arg = @_;
   my $now = time - 1;
   my $keepuser    = $now - ($arg{keepuser}    || 86400* 60);
   my $keepreguser = $now - ($arg{keepreguser} || 86400*365);
   my $keepstate   = $now - ($arg{keepstate}   || 86400* 14);

   local $DBH = PApp::Config::DBH;

   log_state($keepstate);

# update last seen marker.
{
  my $st = sql_exec \my($uid, $ctime), "select userid, unix_timestamp(max(ctime)) from state group by userid";
  while($st->fetch) {
       sql_exec "replace into prefs (uid, path, name, value) values (?, '', 'papp_lastvisit', ?)", $uid, $ctime;
  }
}
#blow away old states (sessions in fact)
{
  my @delstates = sql_fetchall "select sessid from state group by sessid having max(ctime) < from_unixtime(?)", $keepstate;
  scalar @delstates && sql_exec "delete from state where sessid in (".join( ",", @delstates).")";
}
#expire users...
$st = sql_exec \my($uid, $visited, $known), "select uid, value,max(grpid) from prefs left join usergrp on (uid=userid) where path='' and name='papp_lastvisit' group by uid";
while($st->fetch) {
   $known ||= 0;
   next if $visited >= ($known ? $keepreguser : $keepuser);
   sql_exec "delete from prefs where uid = ?", $uid;
   sql_exec "delete from usergrp where userid = ?", $uid if $known;
}
   
}

sub log_state {
   my %arg = @_;
   my $now = time - 1;
   my $lastlog = getenv PAPP_LOG_STATE || 0;

   local $DBH = PApp::Config::DBH;
   return; #NYI

   # TODO: state loggin, NO user logging

   my $st = sql_exec "select id, unix_timestamp(ctime), previd, userid, state from state
                                            where ctime > from_unixtime(?) and ctime <= from_unixtime(?)",
                     $lastlog, $upto;

   my ($app, $loc, $mod);
   
   # compile the decision logic
   my $dec = <<'EOF';
      sub {
         while (my $row = $st->fetchrow_arrayref) {
            my ($meta, $state) = decode_state ($row);
            $app = $meta->{pmod}{name};
            $loc = $meta->{location};
            $mod = $state->{papp_module};
EOF

   for (0..$#cb_state) {
      my $cb = $cb_state[$_];
      my @tst;
      push @tst, "\$app eq \"".quotemeta($cb->[0])."\"" if defined $cb->[0];
      push @tst, "\$loc eq \"".quotemeta($cb->[1])."\"" if defined $cb->[1];
      push @tst, "\$mod eq \"".quotemeta($cb->[2])."\"" if defined $cb->[2];

      $dec .= "\$cb_state[$_][3](\$meta, \$state)";
      $dec .= " if ".join(" && ", @tst) if @tst;
      $dec .= ";\n";

   }

   $dec .= <<'EOF';
         }
      }
EOF

   $dec = eval $dec;
   die if $@;
   $dec->();
   $st->finish;

   setenv PAPP_LASTLOG, $upto;
}

1;