From 53d2232cdf89e419bdc3ad262239c26618c3ea1e Mon Sep 17 00:00:00 2001 From: lars Date: Sun, 15 Jan 2006 22:42:05 +0000 Subject: [PATCH] Mail::Ezmlm: trunk remoed to be replaced by tag/0.07 --- Ezmlm/trunk/Changes | 41 -- Ezmlm/trunk/Ezmlm.pm | 1112 --------------------------------------- Ezmlm/trunk/MANIFEST | 7 - Ezmlm/trunk/META.yml | 10 - Ezmlm/trunk/Makefile.PL | 119 ----- Ezmlm/trunk/README | 22 - Ezmlm/trunk/test.pl | 234 -------- 7 files changed, 1545 deletions(-) delete mode 100644 Ezmlm/trunk/Changes delete mode 100644 Ezmlm/trunk/Ezmlm.pm delete mode 100644 Ezmlm/trunk/MANIFEST delete mode 100644 Ezmlm/trunk/META.yml delete mode 100644 Ezmlm/trunk/Makefile.PL delete mode 100644 Ezmlm/trunk/README delete mode 100644 Ezmlm/trunk/test.pl diff --git a/Ezmlm/trunk/Changes b/Ezmlm/trunk/Changes deleted file mode 100644 index 69bdf62..0000000 --- a/Ezmlm/trunk/Changes +++ /dev/null @@ -1,41 +0,0 @@ -$Id: Changes,v 1.5 2005/03/05 14:14:27 guy Exp $ - -Revision history for Perl extension Mail::Ezmlm. - -0.01 Sun Oct 31 12:58:16 1999 - - original version; created by h2xs 1.1.1.1.2.1 - -0.02 Wed Jan 26 07:59:10 SAST 2000 - - Added functions to check various options - (ismodsub, ismodpost, isremote, isdeny, isallow, isdigest) - - Allowed sub, unsub, list, subscribers, issub to work with list subparts - (ie, the allow, deny, mod, digest sub directories) - - Changed system() calls to safer ones (ie command, switches) - - Made error handling better (errmsg() and errno()) - - Added support for creating MySQL tables via ezmlm-mktab - -0.03 Mon Sep 25 11:49:26 SAST 2000 - - fixed the issub() function - - fixed the problem with dashes in hostnames. - - hopefully got rid of some of the warnings from sub() and unsub() - -0.04 Mon May 26 18:15:38 SAST 2003 - - fixed return value of Makefile.PL (Andrew Pam ) - - fixed issub() (again) to handle parts properly (bug 602; moguo@servism.com) - - converted module global variables to instance variables - -0.05 Sat Mar 5 12:47:10 SAST 2005 - - fixed forced scalar return in subscribers() (Jon Coulter ) - - fixed handling of dashes in hostnames (bug 5571; Lars Braeuer ) - - fixed some tainting problems (Scott Beck and Matt Simerson ) - - fixed order of control/defaulthost and control/me (bug 1515) - - fixed a bug in Makefile.PL (bug 11771). does not affect most users, so released as 0.05.1 - -0.06 Mon Dec 26 18:55:12 CET 2005 - - support for ezmlm-idx-5.0.0 added - - fixed version check - -0.07 Mon Jan 2 22:12:32 CET 2006 - - new functions for text management (idx >= 5.0) - - new functions for language setting (idx >= 5.0) - - new functions for config directory setting (idx >= 5.0) diff --git a/Ezmlm/trunk/Ezmlm.pm b/Ezmlm/trunk/Ezmlm.pm deleted file mode 100644 index 87bd740..0000000 --- a/Ezmlm/trunk/Ezmlm.pm +++ /dev/null @@ -1,1112 +0,0 @@ -# =========================================================================== -# Ezmlm.pm - version 0.04 - 26/05/2003 -# $Id: Ezmlm.pm,v 1.10 2005/03/05 14:11:11 guy Exp $ -# -# Object methods for ezmlm mailing lists -# -# Copyright (C) 1999-2005, Guy Antony Halse, All Rights Reserved. -# Please send bug reports and comments to guy@rucus.ru.ac.za -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions are -# met: -# -# Redistributions of source code must retain the above copyright notice, -# this list of conditions and the following disclaimer. -# -# Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# Neither name Guy Antony Halse nor the names of any contributors -# may be used to endorse or promote products derived from this software -# without specific prior written permission. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS -# IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, -# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE -# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -# POSSIBILITY OF SUCH DAMAGE. -# -# ========================================================================== -# POD is at the end of this file. Search for '=head' to find it -package Mail::Ezmlm; - -use strict; -use vars qw($QMAIL_BASE $EZMLM_BASE $MYSQL_BASE $VERSION @ISA @EXPORT @EXPORT_OK); -use Carp; - -require Exporter; - -@ISA = qw(Exporter); -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. -@EXPORT = qw( - -); -$VERSION = '0.06'; - -require 5.005; - -# == Begin site dependant variables == -$EZMLM_BASE = '/usr/local/bin'; #Autoinserted by Makefile.PL -$QMAIL_BASE = '/var/qmail'; #Autoinserted by Makefile.PL -$MYSQL_BASE = ''; #Autoinserted by Makefile.PL -# == End site dependant variables == - -use Carp; - -# == clean up the path for taint checking == -local $ENV{'PATH'} = $EZMLM_BASE; - -# == Initialiser - Returns a reference to the object == -sub new { - my($class, $list) = @_; - my $self = {}; - bless $self, ref $class || $class || 'Mail::Ezmlm'; - $self->setlist($list) if(defined($list) && $list); - return $self; -} - -# == Make a new mailing list and set it to current == -sub make { - my($self, %list) = @_; - my($VHOST, $comandline, $hostname); - - # Do we want to use command line switches - my $commandline = ''; - $commandline = '-' . $list{'-switches'} if(defined($list{'-switches'})); - my @commandline; - # UGLY! - foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) { - next if (!defined($_) or !$_ or $_ eq ' '); - push @commandline, $_; - } - - # These three variables are essential - ($self->_seterror(-1, 'must define -dir in a make()') && return 0) unless(defined($list{'-dir'})); - ($self->_seterror(-1, 'must define -qmail in a make()') && return 0) unless(defined($list{'-qmail'})); - ($self->_seterror(-1, 'must define -name in a make()') && return 0) unless(defined($list{'-name'})); - - # Determine hostname if it is not supplied - $hostname = $self->_getdefaultdomain; - if(defined($list{'-host'})) { - $VHOST = 1 unless ($list{'-host'} eq $hostname); - } else { - $list{'-host'} = $hostname; - } - - # Attempt to make the list if we can. - unless(-e $list{'-dir'}) { - system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0 - || ($self->_seterror($?) && return undef); - } else { - ($self->_seterror(-1, '-dir must be defined in make()') && return 0); - } - - # Sort out the DIR/inlocal problem if necessary - if(defined($VHOST)) { - unless(defined($list{'-user'})) { - ($self->_seterror(-1, '-user must match virtual host user in make()') && return 0) unless($list{'-user'} = $self->_getvhostuser($list{'-host'})); - } - - open(INLOCAL, ">$list{'-dir'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in make()') && return 0); - print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n"; - close INLOCAL; - } - - $self->_seterror(undef); - return $self->setlist($list{'-dir'}); -} - -# == Update the current list == -sub update { - my($self, $switches) = @_; - my($outhost, $inlocal); - - # Do we have the command line switches - ($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches)); - $switches = '-e' . $switches; - my @switches; - - # UGLY! - foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) { - next if (!defined($_) or !$_ or $_ eq ' '); - # untaint input - $_ =~ m/^([\w _\/,\.\@:'"-]*)$/; - push @switches, $1; - } - - # can we actually alter this list; - ($self->_seterror(-1, 'must setlist() before you update()') && return 0) unless(defined($self->{'LIST_NAME'})); - # check for important files: 'config' (idx < v5.0) or 'flags' (idx >= 5.0) - ($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless((-e "$self->{'LIST_NAME'}/config") || (-e "$self->{'LIST_NAME'}/flags")); - - # Work out if this is a vhost. - open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0); - chomp($outhost = ); - close(OUTHOST); - - # Save the contents of inlocal if it is a vhost - unless($outhost eq $self->_getdefaultdomain) { - open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0); - chomp($inlocal = ); - close(INLOCAL); - } - - # Attempt to update the list if we can. - system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0 - || ($self->_seterror($?) && return undef); - - # Sort out the DIR/inlocal problem if necessary - if(defined($inlocal)) { - open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0); - print INLOCAL "$inlocal\n"; - close INLOCAL; - } - - $self->_seterror(undef); - return $self->{'LIST_NAME'}; -} - -# == Get a list of options for the current list == -sub getconfig { - my($self) = @_; - my($options); - - # Read the config file - if(-e "$self->{'LIST_NAME'}/flags") { - # this file exists since ezmlm-idx-5.0.0 - # 'config' is not authorative anymore since that version - $options = $self->_getconfig_idx5(); - } elsif(open(CONFIG, "<$self->{'LIST_NAME'}/config")) { - # 'config' contains the authorative information - while() { - if (/^F:-(\w+)/) { - $options = $1; - } elsif (/^(\d):(.+)$/) { - $options .= " -$1 '$2'"; - } - } - close CONFIG; - } else { - # Try manually - this will ignore all string settings, that can only be found - # in the config file - $options = $self->_getconfigmanual(); - } - - ($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options)); - - $self->_seterror(undef); - return $options; -} - -# == Return the name of the current list == -sub thislist { - my($self) = shift; - $self->_seterror(undef); - return $self->{'LIST_NAME'}; -} - -# == Set the current mailing list == -sub setlist { - my($self, $list) = @_; - if ($list =~ m/^([\w\d\_\-\.\/]+)$/) { - $list = $1; - if (-e "$list/lock") { - $self->_seterror(undef); - return $self->{'LIST_NAME'} = $list; - } else { - $self->_seterror(-1, "$list does not appear to be a valid list in setlist()"); - return undef; - } - } else { - $self->_seterror(-1, "$list contains tainted data in setlist()"); - return undef; - } -} - -# == Output the subscribers to $stream == -sub list { - my($self, $stream, $part) = @_; - $stream = *STDOUT unless (defined($stream)); - if(defined($part)) { - print $stream $self->subscribers($part); - } else { - print $stream $self->subscribers; - } -} - -# == Return an array of subscribers == -sub subscribers { - my($self, $part) = @_; - my(@subscribers); - ($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'})); - if(defined($part) && $part) { - ($self->_seterror(-1, "$part part of $self->{'LIST_NAME'} does not appear to exist in subscribers()") && return undef) unless(-e "$self->{'LIST_NAME'}/$part"); - @subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}/$part`; - } else { - @subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`; - } - - if($?) { - $self->_seterror($?, 'error during ezmlm-list in subscribers()'); - return (scalar @subscribers ? @subscribers : undef); - } else { - $self->_seterror(undef); - return @subscribers; - } -} - -# == Subscribe users to the current list == -sub sub { - my($self, @addresses) = @_; - ($self->_seterror(-1, 'sub() must be called with at least one address') && return 0) unless @addresses; - my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/); - my($address); - ($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'})); - - if(defined($part) && $part) { - ($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in sub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part"); - foreach $address (@addresses) { - next unless $self->_checkaddress($address); - system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 || - ($self->_seterror($?) && return undef); - } - } else { - foreach $address (@addresses) { - next unless $self->_checkaddress($address); - system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 || - ($self->_seterror($?) && return undef); - } - } - $self->_seterror(undef); - return 1; -} - -# == Unsubscribe users from a list == -sub unsub { - my($self, @addresses) = @_; - ($self->_seterror(-1, 'unsub() must be called with at least one address') && return 0) unless @addresses; - my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/); - my($address); - ($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'})); - - if(defined($part) && $part) { - ($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in unsub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part"); - foreach $address (@addresses) { - next unless $self->_checkaddress($address); - system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 || - ($self->_seterror($?) && return undef); - } - } else { - foreach $address (@addresses) { - next unless $self->_checkaddress($address); - system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 || - ($self->_seterror($?) && return undef); - } - } - $self->_seterror(undef); - return 1; -} - -# == Test whether people are subscribed to the list == -sub issub { - my($self, @addresses) = @_; - my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/); - my($address, $issub); $issub = 1; - ($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'})); - - local $ENV{'SENDER'}; - - if(defined($part) && $part) { - ($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in issub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part"); - foreach $address (@addresses) { - $ENV{'SENDER'} = $address; - undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0) - } - } else { - foreach $address (@addresses) { - $ENV{'SENDER'} = $address; - undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0) - } - } - - $self->_seterror(undef); - return $issub; -} - -# == Is the list posting moderated == -# DEPRECATED: useless - you should better check the appropriate config flag -sub ismodpost { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/modpost"; -} - -# == Is the list subscriber moderated == -# DEPRECATED: useless - you should better check the appropriate config flag -sub ismodsub { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/modsub"; -} - -# == Is the list remote adminable == -# DEPRECATED: useless - you should better check the appropriate config flag -sub isremote { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/remote"; -} - -# == Does the list have a kill list == -# DEPRECATED: useless - you should better check the appropriate config flag -sub isdeny { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/deny"; -} - -# == Does the list have an allow list == -# DEPRECATED: useless - the allow list is always created automatically -sub isallow { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/allow"; -} - -# == Is this a digested list == -# DEPRECATED: useless - you should better check the appropriate config flag -sub isdigest { - my($self) = @_; - ($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'})); - $self->_seterror(undef); - return -e "$self->{'LIST_NAME'}/digest"; -} - -# == retrieve file contents == -sub getpart { - my($self, $part) = @_; - my(@contents, $content); - if(open(PART, "<$self->{'LIST_NAME'}/$part")) { - while() { - chomp($contents[$#contents++] = $_); - $content .= $_; - } - close PART; - if(wantarray) { - return @contents; - } else { - return $content; - } - } ($self->_seterror($?) && return undef); -} - -# == set files contents == -sub setpart { - my($self, $part, @content) = @_; - my($line); - if(open(PART, ">$self->{'LIST_NAME'}/$part")) { - foreach $line (@content) { - $line =~ s/[\r]//g; $line =~ s/\n$//; - print PART "$line\n"; - } - close PART; - return 1; - } ($self->_seterror($?) && return undef); -} - -# == get the configuration directory for this list (idx >= 5.0) == -# return '/etc/ezmlm' for idx < 5.0 -sub get_config_dir { - my ($self) = shift; - my $conf_dir; - if (($self->_get_version() >= 5) && (-e "$self->{'LIST_NAME'}/conf-etc")) { - chomp($conf_dir = $self->getpart('conf-etc')); - } else { - $conf_dir = '/etc/ezmlm'; - } - return $conf_dir; -} - -# == set the configuration directory for this list (idx >= 5.0) == -# return without error for idx < 5.0 -sub set_config_dir { - my ($self, $conf_dir) = @_; - return (0==0) if ($self->_get_version() < 5); - $self->setpart('conf-etc', "$conf_dir"); -} - - -# == get list of available languages (for idx >= 5.0) == -# return empty list for idx < 5.0 -sub get_available_languages { - my ($self) = shift; - my @langs = (); - return @langs if ($self->_get_version() < 5); - - $self->_seterror(undef); - - # check for language directories - my $conf_dir; - ($self->_seterror(-1, 'could not retrieve configuration directory') && return 0) - unless ($conf_dir = $self->get_config_dir()); - if (opendir DIR, "$conf_dir") { - my @dirs; - @dirs = grep !/^\./, readdir DIR; - closedir DIR; - my $item; - foreach $item (@dirs) { - push (@langs, $item) if (-e "$conf_dir/$item/text"); - } - return @langs; - } else { - $self->_seterror(-1, 'could not access configuration directory'); - return 0; - } -} - - -# == get the selected language of the list (idx >= 5.0) == -# return empty string for idx < 5.0 -sub get_lang { - my ($self) = shift; - my $lang; - return '' if ($self->_get_version() < 5); - if (-e "$self->{'LIST_NAME'}/conf-lang") { - chomp($lang = $self->getpart('conf-lang')); - } else { - $lang = 'default'; - } - return $lang; -} - - -# == set the selected language of the list (idx >= 5.0) == -# return without error for idx < 5.0 -sub set_lang { - my ($self, $lang) = @_; - return (0==0) if ($self->_get_version() < 5); - $self->setpart('conf-lang', "$lang"); -} - - -# == get list of available text files == -sub get_available_text_files { - my ($self) = shift; - my @files; - my $item; - my %seen = (); - - # customized text files of this list (idx >= 5.0) - # OR text files of this list (idx < 5.0) - if (opendir DIR, "$self->{'LIST_NAME'}/text") { - my @local_files = grep !/^\./, readdir DIR; - closedir DIR; - foreach $item (@local_files) { - unless ($seen{$item}) { - push (@files, $item); - $seen{$item} = 1; - } - } - } - - # default text files (only idx >= 5.0) - if (($self->_get_version() >= 5) && (opendir GLOBDIR, $self->get_config_dir . '/' . $self->get_lang())) { - my @global_files = grep !/^\./, readdir GLOBDIR; - closedir GLOBDIR; - foreach $item (@global_files) { - unless ($seen{$item}) { - push (@files, $item); - $seen{$item} = 1; - } - } - } - - if ($#files > 0) { - return @files; - } else { - $self->_seterror(-1, 'no textfiles found'); - return undef; - } -} - -# == get text file content == -sub get_text_content { - my ($self, $textfile) = @_; - - if (-e "$self->{'LIST_NAME'}/text/$textfile") { - return $self->getpart("text/$textfile"); - } elsif ($self->_get_version >= 5) { - my $filename = $self->get_config_dir() . '/' . $self->get_lang() . "/text/$textfile"; - my @contents; - my $content; - if (open(PART, "<$filename")) { - while() { - chomp($contents[$#contents++] = $_); - $content .= $_; - } - close PART; - if(wantarray) { - return @contents; - } else { - return $content; - } - } else { - $self->_seterror($?, "could not open $filename"); - return undef; - } - } else { - $self->_seterror(-1, "could not get the text file ($textfile)"); - return undef; - } -} - - -# == set text file content == -sub set_text_content { - my ($self, $textfile, @content) = @_; - mkdir "$self->{'LIST_NAME'}/text" unless (-e "$self->{'LIST_NAME'}/text"); - $self->setpart("text/$textfile", @content); -} - - -# == check if specified text file is customized or default (for idx >= 5.0) == -# return whether the text file exists in the list's directory (false) or not (true) -sub is_text_default { - my ($self, $textfile) = @_; - return (0==1) if ($textfile eq ''); - if (-e "$self->{'LIST_NAME'}/text/$textfile") { - return (1==0); - } else { - return (0==0); - } -} - -# == remove non-default text file (for idx >= 5.0) == -# return without error for idx < 5 -# otherwise: remove customized text file from the list's directory -sub reset_text { - my ($self, $textfile) = @_; - return if ($self->_get_version() < 5); - return if ($textfile eq ''); - return if ($textfile =~ /[^\w_\.-]/); - return if ($self->is_text_default($textfile)); - ($self->_seterror(-1, "could not remove customized text file ($textfile)") && return 0) - unless unlink("$self->{'LIST_NAME'}/text/$textfile"); -} - - -# == return an error message if appropriate == -sub errmsg { - my($self) = @_; - return $self->{'ERRMSG'}; -} - -sub errno { - my($self) = @_; - return $self->{'ERRNO'}; -} - -# == Test the compatiblity of the module == -sub check_version { - my($self) = @_; - my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`; - $self->_seterror(undef); - - # ezmlm-idx is necessary - if ($self->_get_version() >= 4) { - return 0; - } else { - return $version; - } -} - -# == get the major ezmlm version == -# return values: -# 0 => unknown version -# 3 => ezmlm v0.53 -# 4 => ezmlm-idx v0.4* -# 5 => ezmlm-idx v5.* -sub _get_version { - my($self) = @_; - my ($ezmlm, $idx); - my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`; - $self->_seterror(undef); - - $version = $1 if ($version =~ m/^[^:]*:\s+(.*)$/); - $ezmlm = $1 if ($version =~ m/ezmlm-([\d\.]+)$/); - $idx = $1 if ($version =~ m/ezmlm-idx-([\d\.]+)$/); - - if(defined($ezmlm)) { - return 3; - } elsif (defined($idx)) { - if (($idx =~ m/^(\d)/) && ($1 >= 5)) { - # version 5.0 or higher - return 5; - } elsif (($idx =~ m/^0\.(\d)/) && ($1 >= 0)) { - # version 0.4 or higher - return 4; - } else { - return 0; - } - } else { - return 0; - } -} - -# == Create SQL Database tables if defined for a list == -sub createsql { - my($self) = @_; - - ($self->_seterror(-1, 'MySQL must be compiled into Ezmlm for createsql() to work') && return 0) unless(defined($MYSQL_BASE) && $MYSQL_BASE); - ($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'})); - my($config) = $self->getconfig(); - - if($config =~ m/-6\s+'(.+?)'\s*/){ - my($sqlsettings) = $1; - my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6); - - ($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0) - unless (defined($host) && defined($port) && defined($user) - && defined($password) && defined($database) && defined($table)); - - system("$EZMLM_BASE/ezmlm-mktab -d $table | $MYSQL_BASE/mysql -h$host -P$port -u$user -p$password -f $database") == 0 || - ($self->_seterror($?) && return undef); - - } else { - $self->_seterror(-1, 'config for thislist() must include SQL options'); - return 0; - } - - ($self->_seterror(undef) && return 1); - -} - - -# == Internal function to set the error to return == -sub _seterror { - my($self, $no, $mesg) = @_; - - if(defined($no) && $no) { - if($no < 0) { - $self->{'ERRNO'} = -1; - $self->{'ERRMSG'} = $mesg || 'An undefined error occoured'; - } else { - $self->{'ERRNO'} = $no / 256; - $self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call'; - } - } else { - $self->{'ERRNO'} = 0; - $self->{'ERRMSG'} = undef; - } - return 1; -} - -# == Internal function to test for valid email addresses == -sub _checkaddress { - my($self, $address) = @_; - return 1 unless defined($address); - return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/); - $_[1] = $1; - return 1; -} - -# == Internal function to work out a list configuration (idx >= v5.0) == -sub _getconfig_idx5 { - my($self) = @_; - my ($options, %optionfiles); - my ($file, $opt_num, $temp); - - # read flag file (available since ezmlm-idx 5.0.0) - chomp($options = $self->getpart('flags')); - # remove prefixed '-' - $options =~ s/^-//; - - # since ezmlm-idx v5, we have to read the config - # values from different files - # first: preset a array with "filename" and "option_number" - %optionfiles = ( - 'sublist', '0', - 'fromheader', '3', - 'tstdigopts', '4', - 'owner', '5', - 'sql', '6', - 'modpost', '7', - 'modsub', '8'); - # "-9" seems to be ignored - this is a good change (tm) - while (($file, $opt_num) = each(%optionfiles)) { - if (-e "$self->{'LIST_NAME'}/$file") { - chomp($temp = $self->getpart($file)); - $options .= " -$opt_num '$temp'" if ($temp ne ''); - } - } - - return $options; -} - -# == Internal function to work out a list configuration manually (idx < v5.0.0 ) == -sub _getconfigmanual { - # use this function for strange lists without - # 'config' (idx < v5.0) and 'flags' (idx >= v5.0) - my($self) = @_; - my ($savedollarslash, $options, $manager, $editor, $i); - - # Read the whole of DIR/editor and DIR/manager in - $savedollarslash = $/; - undef $/; - # $/ = \0777; - - open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef); - open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef); - $editor = ; $manager = ; - close(EDITOR), close(MANAGER); - - $/ = $savedollarslash; - - $options = ''; - $options .= 'a' if (-e "$self->{'LIST_NAME'}/archived"); - $options .= 'd' if (-e "$self->{'LIST_NAME'}/digest"); - $options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix"); - $options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ ); - $options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed"); - $options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny"); - $options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ ); - $options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost"); - $options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ ); - $options .= 'p' if (-e "$self->{'LIST_NAME'}/public"); - $options .= 'q' if ($manager =~ /ezmlm-request/ ); - $options .= 'r' if (-e "$self->{'LIST_NAME'}/remote"); - $options .= 's' if (-e "$self->{'LIST_NAME'}/modsub"); - $options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer"); - $options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ ) - || $editor =~ /ezmlm-gate/ ); - $options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow"); - - # Add the unselected options too - # but we will skip invalid options (any of 'cevz') - foreach $i ('a' .. 'z') { - $options .= uc($i) unless (('cevz' =~ /$i/) || ($options =~ /$i/i)) - } - - # there is no way to get the other string settings, that are only - # defined in 'config' - sorry ... - - return $options; -} - -# == Internal Function to try to determine the vhost user == -sub _getvhostuser { - my($self, $hostname) = @_; - my($username); - - open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef); - while() { - last if(($username) = /^\s*$hostname:(\w+)$/); - } - close VD; - - return $username; -} - -# == Internal function to work out default host name == -sub _getdefaultdomain { - my($self) = @_; - my($hostname); - - open (GETHOST, "<$QMAIL_BASE/control/defaultdomain") - || open (GETHOST, "<$QMAIL_BASE/control/me") - || ($self->_seterror($?) && return undef); - chomp($hostname = ); - close GETHOST; - - return $hostname; -} - -1; -__END__ - -=head1 NAME - -Ezmlm - Object Methods for Ezmlm Mailing Lists - -=head1 SYNOPSIS - - use Mail::Ezmlm; - $list = new Mail::Ezmlm; - -The rest is a bit complicated for a Synopsis, see the description. - -=head1 ABSTRACT - -Ezmlm is a Perl module that is designed to provide an object interface to -the ezmlm mailing list manager software. See the ezmlm web page -(http://www.ezmlm.org/) for a complete description of the software. - -This version of the module is designed to work with ezmlm version 0.53. -It is fully compatible with ezmlm's IDX extensions (version 0.40). Both -of these can be obtained via anon ftp from ftp://ftp.ezmlm.org/pub/patches/ - -=head1 DESCRIPTION - -=head2 Setting up a new Ezmlm object: - - use Mail::Ezmlm; - $list = new Mail::Ezmlm; - $list = new Mail::Ezmlm('/home/user/lists/moolist'); - -=head2 Changing which list the Ezmlm object points at: - - - $list->setlist('/home/user/lists/moolist'); - -=head2 Getting a list of current subscribers: - -=item Two methods of listing subscribers is provided. The first prints a list -of subscribers, one per line, to the supplied FILEHANDLE. If no filehandle is -given, this defaults to STDOUT. An optional second argument specifies the -part of the list to display (mod, digest, allow, deny). If the part is -specified, then the FILEHANDLE must be specified. - - $list->list; - $list->list(\*STDERR); - $list->list(\*STDERR, 'deny'); - -=item The second method returns an array containing the subscribers. The -optional argument specifies which part of the list to display (mod, digest, -allow, deny). - - @subscribers = $list->subscribers; - @subscribers = $list->subscribers('allow'); - -=head2 Testing for subscription: - - $list->issub('nobody@on.web.za'); - $list->issub(@addresses); - $list->issub(@addresses, 'mod'); - -issub() returns 1 if all the addresses supplied are found as subscribers -of the current mailing list, otherwise it returns undefined. The optional -argument specifies which part of the list to check (mod, digest, allow, -deny). - -=head2 Subscribing to a list: - - $list->sub('nobody@on.web.za'); - $list->sub(@addresses); - $list->sub(@addresses, 'digest'); - -sub() takes a LIST of addresses and subscribes them to the current mailing list. -The optional argument specifies which part of the list to subscribe to (mod, -digest, allow, deny). - - -=head2 Unsubscribing from a list: - - $list->unsub('nobody@on.web.za'); - $list->unsub(@addresses); - $list->unsub(@addresses, 'mod'); - -unsub() takes a LIST of addresses and unsubscribes them (if they exist) from the -current mailing list. The optional argument specifies which part of the list -to unsubscribe from (mod, digest, allow, deny). - - -=head2 Creating a new list: - - $list->make(-dir=>'/home/user/list/moo', - -qmail=>'/home/user/.qmail-moo', - -name=>'user-moo', - -host=>'on.web.za', - -user=>'onwebza', - -switches=>'mPz'); - -make() creates the list as defined and sets it to the current list. There are -three variables which must be defined in order for this to occur; -dir, -qmail and -name. - -=over 6 - -=item -dir is the full path of the directory in which the mailing list is to -be created. - -=item -qmail is the full path and name of the .qmail file to create. - -=item -name is the local part of the mailing list address (eg if your list -was user-moo@on.web.za, -name is 'user-moo'). - -=item -host is the name of the host that this list is being created on. If -this item is omitted, make() will try to determine your hostname. If -host is -not the same as your hostname, then make() will attempt to fix DIR/inlocal for -a virtual host. - -=item -user is the name of the user who owns this list. This item only needs to -be defined for virtual domains. If it exists, it is prepended to -name in DIR/inlocal. -If it is not defined, the make() will attempt to work out what it should be from -the qmail control files. - -=item -switches is a list of command line switches to pass to ezmlm-make(1). -Note that the leading dash ('-') should be ommitted from the string. - -=back - -make() returns the value of thislist() for success, undefined if there was a -problem with the ezmlm-make system call and 0 if there was some other problem. - -See the ezmlm-make(1) man page for more details - -=head2 Determining which list we are currently altering: - - $whichlist = $list->thislist; - print $list->thislist; - -=head2 Getting the current configuration of the current list: - - $list->getconfig; - -getconfig() returns a string that contains the command line switches that -would be necessary to re-create the current list. It does this by reading the -DIR/config file (idx < v5.0) or DIR/flags (idx >= v5.0) if one of them exists. -If it can't find these files it attempts to work things out for itself (with -varying degrees of success). If both these methods fail, then getconfig() -returns undefined. - - $list->ismodpost; - $list->ismodsub; - $list->isremote; - $list->isdeny; - $list->isallow; - -The above five functions test various features of the list, and return a 1 -if the list has that feature, or a 0 if it doesn't. These functions are -considered DEPRECATED as their result is not reliable. Use "getconfig" instead. - -=head2 Updating the configuration of the current list: - - $list->update('msPd'); - -update() can be used to rebuild the current mailing list with new command line -options. These options can be supplied as a string argument to the procedure. -Note that you do not need to supply the '-' or the 'e' command line switch. - - @part = $list->getpart('headeradd'); - $part = $list->getpart('headeradd'); - $list->setpart('headerremove', @part); - -getpart() and setpart() can be used to retrieve and set the contents of -various text files such as headeradd, headerremove, mimeremove, etc. - -=head2 Manage language dependent text files - - $list->get_available_text_files; - $list->get_text_content('sub-ok'); - $list->set_text_content('sub-ok', @content); - -These functions allow you to manipulate the text files, that are used for -automatic replies by ezmlm. - - $list->is_text_default('sub-ok'); - $list->reset_text('sub-ok'); - -These two functions are available if you are using ezmlm-idx v5.0 or higher. -is_text_default() checks, if there is a customized text file defined for this list. -reset_text() removes the customized text file from this list. Ezmlm-idx will use -system-wide default text file, if there is no customized text file for this list. - -=head2 Change the list's settings (for ezmlm-idx >= 5.0) - - $list->get_config_dir; - $list->set_config_dir('/etc/ezmlm-local'); - -These function access the file 'conf-etc' in the mailing list's directory. - - $list->get_available_languages; - $list->get_lang; - $list->set_lang('de'); - -These functions allow you to change the language of the text files, that are used -for automatic replies of ezmlm-idx (v5.0 or higher, the configured language is stored -in 'conf-lang' within the mailing list's directory). Customized files (in the 'text' -directory of a mailing list directory) override the default language setting. - -=head2 Creating MySQL tables: - - $list->createsql(); - -Currently only works for MySQL. - -createsql() will attempt to create the table specified in the SQL connect -options of the current mailing list. It will return an error if the current -mailing list was not configured to use SQL, or is Ezmlm was not compiled -with MySQL support. See the MySQL info pages for more information. - -=head2 Checking the Mail::Ezmlm and ezmlm version numbers - -The version number of the Mail::Ezmlm module is stored in the variable -$Mail::Ezmlm::VERSION. The compatibility of this version of Mail::Ezmlm -with your system installed version of ezmlm can be checked with - - $list->check_version(); - -This returns 0 for compatible, or the version string of ezmlm-make(2) if -the module is incompatible with your set up. - -=head1 RETURN VALUES - -All of the routines described above have return values. 0 or undefined are -used to indicate that an error of some form has occoured, while anything ->0 (including strings, etc) are used to indicate success. - -If an error is encountered, the functions - - $list->errno(); - $list->errmsg(); - -can be used to determine what the error was. - -errno() returns; 0 or undef if there was no error. - -1 for an error relating to this module. - >0 exit value of the last system() call. - -errmsg() returns a string containing a description of the error ($! if it -was from a system() call). If there is no error, it returns undef. - -For those who are interested, in those sub routines that have to make system -calls to perform their function, an undefined value indicates that the -system call failed, while 0 indicates some other error. Things that you would -expect to return a string (such as thislist()) return undefined to indicate -that they haven't a clue ... as opposed to the empty string which would mean -that they know about nothing :) - -=head1 AUTHOR - - Guy Antony Halse - -=head1 BUGS - - May have problems with newer versions of Perl. - - Please report bugs to the author. - -=head1 SEE ALSO - - ezmlm(5), ezmlm-make(2), ezmlm-sub(1), - ezmlm-unsub(1), ezmlm-list(1), ezmlm-issub(1) - - http://rucus.ru.ac.za/~guy/ezmlm/ - http://www.ezmlm.org/ - http://www.qmail.org/ - -=cut diff --git a/Ezmlm/trunk/MANIFEST b/Ezmlm/trunk/MANIFEST deleted file mode 100644 index 8bcd77d..0000000 --- a/Ezmlm/trunk/MANIFEST +++ /dev/null @@ -1,7 +0,0 @@ -Changes -Ezmlm.pm -MANIFEST -README -Makefile.PL -test.pl -META.yml diff --git a/Ezmlm/trunk/META.yml b/Ezmlm/trunk/META.yml deleted file mode 100644 index f050e61..0000000 --- a/Ezmlm/trunk/META.yml +++ /dev/null @@ -1,10 +0,0 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Ezmlm -version: 0.05 -version_from: Ezmlm.pm -installdirs: site -requires: - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 diff --git a/Ezmlm/trunk/Makefile.PL b/Ezmlm/trunk/Makefile.PL deleted file mode 100644 index 7e6f918..0000000 --- a/Ezmlm/trunk/Makefile.PL +++ /dev/null @@ -1,119 +0,0 @@ -# $Id: Makefile.PL,v 1.3 2005/03/05 14:15:20 guy Exp $ - -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'CONFIGURE' => \&set_paths, - 'NAME' => 'Mail::Ezmlm', - 'VERSION_FROM' => 'Ezmlm.pm', # finds $VERSION - 'DISTNAME' => 'Ezmlm', - 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' }, - 'clean' => { FILES => 'ezmlmtmp' } -); - -sub set_paths { - my($qmail_path, $ezmlm_path); - - # special case to handle the FreeBSD ports system - if ($ENV{BSD_BATCH_INSTALL}) { - print STDERR "\$BSD_BATCH_INSTALL is set in your environment, assuming port defaults\n"; - return {}; - } - - print << 'EOM'; - -We now need to know where some things live on your system. I'll try and make -some intelligent guesses - if I get it right, please just press enter at the -prompt. If I get them wrong, please type in the correct path for me and then -press enter. - -First I need to know where the Ezmlm binaries live (ie where I can find -ezmlm-make, ezmlm-sub, etc). - -EOM - - *prompt = \&ExtUtils::MakeMaker::prompt; - - foreach (1..10) { - $ezmlm_path = prompt('Ezmlm binary directory?', '/usr/local/bin'); - last if (-e "$ezmlm_path/ezmlm-make"); - print "I can't find $ezmlm_path/ezmlm-make. Please try again\n"; - if (! -e "$ezmlm_path/ezmlm-make") { - print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n"; - exit (2); - } - } - - print << 'EOM'; - -Now I need to know where Qmail resides on your system. The Qmail base -directory is the one in which the Qmail bin, control, etc directories -live in. - -EOM - - foreach (1..10) { - $qmail_path = prompt('Qmail base directory?', '/var/qmail'); - last if (-d "$qmail_path/control"); - print "I can't find $qmail_path/control. Please try again\n"; - if (! -e "$qmail_path/control") { - print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n"; - exit (2); - } - } - - if(`strings $ezmlm_path/ezmlm-sub | grep -i 'MySQL'`) { - - print << 'EOM'; - -It appears you have compiled MySQL support into your version of Ezmlm. If -this is correct, I now need to know where the MySQL client (mysql) lives on -your machine. - -Please leave this blank if you do not want to enable MySQL support in the -Mail::Ezmlm module. - -EOM - - foreach (1..10) { - $mysql_path = prompt('MySQL binary directory?', ''); - last if (-e "$mysql_path/mysql" || $mysql_path eq ''); - print "I can't find $mysql_path/mysql. Please enter the full path\n"; - print "or leave this option blank if you don't want to use MySQL\n"; - if ((! -e "$mysql_path/mysql") && ($mysql_path ne '')) { - print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n"; - exit (2); - } - } - - } - - print << 'EOM'; - -Thank you. I will use this information to configure Mail::Ezmlm for you - -EOM - - # Back up file - open(EZMLM, 'Ezmlm.pm.tmp.$$") or die "Unable to create temp file: $!"; - while() { print TMP; } - close TMP; close EZMLM; - - # Do variable substitution - open(EZMLM, '>Ezmlm.pm') or die "Unable to open Ezmlm.pm for write: $!"; - open(TMP, ") { - s{^\$EZMLM_BASE\s*=\s*['"].+?['"]\s*;}{\$EZMLM_BASE = '$ezmlm_path'; #Autoinserted by Makefile.PL}; - s{^\$QMAIL_BASE\s*=\s*['"].+?['"]\s*;}{\$QMAIL_BASE = '$qmail_path'; #Autoinserted by Makefile.PL}; - s{^\$MYSQL_BASE\s*=\s*['"].*?['"]\s*;}{\$MYSQL_BASE = '$mysql_path'; #Autoinserted by Makefile.PL}; - print EZMLM; - } - close TMP; close EZMLM; - - unlink "Ezmlm.pm.tmp.$$"; - - return {}; - -} diff --git a/Ezmlm/trunk/README b/Ezmlm/trunk/README deleted file mode 100644 index 3b2046a..0000000 --- a/Ezmlm/trunk/README +++ /dev/null @@ -1,22 +0,0 @@ -$Id: README,v 1.3 2005/03/05 14:14:06 guy Exp $ - -Ezmlm.pm - -Object methods for ezmlm mailing lists. - -Install by doing the following ... -# perl Makefile.PL -# make test -# make install - -One thing. For some reason MakeMaker doesn't like symlinks. Please make sure -you use the full cantonical path for the qmail and ezmlm binaries. - -Documentation is in pod format. Please run perldoc Mail::Ezmlm after you have -installed it. - -Much as I'd like to, I don't have the time to regularly maintain this. New -releases are infrequent at best. Check http://guy.rucus.net/ezmlm/contrib/ -for patches, etc that may be useful. - -- Guy Antony Halse diff --git a/Ezmlm/trunk/test.pl b/Ezmlm/trunk/test.pl deleted file mode 100644 index 39b1670..0000000 --- a/Ezmlm/trunk/test.pl +++ /dev/null @@ -1,234 +0,0 @@ -# =========================================================================== -# test.pl - version 0.02 - 25/09/2000 -# $Id: test.pl,v 1.5 2005/03/05 14:08:30 guy Exp $ -# Test suite for Mail::Ezmlm -# -# Copyright (C) 1999, Guy Antony Halse, All Rights Reserved. -# Please send bug reports and comments to guy-ezmlm@rucus.ru.ac.za -# -# This program is subject to the restrictions set out in the copyright -# agreement that can be found in the Ezmlm.pm file in this distribution -# -# ========================================================================== -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -$failed = 0; - -BEGIN { $| = 1; print "1..9\n"; } -END {($failed++ && print "not ok 1\n") unless $loaded;} -use Mail::Ezmlm; -$loaded = 1; -print "Loading: ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - -use Cwd; -use File::Find; -$list = new Mail::Ezmlm; - -# create a temp directory if necessary -$TMP = cwd() . '/ezmlmtmp'; -mkdir $TMP, 0755 unless (-d $TMP); - -print 'Checking list creation: '; -$test1 = $list->make(-name=>"ezmlm-test1-$$", - -qmail=>"$TMP/.qmail-ezmlm-test1-$$", - -dir=>"$TMP/ezmlm-test1-$$"); -if($test1 eq "$TMP/ezmlm-test1-$$") { - print "ok 2\n"; -} else { - print 'not ok 2 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Checking vhost list creation: '; -$test2 = $list->make(-name=>"ezmlm-test2-$$", - -qmail=>"$TMP/.qmail-ezmlm-test2-$$", - -dir=>"$TMP/ezmlm-test2-$$", - -host=>'on.web.za', - -user=>'onwebza'); -if($test2 eq "$TMP/ezmlm-test2-$$") { - open(INLOCAL, "<$TMP/ezmlm-test2-$$/inlocal"); - chomp($test2 = ); - close INLOCAL; - if($test2 eq "onwebza-ezmlm-test2-$$") { - print "ok 3\n"; - } else { - print 'not ok 3 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print 'not ok 3 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing list update: '; -if($list->update('ms')) { - print "ok 4\n"; -} else { - print 'not ok 4 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing setlist() and thislist(): '; -$list->setlist("$TMP/ezmlm-test1-$$"); -if($list->thislist eq "$TMP/ezmlm-test1-$$") { - print "ok 5\n"; -} else { - print 'not ok 5 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing list subscription and subscription listing: '; -$list->sub('nobody@on.web.za'); -$list->sub('anonymous@on.web.za', 'test@on.web.za'); -@subscribers = $list->subscribers; -if($subscribers[1] =~ /nobody\@on.web.za/) { - print "ok 6\n"; -} else { - print 'not ok 6 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing issub(): '; -if(defined($list->issub('nobody@on.web.za'))) { - if(defined($list->issub('some@non.existant.address'))) { - print 'not ok 7 [', $list->errmsg(), "]\n"; - $failed++; - } else { - print "ok 7\n"; - } -} else { - print 'not ok 7 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing list unsubscription: '; -$list->unsub('nobody@on.web.za'); -$list->unsub('anonymous@on.web.za', 'test@on.web.za'); -@subscribers = $list->subscribers; -unless(@subscribers) { - print "ok 8\n"; -} else { - print 'not ok 8 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing installed version of ezmlm: '; -my($version) = $list->check_version(); -if ($version) { - $version =~ s/\n//; - print 'not ok 9 [Warning: Ezmlm.pm is designed to work with ezmlm-idx > 0.40. Your version reports as: ', $version, "]\n"; -} else { - print "ok 9\n"; -} - -print 'Testing retrieving of text files: '; -if ($list->get_text_content('sub-ok') ne '') { - print "ok 10\n"; -} else { - print 'not ok 10 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing changing of text files: '; -$list->set_text_content('sub-ok', "testing message\n"); -if ($list->get_text_content('sub-ok') eq "testing message\n") { - print "ok 11\n"; -} else { - print 'not ok 11 [', $list->errmsg(), "]\n"; - $failed++; -} - -print 'Testing if text file is marked as customized (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - if ($list->is_text_default('sub-ok')) { - print 'not ok 12 [', $list->errmsg(), "]\n"; - $failed++; - } else { - print "ok 12\n"; - } -} else { - print "ok 12 [skipped]\n"; -} - -print 'Testing resetting text files (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - $list->reset_text('sub-ok'); - if ($list->is_text_default('sub-ok')) { - print "ok 13\n"; - } else { - print 'not ok 13 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print "ok 13 [skipped]\n"; -} - -print 'Testing retrieving available languages (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - my @avail_langs = $list->get_available_languages(); - if ($#avail_langs > 0) { - print "ok 14\n"; - } else { - print 'not ok 14 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print "ok 14 [skipped]\n"; -} - -print 'Testing changing the configured language (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - my @avail_langs = $list->get_available_languages(); - $list->set_lang($avail_langs[$#avail_langs-1]); - if ($list->get_lang() eq $avail_langs[$#avail_langs-1]) { - print "ok 15\n"; - } else { - print 'not ok 15 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print "ok 15 [skipped]\n"; -} - -print 'Testing getting the configuration directory (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - if ($list->get_config_dir() ne '') { - print "ok 16\n"; - } else { - print 'not ok 16 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print "ok 16 [skipped]\n"; -} - -print 'Testing changing the configuration directory (only idx >= 5.0): '; -if ($list->_get_version >= 5) { - $list->set_config_dir('/etc/ezmlm-local'); - if ($list->get_config_dir() eq '/etc/ezmlm-local') { - print "ok 17\n"; - } else { - print 'not ok 17 [', $list->errmsg(), "]\n"; - $failed++; - } -} else { - print "ok 17 [skipped]\n"; -} - -if($failed > 0) { - print "\n$failed tests were failed\n"; - exit $failed; -} else { - print "\nSuccessful :-)\n"; - finddepth(sub { (-d $File::Find::name) ? rmdir ($File::Find::name) : unlink ($File::Find::name) }, cwd() . "/ezmlmtmp"); - exit; -}