added new functions for text file management
added new functions for the language setting (for idx >= 5.0) added new functions for the configuration directory setting (for idx >= 5.0)
This commit is contained in:
parent
c39cb18be6
commit
9990c05f4a
|
|
@ -34,3 +34,8 @@ Revision history for Perl extension Mail::Ezmlm.
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -140,7 +140,7 @@ sub update {
|
|||
foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) {
|
||||
next if (!defined($_) or !$_ or $_ eq ' ');
|
||||
# untaint input
|
||||
$_ =~ m/^([\w _\/,\.@:'"-]*)$/;
|
||||
$_ =~ m/^([\w _\/,\.\@:'"-]*)$/;
|
||||
push @switches, $1;
|
||||
}
|
||||
|
||||
|
|
@ -344,6 +344,7 @@ sub 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'}));
|
||||
|
|
@ -352,6 +353,7 @@ sub ismodpost {
|
|||
}
|
||||
|
||||
# == 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'}));
|
||||
|
|
@ -360,6 +362,7 @@ sub ismodsub {
|
|||
}
|
||||
|
||||
# == 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'}));
|
||||
|
|
@ -368,6 +371,7 @@ sub isremote {
|
|||
}
|
||||
|
||||
# == 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'}));
|
||||
|
|
@ -376,6 +380,7 @@ sub isdeny {
|
|||
}
|
||||
|
||||
# == 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'}));
|
||||
|
|
@ -384,6 +389,7 @@ sub isallow {
|
|||
}
|
||||
|
||||
# == 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'}));
|
||||
|
|
@ -423,6 +429,187 @@ sub setpart {
|
|||
} ($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(<PART>) {
|
||||
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) = @_;
|
||||
|
|
@ -436,30 +623,48 @@ sub 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);
|
||||
|
||||
#my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+(ezmlm-([\d\.])+|ezmlm-idx-([\d\.]+))$/;
|
||||
$version = $1 if ($version =~ m/^[^:]*:\s+(.*)$/);
|
||||
$ezmlm = $1 if ($version =~ m/ezmlm-([\d\.]+)$/);
|
||||
$idx = $1 if ($version =~ m/ezmlm-idx-([\d\.]+)$/);
|
||||
# ezmlm-idx is required
|
||||
|
||||
if(defined($ezmlm)) {
|
||||
return $version;
|
||||
return 3;
|
||||
} elsif (defined($idx)) {
|
||||
if (($idx =~ m/^(\d)/) && ($1 >= 5)) {
|
||||
# version 5.0 or higher
|
||||
return 0;
|
||||
return 5;
|
||||
} elsif (($idx =~ m/^0\.(\d)/) && ($1 >= 0)) {
|
||||
# version 0.4 or higher
|
||||
return 0;
|
||||
return 4;
|
||||
} else {
|
||||
return $version;
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return $version;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -785,7 +990,8 @@ returns undefined.
|
|||
$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.
|
||||
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:
|
||||
|
||||
|
|
@ -802,6 +1008,39 @@ Note that you do not need to supply the '-' or the 'e' command line switch.
|
|||
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();
|
||||
|
|
|
|||
|
|
@ -125,11 +125,105 @@ print 'Testing installed version of ezmlm: ';
|
|||
my($version) = $list->check_version();
|
||||
if ($version) {
|
||||
$version =~ s/\n//;
|
||||
print 'not ok 9 [Ezmlm.pm is designed to work with ezmlm-idx > 0.40. Your version reports as: ', $version, "]\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;
|
||||
|
|
|
|||
Loading…
Reference in a new issue