|
From: <jgr...@us...> - 2003-06-14 21:10:15
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv29263/POPFile
Modified Files:
Configuration.pm Logger.pm Module.pm
Added Files:
MQ.pm
Log Message:
Added new message queuing engine for asynchronous message passing, use it for classification data and UI registrations, remove mcount and ecount global variables, add new access to all configuration options on Advanced page
--- NEW FILE: MQ.pm ---
# POPFILE LOADABLE MODULE
package POPFile::MQ;
use POPFile::Module;
@ISA = ( "POPFile::Module" );
#----------------------------------------------------------------------------
#
# This module handles POPFile's message queue. Every POPFile::Module is
# able to register with the MQ for specific message types and can also
# send messages without having to know which modules need to receive
# its messages.
#
# Message delivery is asynchronous and guaranteed.
#
# The following public functions are defined:
#
# register() - register for a specific message type and pass an object
# reference. will call that object's deliver() method to
# deliver messages
#
# post() - send a message of a specific type
#
# The current list of types is
#
# CLASS A message was classified, message is the bucket and the
# parameter is null (comes from Proxy::Proxy)
#
# UIREG Register a UI component, message is the component type
# and the parameter is a the element and reference to the
# object registering (comes from any component)
#
# TICKD Occurs when a day has passed since the last TICKD (this
# is generated by the POPFile::Logger module)
#
# LOGIN Occurs when a proxy logs into a remote server, the message
# is the username sent
#
# Copyright (c) 2001-2003 John Graham-Cumming
#
#----------------------------------------------------------------------------
use strict;
use warnings;
use locale;
#----------------------------------------------------------------------------
# new
#
# Class new() function
#----------------------------------------------------------------------------
sub new
{
my $type = shift;
my $self = POPFile::Module->new();
# These are the individual queues of message, indexed by type
# and written to by post().
$self->{queue__} = {};
# These are the registered objects for each type
$self->{waiters__} = {};
bless $self, $type;
$self->name( 'mq' );
return $self;
}
# ---------------------------------------------------------------------------------------------
#
# service
#
# Called to handle pending tasks for the module. Here we flush all queues
#
# ---------------------------------------------------------------------------------------------
sub service
{
my ( $self ) = @_;
# Iterate through all the messages in all the queues
for my $type (keys %{$self->{queue__}}) {
while ( my $ref = shift @{$self->{queue__}{$type}} ) {
if ( defined( $ref ) ) {
for my $waiter (@{$self->{waiters__}{$type}}) {
my $message = @$ref[0];
my $parameter = @$ref[1];
$waiter->deliver( $type, $message, $parameter );
}
} else {
last;
}
}
}
return 1;
}
#----------------------------------------------------------------------------
#
# register
#
# When a module wants to receive specific message types it calls this
# method with the type of message is wants to receive and the address
# of a callback function that will receive the messages
#
# $type A string identifying the message type
# $callback Reference to a function that takes three parameters
#
#----------------------------------------------------------------------------
sub register
{
my ( $self, $type, $callback ) = @_;
push @{$self->{waiters__}{$type}}, ( $callback );
}
#----------------------------------------------------------------------------
#
# post
#
# Called to send a message through the message queue
#
# $type A string identifying the message type
# $message The message
# $parameter Parameters to the message
#
#----------------------------------------------------------------------------
sub post
{
my ( $self, $type, $message, $parameter ) = @_;
push @{$self->{queue__}{$type}}, [ $message, $parameter ];
}
1;
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** Configuration.pm 26 May 2003 22:19:53 -0000 1.18
--- Configuration.pm 14 Jun 2003 21:10:12 -0000 1.19
***************
*** 37,40 ****
--- 37,44 ----
$self->{configuration_parameters__} = {};
+ # Name of the PID file that we created
+
+ $self->{pid_file__} = '';
+
bless $self, $type;
***************
*** 75,85 ****
$self->global_config_( 'download_count', 0 );
- # We keep track of the total number of messages downloaded (the mcount)
- # and the total number of classification errors made (ecount) which is
- # actually the number of times a message is reclassified in the UI
-
- $self->global_config_( 'mcount', 0 );
- $self->global_config_( 'ecount', 0 );
-
# The default timeout in seconds for POP3 commands
$self->global_config_( 'timeout', 60 );
--- 79,82 ----
***************
*** 111,115 ****
my ( $self ) = @_;
! if ( open PID, '>' . $self->config_( 'piddir' ) . 'popfile.pid' ) {
print PID "$$\n";
close PID;
--- 108,127 ----
my ( $self ) = @_;
! # Check to see if the PID file is present, if it is then another POPFile
! # may be running, warn the user and terminate
!
! $self->{pid_file__} = $self->config_( 'piddir' ) . 'popfile.pid';
!
! if ( -e $self->{pid_file__} ) {
! my $error = "\n\nAnother copy of POPFile appears to be running. \nIf this is not the case then" .
! " delete the file \n$self->{pid_file__} and restart POPFile.\n\n";
!
! print $error;
! $self->log_( $error );
!
! return 0;
! }
!
! if ( open PID, ">$self->{pid_file__}" ) {
print PID "$$\n";
close PID;
***************
*** 130,134 ****
my ( $self ) = @_;
! unlink( $self->config_( 'piddir' ) . 'popfile.pid' );
}
--- 142,148 ----
my ( $self ) = @_;
! $self->save_configuration();
!
! unlink( $self->{pid_file__} );
}
***************
*** 211,216 ****
'debug', 'GLOBAL_debug',
- 'ecount', 'GLOBAL_ecount',
- 'mcount', 'GLOBAL_mcount',
'msgdir', 'GLOBAL_msgdir',
'subject', 'GLOBAL_subject',
--- 225,228 ----
***************
*** 329,332 ****
--- 341,353 ----
return $self->{configuration_parameters__}{$name};
+ }
+
+ # GETTER
+
+ sub configuration_parameters
+ {
+ my ( $self ) = @_;
+
+ return sort keys %{$self->{configuration_parameters__}};
}
Index: Logger.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Logger.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** Logger.pm 9 Jun 2003 22:39:16 -0000 1.18
--- Logger.pm 14 Jun 2003 21:10:12 -0000 1.19
***************
*** 64,68 ****
$self->config_( 'logdir', './' );
! remove_debug_files( $self );
return 1;
--- 64,68 ----
$self->config_( 'logdir', './' );
! calculate_today__( $self );
return 1;
***************
*** 99,102 ****
--- 99,107 ----
if ( $self->{today__} > $yesterday ) {
+
+ # Inform other modules that a day has passed
+
+ $self->mq_post_( 'TICKD', '', '' );
+
my @debug_files = glob( $self->config_( 'logdir' ) . 'popfile*.log' );
Index: Module.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Module.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Module.pm 9 Jun 2003 18:32:10 -0000 1.9
--- Module.pm 14 Jun 2003 21:10:12 -0000 1.10
***************
*** 41,44 ****
--- 41,46 ----
# used as the key for this module in %components
#
+ # deliver() - called by the message queue to deliver a message
+ #
# The following methods are PROTECTED and should be accessed by sub classes:
#
***************
*** 47,50 ****
--- 49,58 ----
# config_() - gets or sets a configuration parameter for this module
#
+ # mq_post_() - post a message to the central message queue
+ #
+ # mq_register_() register for messages from the message queue
+ #
+ # register_configuration_item_() register a UI configuration item
+ #
# A note on the naming
#
***************
*** 95,98 ****
--- 103,110 ----
$self->{logger__} = 0; # PRIVATE
+ # A reference to the POPFile::MQ module
+
+ $self->{mq__} = 0;
+
# The name of this module
***************
*** 222,226 ****
#
# This is called when some module forks POPFile and is within the context of the child
! # process so that this module can close any duplicated file handles that are not needed.
#
# There is no return value from this method
--- 234,238 ----
#
# This is called when some module forks POPFile and is within the context of the child
! # process so that this module can close any duplicated file handles that are not needed.
#
# There is no return value from this method
***************
*** 234,237 ****
--- 246,263 ----
# ---------------------------------------------------------------------------------------------
#
+ # deliver
+ #
+ # Called by the message queue to deliver a message
+ #
+ # There is no return value from this method
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub deliver
+ {
+ my ( $self, $type, $message, $parameter ) = @_;
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
# log_
#
***************
*** 273,276 ****
--- 299,337 ----
# ---------------------------------------------------------------------------------------------
#
+ # mq_post_
+ #
+ # Called by a subclass to post a message to the message queue
+ #
+ # $type Type of message to send
+ # $message Message to send
+ # $parameter Message parameters
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub mq_post_
+ {
+ my ( $self, $type, $message, $parameter ) = @_;
+
+ return $self->{mq__}->post( $type, $message, $parameter );
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # mq_register_
+ #
+ # Called by a subclass to register with the message queue for messages
+ #
+ # $type Type of message to send
+ # $object Callback object
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub mq_register_
+ {
+ my ( $self, $type, $object ) = @_;
+
+ return $self->{mq__}->register( $type, $object );
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
# global_config_
#
***************
*** 312,315 ****
--- 373,392 ----
}
+ # ---------------------------------------------------------------------------------------------
+ #
+ # register_configuration_item_
+ #
+ # Called by a subclass to register a UI element
+ #
+ # $type, $name, $object See register_configuration_item in UI::HTML
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub register_configuration_item_
+ {
+ my ( $self, $type, $name, $object ) = @_;
+
+ return $self->mq_post_( 'UIREG', "$type:$name", $object );
+ }
+
# GETTER/SETTER methods. Note that I do not expect documentation of these unless they
# are non-trivial since the documentation would be a waste of space
***************
*** 331,334 ****
--- 408,422 ----
# This method access the foo_ variable for reading or writing, $c->foo() read foo_ and
# $c->foo( 'foo' ) writes foo_
+
+ sub mq
+ {
+ my ( $self, $value ) = @_;
+
+ if ( defined( $value ) ) {
+ $self->{mq__} = $value;
+ }
+
+ return $self->{mq__};
+ }
sub configuration
|