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:
lars 2006-01-02 22:52:54 +00:00
parent c39cb18be6
commit 9990c05f4a
3 changed files with 348 additions and 10 deletions

View file

@ -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)

View file

@ -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) = @_;
@ -437,29 +624,47 @@ sub errno {
# == Test the compatiblity of the module ==
sub check_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;
} elsif (defined($idx)) {
if (($idx =~ m/^(\d)/) && ($1 >= 5)) {
# version 5.0 or higher
return 0;
} elsif (($idx =~ m/^0\.(\d)/) && ($1 >= 0)) {
# version 0.4 or higher
# 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 $version;
return 0;
}
} else {
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();

View file

@ -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;