Havin gotten good reponses on shlock.pl, here is my stab at a
list contatination script which should obide by majordomo's file
locking rules.
If you have time, please look it over. I've only played with
it for 15 minutes since finishing it, and would appreciate any
obvious mistakes.
The goal of this script, is to place it in majordomo's cron,
and concatinate several smaller lists (regional list) into
a global list. The intention is to config the global list as
closed, moderated, etc...
Anyway, basic syntax is:
list-cat -h for help
list-cat -D list1 list2 list3 superlist
################################### CUT HERE #################################
#!/usr/bin/perl
##BEGIN-HELP
###############################################################################
#
##-----------------------------------------------------------------------------
-
## $Header$
##-----------------------------------------------------------------------------
-
##
## Synopsis:
##
## Concatinate multiple lists to a super-list.
##
## Usage:
##
## list-cat options listname listname ... superlist
##
## -d debug messages displayed
## -D lots of debugging messages
## -h this help page
##
## *NOTE* this script is intended to run as the user 'majordom'
##
###############################################################################
#
##END-HELP
###############################################################################
#
###############################################################################
#
if (! defined $ENV{"HOME"}){
logger("ERR: HOME environment variable not set");
return(1);
}
$homedir=$ENV{"HOME"};
unshift(@INC, $homedir);
require "shlock.pl";
require "getopts.pl";
##
## I like to explicitly declare my package (no assumptions)
##
package main;
##
## Global variables
##
# Debug levels (using -d and -D sets 50 and 100 repectively)
# 10
# 20
# 30
# 40
# 50 procedure entering/exiting messages
# 60 block messages (loops, etc)
# 70
# 80
# 90 petty overkill
$DEBUG_LEVEL = 0;
# The non-fatal error count
$NFEC = 0;
# Signals to trap
$SIG{INT} = \&terminate;
# $SIG{HUP} = 'ignore';
# $SIG{QUIT} = 'ignore';
# $SIG{ABRT} = 'ignore';
# $SIG{KILL} = 'ignore';
# $SIG{ALRM} = 'ignore';
# $SIG{TERM} = 'ignore';
# $SIG{USR1} = 'ignore';
# $SIG{USR2} = 'ignore';
##
## I like my code to follow a C-like structure
##
exit(&main);
##------------------------------------------------------------------##
## function ........... main()
## synopsis ........... This is the beginning
## calling routines ... (none)
##------------------------------------------------------------------##
sub main() {
local $err;
$err = 0;
Getopts("bDdhry");
if ( defined $opt_d ) {
$DEBUG_LEVEL=50;
}
if ( defined $opt_D ) {
$DEBUG_LEVEL=100;
$shlock_debug=1;
}
logger ("entering",50);
if ( defined $opt_h ) {
logger ("help requested",60);
ShowUsage();
return($err);
}
$err = Engage();
if ( $NFEC > 0 ) {
logger("$NFEC non-fatal errors occured during processing");
}
logger ("exiting ($err)",50);
return($err);
}
##------------------------------------------------------------------##
## function ........... Engage()
## synopsis ...........
## calling routines ... main()
##------------------------------------------------------------------##
sub Engage {
local $i,$list,$err=0,LIST;
logger ("enter",50);
##
## Check my user id
##
if ( (getpwuid($>))[0] ne "majordom") {
logger("ERR: you must be user 'majordom' to run this script");
return(1);
}
##
## Load Majordomo's config info
##
$cf = $homedir."/majordomo.cf";
if (! -r $cf) {
logger("ERR: can't read $cf");
return(1);
}
logger("loading $cf",50);
require "$cf";
##
## Process command line parameters
##
$newlist = $ARGV[$#ARGV];
foreach $i (@ARGV) {
@lists = (@lists,"$listdir/$i") if ($i ne $newlist);
}
$listtemp = "$TMPDIR/$newlist.tmp";
$newlist = "$listdir/$newlist";
##
## Verify parameters
##
logger("$newlist (is a union of):",50);
foreach $i (@lists) {
logger (" $i",50);
if (! -r "$i") {
logger ("ERR: cannot read $i");
return(1);
}
}
##
## Create the new super list in a temp
##
if (lopen(TMPLIST,"+>","$listtemp")) {
logger("locked $listtemp",50);
foreach $i (@lists) {
if (lopen(LIST,"<","$i")) {
logger("locked $i",50);
while ($line = <LIST>) {
chomp($line);
if (defined $Used{$line}) {
logger ("- $line",60);
next;
}
$Used{$line} = 1;
logger("+ $line",60);
print TMPLIST "$line\n";
}
lclose(LIST);
logger("unlocked $i",50);
}
}
## Now lock the real list and copy it over
if (lopen(NEWLIST,"+>","$newlist")) {
logger("locked $newlist",50);
## Move the file pointer back to the beginning
seek(TMPLIST,0,0);
while (<TMPLIST>) { print NEWLIST; }
lclose(NEWLIST);
logger("unlocked $newlist",50);
}
lclose(TMPLIST);
logger("unlocked $listtemp",50);
}
logger ("exit",50);
return(0);
}
##------------------------------------------------------------------##
## function ........... ShowUsage()
## synopsis ...........
## calling routines ... main()
##------------------------------------------------------------------##
sub ShowUsage {
logger ("entering",50);
open(IN,"<$0");
$mode=0;
READER:
while (<IN>) {
if ($mode == 0 && /^##BEGIN-HELP.*/) {
++$mode;
} elsif ($mode != 0) {
if (/^##END-HELP.*/) {last READER;}
s/^#+ ?//;
printf $_;
}
}
close(IN);
logger ("exit",50);
}
##------------------------------------------------------------------##
## function ........... logger()
## synopsis ........... echos a log message to stderr. if logger
## is called without a level parameter, the
## message will be echoed.
## calling routines ... main()
##------------------------------------------------------------------##
sub logger {
local($msg,$level) = @_;
($sub) = (caller(1))[3];
if ($DEBUG_LEVEL >= $level) {
printf(STDERR "%2s %-25s %s\n",$level,$sub,$msg);
print("$msg\n") if (!$level);
}
}
##------------------------------------------------------------------##
## function ........... terminate()
## synopsis ........... attempt a clean exit after a signal to die
## calling routines ... SIG{INT}
##------------------------------------------------------------------##
sub terminate() {
print "Weow - I've been killed by a signal\n";
die;
}
Follow-Ups:
|
|
