diff --git a/Ezmlm/trunk/Changes b/Ezmlm/trunk/Changes index 83e77b0..69bdf62 100644 --- a/Ezmlm/trunk/Changes +++ b/Ezmlm/trunk/Changes @@ -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) diff --git a/Ezmlm/trunk/Ezmlm.pm b/Ezmlm/trunk/Ezmlm.pm index a0cf93e..87bd740 100644 --- a/Ezmlm/trunk/Ezmlm.pm +++ b/Ezmlm/trunk/Ezmlm.pm @@ -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() { + 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(); diff --git a/Ezmlm/trunk/test.pl b/Ezmlm/trunk/test.pl index e8de0ff..39b1670 100644 --- a/Ezmlm/trunk/test.pl +++ b/Ezmlm/trunk/test.pl @@ -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;