[Sam Watkins]
> I am using mailman 2.1 (for the site http://nipl.net/)
> and I found that listadmin 2.27 does not work with this version of mailman.
> So I mangled it to make it work, attached.
>
> it is also at http://sam.nipl.net/all/listadmin/listadmin-mm2.1
I've successfully used the version available from the URL above to
approve messages in mailman versions 2.1, 2.0 and 1.2 (at UiO). I had
to apply a minor patch to get the default URLs for UiO working. I had
to avoid passing a pattern to mailman_url() when $url was undefined.
--- listadmin-mm2.1.orig 2005-12-22 09:47:35.641600679 +0100
+++ listadmin-mm2.1 2005-12-22 09:39:44.647303174 +0100
@@ -419,7 +419,8 @@
my $resp_subscriptions = $ua->post (mailman_url($list, $url),
mailman_params($user, $pw));
$page_subscriptions = $resp_subscriptions->content;
- my $resp_approvals = $ua->post (mailman_url($list, "$url?details=all"),
mailman_params($user, $pw));
+ my $pattern = "$url?details=all" if $url;
+ my $resp_approvals = $ua->post (mailman_url($list, $pattern),
mailman_params($user, $pw));
$page_approvals = $resp_approvals->content;
Here is the patch from Sam Watkins with my minor fix included.
Please make a new release with these fixes included. :)
--- /usr/bin/listadmin 2005-09-30 09:31:42.000000000 +0200
+++ /tmp/listadmin-mm2.1 2005-12-22 09:39:44.647303174 +0100
@@ -1,10 +1,12 @@
#! /usr/bin/perl -w
#
-# listadmin version 2.27
+# listadmin version 2.27 (mangled to work with mailman-2.1)
# Written 2003 - 2005 by
# Kjetil Torgrim Homme <[EMAIL PROTECTED]>
# Released into public domain.
+# mangled by Sam Watkins to work with mailman-2.1
+
use HTML::TokeParser;
use LWP::UserAgent;
use MIME::Base64;
@@ -412,56 +414,77 @@
my %data = ();
my $starttime = time;
- my $page;
+ my $page_subscriptions;
+ my $page_approvals;
+
+ my $resp_subscriptions = $ua->post (mailman_url($list, $url),
mailman_params($user, $pw));
+ $page_subscriptions = $resp_subscriptions->content;
+ my $pattern = "$url?details=all" if $url;
+ my $resp_approvals = $ua->post (mailman_url($list, $pattern),
mailman_params($user, $pw));
+ $page_approvals = $resp_approvals->content;
- my $resp = $ua->post (mailman_url($list, $url), mailman_params($user,
$pw));
- $page = $resp->content;
# save it for eased debug for the developer...
- if ($< == 1232 && open (DUMP, ">/tmp/dump-$list.html")) {
- print DUMP $page;
- close (DUMP);
+ my $dumpdir = $config->{$list}{"dumpdir"};
+ if (defined $dumpdir) {
+ if (open (DUMP, ">$dumpdir/dump-subs-$list.html")) {
+ print DUMP $page_subscriptions;
+ close (DUMP);
+ }
+ if (open (DUMP, ">$dumpdir/dump-held-$list.html")) {
+ print DUMP $page_approvals;
+ close (DUMP);
+ }
}
- unless ($resp->is_success) {
- print STDERR $resp->error_as_HTML;
- return ();
+ for my $resp ($resp_subscriptions, $resp_approvals) {
+ unless ($resp->is_success) {
+ print STDERR $resp->error_as_HTML;
+ return ();
+ }
}
+
+ my $mmver = 2.1; # not negotiable!
+ for my $page ($page_subscriptions, $page_approvals) {
+
my $parse = HTML::TokeParser->new(\$page) || die;
- $parse->get_tag ("title") || die;
- my $title = $parse->get_trimmed_text ("/title") || die;
- if ($title =~ /authentication/i) {
- print STDERR
- "Unable to log in. Is your username and password correct?\n";
- return ();
+ if ($page =~ /<title>/) {
+ $parse->get_tag ("title") || die;
+ my $title = $parse->get_trimmed_text ("/title") || die;
+ if ($title =~ /authentication/i) {
+ print STDERR
+ "Unable to log in. Is your username and password
correct?\n";
+ return ();
+ }
}
- my $mmver;
$parse->get_tag ("hr");
- $parse->get_tag ("h2") || return ();
+ $parse->get_tag ("h2") || next;
my $headline = $parse->get_trimmed_text ("/h2") || die;
if ($headline =~ /subscription/i) {
parse_subscriptions ($parse, \%data);
my $token = $parse->get_token;
- if (lc ($token->[1]) eq "input") {
- return () unless parse_footer ($parse, \%data, $mmver);
- return (\%data);
- } else {
+ $token = $parse->get_token if
+ $token->[0] eq "S" && lc ($token->[1]) eq "center";
+ unless (lc ($token->[1]) eq "input") {
$parse->get_tag ("h2") || die;
$headline = $parse->get_trimmed_text ("/h2") || die;
}
}
if ($headline =~ /held for approval/i) {
- $mmver = parse_approvals ($parse, \%data);
+ my $_mmver = parse_approvals ($parse, \%data);
+# $mmver ||= $_mmver;
} else {
$parse->get_tag ("hr") || die;
my $token = $parse->get_token;
if ($token->[0] eq "S" && lc ($token->[1]) eq "center") {
- $mmver = parse_approvals ($parse, \%data);
+ my $_mmver = parse_approvals ($parse, \%data);
+# $mmver ||= $_mmver;
}
}
- return () unless parse_footer ($parse, \%data, $mmver);
+ next unless parse_footer ($parse, \%data, $mmver);
+ }
return (\%data);
}
@@ -504,6 +527,8 @@
$parse->get_tag ("/table");
$parse->get_tag ("hr");
$token = $parse->get_token;
+ $token = $parse->get_token if
+ $token->[0] eq "S" && lc ($token->[1]) eq "center";
} until ($token->[0] eq "S" && lc ($token->[1]) eq "input");
return ($mmver);
}
@@ -599,7 +624,7 @@
$data->{$id}->{"date"} = $1
if $headers =~ /^Date: (.*)$/m;
- if ($mmver == 2) {
+ if ($mmver >= 2) {
$parse->get_tag ("tr") || die; # Message Excerpt
$parse->get_tag ("td") || die;
$parse->get_tag ("textarea") || die;
@@ -620,20 +645,22 @@
sub parse_footer {
my ($parse, $data, $mmver) = @_;
- $parse->get_tag ("address") || die;
- my $text = $parse->get_trimmed_text ("/address") || die;
-
- if ($text =~ /Mailman\s*v(ersion)? (\d+\.\d+)/) {
- if ($mmver && $mmver != 0 + $2) {
- print STDERR "Unknown version of Mailman. First I thought ",
- "this was version $mmver.\n", "Now version ", 0 + $2,
- " looks more likely. Help!\n";
- return (0);
- }
- $mmver = 0 + $2;
- }
+# if ($parse->get_tag ("address")) {
+# my $text = $parse->get_trimmed_text ("/address") || die;
+#
+# if ($text =~ /Mailman\s*v(ersion)? (\d+\.\d+)/) {
+# $mmver = 0+$2;
+# # if ($mmver && $mmver != 0 + $2) {
+# # print STDERR "Unknown version of Mailman. First I thought
",
+# # "this was version $mmver.\n", "Now version ", 0 + $2,
+# # " looks more likely. Help!\n";
+# # return (0);
+# # }
+# # $mmver = 0 + $2;
+# }
+# }
- if ($mmver == 2) {
+ if ($mmver >= 2) {
$data->{"global"}{"actions"} = { "a" => 1,
"r" => 2,
"d" => 3,
@@ -689,6 +716,7 @@
my $count = 0;
my $lineno = 0;
my $logfile;
+ my $dumpdir;
my $confirm = 1;
my $url;
my %patterns = map { $_ => undef; }
@@ -769,15 +797,12 @@
}
$default = $act{$default};
} elsif ($line =~ /^log\s+/i) {
- $logfile = unquote ($'); # ' stupid perl-mode
- $logfile =~ s,^\$HOME/,$ENV{'HOME'}/,;
- $logfile =~ s,^~/,$ENV{'HOME'}/,;
- $logfile =~ s,^~(\w+)/,(getpwnam($1))[7]."/",e;
- if ($logfile =~ /^M:/i) {
- $logfile =~ s,\\,/,g;
- $logfile =~ s,^M:,$ENV{'HOME'},;
+ $logfile = expand_pathname(unquote($')); # ' stupid perl-mode
+ } elsif ($line =~ /^dumpdir\s+/i) {
+ $dumpdir = expand_pathname(unquote($')); # ' stupid perl-mode
+ if (defined $dumpdir) {
+ mkdir $dumpdir;
}
- $logfile = undef if $logfile eq "none";
} elsif ($line =~ /^subscription_action\s+/) {
$subact = unquote ($'); # ' stupid perl-mode
unless (exists $sact{$subact}) {
@@ -817,6 +842,7 @@
"action" => $action,
"default" => $default,
"logfile" => $logfile,
+ "dumpdir" => $dumpdir,
%patterns,
"order" => ++$count,
};
@@ -840,6 +866,20 @@
}
return ($val);
}
+
+sub expand_pathname {
+ my ($pathname) = @_;
+ $pathname =~ s,^\$HOME/,$ENV{'HOME'}/,;
+ $pathname =~ s,^~/,$ENV{'HOME'}/,;
+ $pathname =~ s,^~(\w+)/,(getpwnam($1))[7]."/",e;
+ if ($pathname =~ /^M:/i) {
+ $pathname =~ s,\\,/,g;
+ $pathname =~ s,^M:,$ENV{'HOME'},;
+ }
+ $pathname = undef if $pathname eq "none";
+ return $pathname;
+}
+
sub prompt_for_config {
my ($rc) = @_;
@@ -985,6 +1025,7 @@
sub submit_http {
my ($url, $params, $log, $logfile) = @_;
+ $url =~ s/\?.*//;
my $opened;
if ($logfile) {
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
