HighInBC's Master Control Program

This program is licensed under the GFDL

This is an attempt to make a framework that will run plugin-like "bots". The plugins will be able to communicate with each other. This means that one plugin can monitor the recent changes IRC feed, and several other plugins can use that information.

See also the plugins:

  • RecoverTalkArchive - A plugin for the command parser that builds a talk page archive from its history.

The plugins are controlled by the configuration file:

#!/usr/bin/perl
use strict;
use Data::Dumper;
use Time::HiRes qw(sleep);

push(@INC, '.');
my $data_root = 'data/';

our(%shared_data);
%shared_data =
 (
  job_list      => [],
  add_job       => sub {my ($r_job , $timing) = @_;push (@{$shared_data{job_list}} , [$r_job , (time()+$timing)]);}
 );
my(%plugins);

open(CFG,'HBC_MCP.cfg');
sysread(CFG, my $cfg, -s(CFG));
close(CFG);
eval($cfg);
die $@ if ($@);

warn "Initializing plugins...\n";
foreach my $name (keys(%plugins))
  {
  warn "Initializing $name\n";
  my $obj;
  $plugins{$name}{shared} = \%shared_data;
  $plugins{$name}{files} = $data_root.$name.'/';
  mkdir ($data_root.$name.'/') unless (-d($data_root.$name.'/'));
  my $plugin_command = 'use HBCPlugins::'.$name.';$obj = HBCPlugins::'.$name.'->new($plugins{\''.$name.'\'});';
  eval $plugin_command;
  $shared_data{$obj->{label}} = $obj;
  }
warn "Initialization complete.\n\n";
until (6 == 9)                               # Infinite loop, a serpent biting it's own tail.
  {
  my $ra_job_list = $shared_data{job_list};
  sleep(.1);                             # Important in all infinite loops to keep it calm
  my (@kept_jobs);                      # A place to put jobs not ready to run yet
  while (my $job = shift(@{$ra_job_list}))    # Go through each job pending
    {
    my($r_job , $timing) = @{$job};
    if ($timing < time())               # If it is time to run it then run it
      {
      if (ref($r_job) eq 'ARRAY')       # Callback style, reference to an array with a sub followed by paramaters
        {
        my $cmd = shift(@{$r_job});
        &{$cmd}(@{$r_job});
        }
      elsif (ref($r_job) eq 'CODE')     # Otherwise just the reference to the sub
        {
        &{$r_job};
        }
      }
    else                                # If it is not time yet, save it for later
      {
      push(@kept_jobs , $job)
      }
    }
  push (@{$ra_job_list} , @kept_jobs);        # Keep jobs that are still pending
  }