Menu
▾
▴
popfile-commit
|
From: <ssc...@us...> - 2003-07-12 12:42:50
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv32052
Added Files:
Loader.pm
Log Message:
New file: Loader.pm --- API for loading POPFile loadable modules and encapsulating POPFile application tasks
--- NEW FILE: Loader.pm ---
package POPFile::Loader;
# ---------------------------------------------------------------------------------------------
#
# Loader.pm --- API for loading POPFile loadable modules and encapsulating POPFile application
# tasks
#
# subroutine names beginning with CORE indicate a subroutine designed for exclusive use of
# POPFile's core application. subroutines not so marked are suitable for use by POPFile-based
# utilities to assist in loading and executing modules
#
# Copyright (c) 2001-2003 John Graham-Cumming
#
# ---------------------------------------------------------------------------------------------
#----------------------------------------------------------------------------
# new
#
# Class new() function
#----------------------------------------------------------------------------
sub new
{
my $type = shift;
my $self;
# The POPFile classes are stored by reference in the components hash, the top level key is
# the type of the component (see CORE_load_directory_modules) and then the name of the
# component derived from calls to each loadable modules name() method and which points to
# the actual module
$self->{components__} = {};
# A handy boolean that tells us whether we are alive or not. When this is set to 1 then the
# proxy works normally, when set to 0 (typically by the aborting() function called from a signal)
# then we will terminate gracefully
$self->{alive__} = 1;
# This must be 1 for POPFile::Loader to create any output on STDOUT
$self->{debug__} = 0;
# This stuff lets us do some things in a way that tolerates some window-isms
$self->{on_windows__} = 0;
if ( $^O eq 'MSWin32' ) {
require v5.8.0;
$self->{on_windows__} = 1;
}
$self->{aborting__} = '';
$self->{pipeready__} = '';
$self->{forker__} = '';
$self->{reaper__} = '';
$self->{major_version__} = '';
$self->{minor_version__} = '';
$self->{build_version__} = '';
$self->{version_string__} = '';
bless $self, $type;
return $self;
}
#---------------------------------------------------------------------------------------------
# CORE_loader_init
#
# Initiali
#
# ***CORE***
#---------------------------------------------------------------------------------------------
sub CORE_loader_init
{
my ($self) = @_;
# These anonymous subroutine references allow us to call these important
# functions from anywhere using the reference, granting internal access
# to $self, without exposing $self to the unwashed. No reference to
# POPFile::Loader is needed by the caller
$self->{aborting__} = sub { $self->CORE_aborting(@_) };
$self->{pipeready__} = sub { $self->pipeready(@_) };
$self->{forker__} = sub { $self->CORE_forker(@_) };
$self->{reaper__} = sub { $self->CORE_reaper(@_) };
print "\nPOPFile Engine $self->{version_string__} loading\n" if $self->{debug__};
}
#---------------------------------------------------------------------------------------------
#
# CORE_aborting
#
# Called if we are going to be aborted or are being asked to abort our operation. Sets the
# alive flag to 0 that will cause us to abort at the next convenient moment
#
#---------------------------------------------------------------------------------------------
sub CORE_aborting
{
my ($self) = @_;
$self->{alive__} = 0;
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->alive(0);
$self->{components__}{$type}{$name}->stop();
}
}
}
#---------------------------------------------------------------------------------------------
#
# pipeready
#
# Returns 1 if there is data available to be read on the passed in pipe handle
#
# $pipe Pipe handle
#
#---------------------------------------------------------------------------------------------
sub pipeready
{
my ( $self, $pipe ) = @_;
# Check that the $pipe is still a valid handle
if ( !defined( $pipe ) ) {
return 0;
}
if ( $self->{on_windows__} ) {
# I am NOT doing a select() here because that does not work
# on Perl running on Windows. -s returns the "size" of the file
# (in this case a pipe) and will be non-zero if there is data to read
return ( ( -s $pipe ) > 0 );
} else {
# Here I do a select because we are not running on Windows where
# you can't select() on a pipe
my $rin = '';
vec( $rin, fileno( $pipe ), 1 ) = 1;
my $ready = select( $rin, undef, undef, 0.01 );
return ( $ready > 0 );
}
}
#---------------------------------------------------------------------------------------------
#
# CORE_reaper
#
# Called if we get SIGCHLD and asks each module to do whatever reaping is needed
#
#---------------------------------------------------------------------------------------------
sub CORE_reaper
{
my ($self) = @_;
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->reaper();
}
}
$SIG{CHLD} = $self->{reaper__};
}
#---------------------------------------------------------------------------------------------
#
# CORE_forker
#
# Called to fork POPFile. Calls every module's forked function in the child process to give
# then a chance to clean up
#
# Returns the return value from fork() and a file handle that form a pipe in the
# direction child to parent. There is no need to close the file handles that are unused as
# would normally be the case with a pipe and fork as forker takes care that in each process
# only one file handle is open (be it the reader or the writer)
#
#---------------------------------------------------------------------------------------------
sub CORE_forker
{
my ($self) = @_;
# Tell all the modules that a fork is about to happen
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->prefork();
}
}
# Create the pipe that will be used to send data from the child to the parent process,
# $writer will be returned to the child process and $reader to the parent process
pipe my $reader, my $writer;
my $pid = fork();
# If fork() returns an undefined value then we failed to fork and are
# in serious trouble (probably out of resources) so we return undef
if ( !defined( $pid ) ) {
close $reader;
close $writer;
return (undef, undef);
}
# If fork returns a PID of 0 then we are in the child process so close the
# reading pipe file handle, inform all modules that are fork has occurred and
# then return 0 as the PID so that the caller knows that we are in the child
if ( $pid == 0 ) {
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->forked();
}
}
close $reader;
# Set autoflush on the write handle so that output goes straight through
# to the parent without buffering it until the socket closes
use IO::Handle;
$writer->autoflush(1);
return (0, $writer);
}
# Reach here because we are in the parent process, close out the writer pipe
# file handle and return our PID (non-zero) indicating that this is the parent
# process
close $writer;
return ($pid, $reader);
}
#---------------------------------------------------------------------------------------------
#
# CORE_load_directory_modules
#
# Called to load all the POPFile Loadable Modules (implemented as .pm files with special
# comment on first line) in a specific subdirectory and loads them into a structured
# components hash
#
# $directory The directory to search for loadable modules
# $type The 'type' of module being loaded (e.g. proxy, core, ui) which is used
# when fixing up references between modules (e.g. proxy modules all need
# access to the classifier module) and for structuring components hash
#
#---------------------------------------------------------------------------------------------
sub CORE_load_directory_modules
{
my ( $self, $directory, $type ) = @_;
print "\n {$type:" if $self->{debug__};
# Look for all the .pm files in named directory and then see which of them
# are POPFile modules indicated by the first line of the file being and
# comment (# POPFILE LOADABLE MODULE) and load that module into the %{$self->{components__}}
# hash getting the name from the module by calling name()
my @modules = glob "$directory/*.pm";
foreach my $module (@modules) {
$self->CORE_load_module($module, $type);
}
print '} ' if $self->{debug__};
}
#---------------------------------------------------------------------------------------------
#
# CORE_load_module
#
# Called to load a single POPFile Loadable Module (implemented as .pm files with special
# comment on first line and add it to the components hash.
# Returns a handle to the module
#
# $module The path of the module to load
# $type The 'type' of module being loaded (e.g. proxy, core, ui)
#
#---------------------------------------------------------------------------------------------
sub CORE_load_module
{
my ( $self, $module, $type ) = @_;
my $mod = $self->load_module_($module);
if ( defined( $mod ) ) {
my $name = $mod->name();
print " $name" if $self->{debug__};
$self->{components__}{$type}{$name} = $mod;
}
return $mod;
}
#---------------------------------------------------------------------------------------------
#
# load_module_
#
# Called to load a single POPFile Loadable Module (implemented as .pm files with special
# comment on first line. Returns a handle to the module, undef if the module failed to load.
# No internal side-effects.
#
# $module The path of the module to load
#
#---------------------------------------------------------------------------------------------
sub load_module_
{
my ( $self, $module ) = @_;
my $mod;
if ( open MODULE, "<$module" ) {
my $first = <MODULE>;
close MODULE;
if ( $first =~ /^# POPFILE LOADABLE MODULE/ ) {
require $module;
$module =~ s/\//::/;
$module =~ s/\.pm//;
$mod = $module->new();
}
}
return $mod;
}
#---------------------------------------------------------------------------------------------
# CORE_signals
#
# Sets signals to ensure that POPFile handles OS and IPC events
#
# TODO: Figure out why windows POPFile doesn't seem to get SIGTERM when windows shuts down
#
#---------------------------------------------------------------------------------------------
sub CORE_signals
{
my ($self) = @_;
# Redefine POPFile's signals
$SIG{QUIT} = $self->{aborting__};
$SIG{ABRT} = $self->{aborting__};
$SIG{KILL} = $self->{aborting__};
$SIG{STOP} = $self->{aborting__};
$SIG{TERM} = $self->{aborting__};
$SIG{INT} = $self->{aborting__};
# Yuck. On Windows SIGCHLD isn't calling the reaper under ActiveState 5.8.0
# so we detect Windows and ignore SIGCHLD and call the reaper code below
$SIG{CHLD} = $self->{on_windows__}?'IGNORE':$self->{reaper__};
# I've seen spurious ALRM signals happen on Windows so here we for safety
# say that we want to ignore them
$SIG{ALRM} = 'IGNORE';
return $SIG;
}
#---------------------------------------------------------------------------------------------
# CORE_platform_
#
# Loads POPFile's platform-specific code
#
#---------------------------------------------------------------------------------------------
sub CORE_platform_
{
my ($self) = @_;
# Look for a module called Platform::<platform> where <platform> is the value of $^O
# and if it exists then load it as a component of POPFile. IN this way we can have
# platform specific code (or not) encapsulated. Note that such a module needs to be
# a POPFile Loadable Module and a subclass of POPFile::Module to operate correctly
my $platform = $^O;
if ( -e "Platform/$platform.pm" ) {
print "\n {core:" if $self->{debug__};
$self->CORE_load_module( "Platform/$platform.pm",'core');
print "}" if $self->{debug__};
}
}
#---------------------------------------------------------------------------------------------
# load
#
# Loads POPFile's modules
#
#---------------------------------------------------------------------------------------------
sub CORE_load
{
my ($self) = @_;
# Create the main objects that form the core of POPFile. Consists of the configuration
# modules, the classifier, the UI (currently HTML based), and the POP3 proxy.
print "\n Loading... " if $self->{debug__};
# Do our platform-specific stuff
$self->CORE_platform_();
# populate our components hash
$self->CORE_load_directory_modules( 'POPFile', 'core' );
$self->CORE_load_directory_modules( 'Classifier', 'classifier' );
$self->CORE_load_directory_modules( 'UI', 'interface' );
$self->CORE_load_directory_modules( 'Proxy', 'proxy' );
}
#---------------------------------------------------------------------------------------------
# clink
#
# Links POPFile's modules together to allow them to make use of each-other as objects
#
#---------------------------------------------------------------------------------------------
sub CORE_link_components
{
my ($self) = @_;
print "\n\nPOPFile Engine $self->{version_string__} starting" if $self->{debug__};
# Link each of the main objects with the configuration object so that they can set their
# default parameters all or them also get access to the logger, version, and message-queue
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->version( $self->CORE_version() );
$self->{components__}{$type}{$name}->configuration( $self->{components__}{core}{config} );
$self->{components__}{$type}{$name}->logger( $self->{components__}{core}{logger} ) if ( $name ne 'logger' );
$self->{components__}{$type}{$name}->mq( $self->{components__}{core}{mq} );
}
}
# All interface components need access to the classifier
foreach my $name (keys %{$self->{components__}{interface}}) {
$self->{components__}{interface}{$name}->classifier( $self->{components__}{classifier}{bayes} );
}
foreach my $name (keys %{$self->{components__}{proxy}}) {
$self->{components__}{proxy}{$name}->classifier( $self->{components__}{classifier}{bayes} );
}
}
#---------------------------------------------------------------------------------------------
# initialize
#
# Loops across POPFile's modules and initializes them
#
#---------------------------------------------------------------------------------------------
sub CORE_initialize
{
my ($self) = @_;
print "\n\n Initializing... " if $self->{debug__};
# Tell each module to initialize itself
foreach my $type (keys %{$self->{components__}}) {
print "\n {$type:" if $self->{debug__};
foreach my $name (keys %{$self->{components__}{$type}}) {
print " $name" if $self->{debug__};
flush STDOUT;
if ( $self->{components__}{$type}{$name}->initialize() == 0 ) {
die "Failed to start while initializing the $name module";
}
$self->{components__}{$type}{$name}->alive( 1 );
$self->{components__}{$type}{$name}->forker( $self->{forker__} );
$self->{components__}{$type}{$name}->pipeready( $self->{pipeready__} );
}
print '} ' if $self->{debug__};
}
}
#---------------------------------------------------------------------------------------------
# CORE_config
#
# Loads POPFile's configuration and command-line settings
#
#---------------------------------------------------------------------------------------------
sub CORE_config
{
my ($self) = @_;
# Load the configuration from disk and then apply any command line
# changes that override the saved configuration
$self->{components__}{core}{config}->load_configuration();
$self->{components__}{core}{config}->parse_command_line();
}
#---------------------------------------------------------------------------------------------
# CORE_start
#
# Loops across POPFile's modules and starts them
#
#---------------------------------------------------------------------------------------------
sub CORE_start
{
my ($self) = @_;
print "\n\n Starting... " if $self->{debug__};
# Now that the configuration is set tell each module to begin operation
foreach my $type (keys %{$self->{components__}}) {
print "\n {$type:" if $self->{debug__};
foreach my $name (keys %{$self->{components__}{$type}}) {
print " $name" if $self->{debug__};
flush STDOUT;
if ( $self->{components__}{$type}{$name}->start() == 0 ) {
die "Failed to start while starting the $name module";
}
}
print '} ' if $self->{debug__};
}
}
#---------------------------------------------------------------------------------------------
# CORE_service
#
# This is POPFile. Loops across POPFile's modules and executes their service subroutines then
# sleeps briefly
#
#
#---------------------------------------------------------------------------------------------
sub CORE_service
{
my ($self) = @_;
print "\n\nPOPFile Engine $self->{version_string__} running\n" if $self->{debug__};
flush STDOUT;
# MAIN LOOP - Call each module's service() method to all it to
# handle its own requests
while ( $self->{alive__} == 1 ) {
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
if ( $self->{components__}{$type}{$name}->service() == 0 ) {
$self->{alive__} = 0;
last;
}
}
}
# Sleep for 0.05 of a second to ensure that POPFile does not hog the machine's
# CPU
select(undef, undef, undef, 0.05);
# If we are on Windows then reap children here
if ( $self->{on_windows__} ) {
foreach my $type (keys %{$self->{components__}}) {
foreach my $name (keys %{$self->{components__}{$type}}) {
$self->{components__}{$type}{$name}->reaper();
}
}
}
}
}
#---------------------------------------------------------------------------------------------
# CORE_stop
#
# Loops across POPFile's modules and stops them
#
#---------------------------------------------------------------------------------------------
sub CORE_stop
{
my ($self) = @_;
print "\n\nPOPFile Engine $self->{version_string__} stopping\n" if $self->{debug__};
flush STDOUT;
print "\n Stopping... " if $self->{debug__};
# Shutdown all the modules
foreach my $type (keys %{$self->{components__}}) {
print "\n {$type:" if $self->{debug__};
foreach my $name (keys %{$self->{components__}{$type}}) {
print " $name" if $self->{debug__};
flush STDOUT;
$self->{components__}{$type}{$name}->alive(0);
$self->{components__}{$type}{$name}->stop();
}
print '} ' if $self->{debug__};
}
print "\n\nPOPFile Engine $self->{version_string__} terminated\n" if $self->{debug__};
}
# GETTERS/SETTERS
#---------------------------------------------------------------------------------------------
# CORE_version
#
# Gets and Sets POPFile's version data. Returns string in scalar context, or (major, minor, build)
# triplet in list context
#
# $major_version The major version number
# $minor_version The minor version number
# $build_version The build version number
#
#---------------------------------------------------------------------------------------------
sub CORE_version
{
my ($self,$major_version, $minor_version, $build_version) = @_;
if (!defined($major_version)) {
if (wantarray) {
return ($self->{major_version__},$self->{minor_version__},$self->{build_version__});
} else {
return $self->{version_string__};
}
} else {
($self->{major_version__}, $self->{minor_version__}, $self->{build_version__}) = ($major_version, $minor_version, $build_version);
$self->{version_string__} = "v$major_version.$minor_version.$build_version"
}
}
#---------------------------------------------------------------------------------------------
# get_module
#
# Gets a module from components hash. Returns a handle to a module.
#
# May be called either as:
#
# $name Module name in scoped format (eg, Classifier::Bayes)
#
# Or:
#
# $name Name of the module
# $type The type of module
#
#---------------------------------------------------------------------------------------------
sub get_module
{
my ($self, $name, $type) = @_;
if (!defined($type) && $name =~ /^(.*)::(.*)$/ ) {
$type = lc($1);
$name = lc($2);
$type =~ s/^POPFile$/core/
}
return $self->{components__}{$type}{$name};
}
#---------------------------------------------------------------------------------------------
# set_module
#
# Inserts a module into components hash.
#
# $name Name of the module
# $type The type of module
# $module A handle to a module
#
#---------------------------------------------------------------------------------------------
sub set_module
{
my ($self, $type, $name, $module) = @_;
$self->{components__}{$type}{$name} = $module;
}
#---------------------------------------------------------------------------------------------
# remove_module
#
# removes a module from components hash.
#
# $name Name of the module
# $type The type of module
# $module A handle to a module
#
#---------------------------------------------------------------------------------------------
sub remove_module
{
my ($self, $type, $name) = @_;
$self->{components__}{$type}{$name}->stop();
delete($self->{components__}{$type}{$name});
}
#---------------------------------------------------------------------------------------------
# debug
#
# POPFile::Loader debugging getter/setter
#
#---------------------------------------------------------------------------------------------
sub debug
{
my ($self, $debug) = @_;
$self->{debug__} = $debug;
}
1;
##
|
Thanks for helping keep SourceForge clean.
X