home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
cronhook.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
2KB
|
84 lines
# FILE: cronhook.pl
# DESCRIPTION: Various "hooks" for cron-based tasks
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
###
### hook_manager
###
### Manages hooks by looking at command line:
### (No arguments) Send queued 'cron' messages
### -sched Run Discus scheduler
### -pop3 Run POP3 mailbox checker
###
sub hook_manager {
if ($ENV{REQUEST_METHOD} ne "" || $ENV{REMOTE_ADDR} ne "") {
send_queued_cron_messages();
if ($GLOBAL_OPTIONS->{scanpop3} == 1) {
dreq("em-reply");
email_reply_pop3_handler();
}
header();
print "<!--cronhook-->\n";
program_exit(0);
} else {
if ($ARGV[0] eq "") {
send_queued_cron_messages();
} else {
while (my $j = shift @ARGV) {
if ($j =~ /^\-sched/i) {
dreq("schedule-PRO");
schedule_daemon_once();
} elsif ($j =~ /^\-pop3/i) {
dreq("em-reply");
email_reply_pop3_handler();
}
}
}
program_exit(0);
}
}
###
### send_queued_cron_messages
###
### Sends out queued messages
###
sub send_queued_cron_messages {
if (opendir(DIR, "$DCONF->{admin_dir}/mailqueue")) {
my @dir = map { "$DCONF->{admin_dir}/mailqueue/$_" } grep { /\.txt$/ } readdir(DIR);
closedir(DIR);
my $tcache = time;
@dir = grep { (stat($_))[9] < ($tcache - 30) } @dir;
while (my $file = shift @dir) {
if (open(FILE, "< $file")) {
my @J = <FILE>;
close (FILE);
unlink $file;
my $cmdline = shift @J; chomp $cmdline;
if (open (MAILPIPE, $cmdline)) {
binmode MAILPIPE;
print MAILPIPE @J;
close (MAILPIPE);
}
}
}
}
}
1;