view release on metacpan or  search on metacpan

lib/Bot/Cobalt/Plugin/Seen.pm  view on Meta::CPAN

## FIXME method to retrieve users w/ similar hosts
## !seen search ... ?

sub retrieve {
  my ($self, $context, $nickname) = @_;
  $nickname = _parse_nick($context, $nickname);

  my $ref = $self->[BUF]->{$context}->{$nickname}; # intentional autoviv
  unless (defined $ref) {
    my $db = $self->[SDB];
    unless ($db->dbopen) {
      logger->warn("dbopen failed in retrieve; cannot open SeenDB");
      return
    }
    my $thiskey = $context .'%'. $nickname;
    $ref = $db->get($thiskey);
    $db->dbclose;
  }

  ref $ref ? $ref : ()
}

sub Cobalt_register {
  my ($self, $core) = splice @_, 0, 2;
    
  my $pcfg = $core->get_plugin_cfg($self);
  my $seendb_path = path(
    $core->var .'/'. ($pcfg->{SeenDB} || "seen.db")
  );
  
  logger->info("Opening SeenDB at $seendb_path");

  $self->[BUF] = +{};
  $self->[SDB] = Bot::Cobalt::DB->new(file => $seendb_path);
  
  my $rc = $self->[SDB]->dbopen;
  $self->[SDB]->dbclose;
  unless ($rc) {
    logger->warn("Failed to open SeenDB at $seendb_path");
    die "Unable to open SeenDB at $seendb_path"
  }

  register( $self, 'SERVER', 
    qw/
    
      public_cmd_seen
      
      nick_changed      
      chan_sync
      user_joined
      user_left
      user_quit
      
      seendb_update
      
      seenplug_deferred_list
      
    /,
  );
  
  core->timer_set( 6, 
    +{ Event => 'seendb_update' },
    'SEENDB_WRITE'
  );
  
  logger->info("Loaded");
  
  PLUGIN_EAT_NONE
}

sub Cobalt_unregister {
  my ($self, $core) = splice @_, 0, 2;
  $self->Bot_seendb_update($core, \1);
  $core->log->info("Unloaded");
  PLUGIN_EAT_NONE
}

sub Bot_seendb_update {
  my ($self, $core) = splice @_, 0, 2;
  my $force_flush = @_ ? ${ $_[0] } : 0;

  my $buf = $self->[BUF];
  unless (keys %$buf) {
    $core->timer_set( 2, +{ Event => 'seendb_update' } );
    return PLUGIN_EAT_ALL
  }

  my $db  = $self->[SDB];

  CONTEXT: for my $context (keys %$buf) {
    unless ($db->dbopen) {
      logger->warn("dbopen failed in update; cannot update SeenDB");
      # FIXME exponential back-off?
      $core->timer_set( 6, +{ Event => 'seendb_update' } );
      return PLUGIN_EAT_ALL
    }

    my $writes;
    NICK: for my $nickname (keys %{ $buf->{$context} }) {
      ## if we've done a lot of writes, yield back (unless we're cleaning up)
      if (!$force_flush && $writes && $writes % 50 == 0) {
        $db->dbclose;
        broadcast 'seendb_update';
        return PLUGIN_EAT_ALL
      }
      ## .. else flush this item to disk
      my $thisbuf = delete $buf->{$context}->{$nickname};
      my $thiskey = $context .'%'. $nickname;
      $db->put($thiskey, $thisbuf);
      ++$writes;
    } ## NICK
    $db->dbclose;
    
    delete $buf->{$context} unless keys %{ $buf->{$context} };
  
  } ## CONTEXT
  
  $core->timer_set( 2, +{ Event => 'seendb_update' } );  

  return PLUGIN_EAT_ALL
}

sub Bot_user_joined {
  my ($self, $core) = splice @_, 0, 2;
  my $join    = ${ $_[0] };
  my $context = $join->context;

  my $nick = $join->src_nick;
  my $user = $join->src_user;
  my $host = $join->src_host;
  my $chan = $join->channel;

  $nick = _parse_nick($context, $nick);
  $self->[BUF]->{$context}->{$nick} = +{
    TS       => time(),
    Action   => 'join',
    Channel  => $chan,
    Username => $user,
    Host     => $host,
  };
  
  PLUGIN_EAT_NONE
}

sub Bot_chan_sync {
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${$_[0]};
  my $channel = ${$_[1]};

  broadcast seenplug_deferred_list => $context, $channel;

  PLUGIN_EAT_NONE
}

sub Bot_seenplug_deferred_list {
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${$_[0]};
  my $channel = ${$_[1]};
    
  my $irc   = $core->get_irc_object($context);
  my @nicks = $irc->channel_list($channel);
  for my $nick (@nicks) {
    $nick = _parse_nick($context, $nick);
    $self->[BUF]->{$context}->{$nick} = +{
      TS       => time(),
      Action   => 'present',
      Channel  => $channel,
      Username => '',
      Host     => '',
    };
  }
  
  PLUGIN_EAT_ALL
}

sub Bot_user_left {
  my ($self, $core) = splice @_, 0, 2;
  my $part    = ${ $_[0] };