# $Id$ # Mailman page Perl template. # Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; exactly version 2 of June 1991 is required # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA package Mailman; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway use vars qw($VERSION $CVS_ID); $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; $CVS_ID=q$Id$; use strict; use warnings; use My::Web; use URI::Escape; require LWP::Simple; our $HTML_TEST=0; # TODO: Provide some real URLs for download/translation. our $HTML_TEST_QUERY_STRING="list=html_test"; sub handler { my $W=My::Web->init( "title"=>"Mailman Interface", "no_job"=>1, "args_check"=>{ "email"=>'', "pw"=>'', "pw-conf"=>'', "list"=>['^[-\w]+$'], "back"=>'', }, "http_safe"=>0, # LWP downloads. # Mailman does not produce valid XHTML. "content_type"=>"text/html", ); My::Web->heading(); for my $list (@{$W->{"args"}{"list"}}) { print "

List $list

\n"; my $url_base=$W->{"mailman_url"}."/subscribe/$list"; my $url=URI->new($url_base); $url->query_form( "list"=>$list, map(($_=>$W->{"args"}{$_}),qw(email pw pw-conf)), ); my $t=LWP::Simple::get($url); $t=($t=~m#^.*]*>(.*?)#is)[0]; $t=~s#(href=")(../[^"]*)(")#$1$url_base/$2$3#gi; print $t; print "
\n"; } if ($W->{"args"}{"back"}) { print '

'.a_href($W->{"args"}{"back"},'Back to the original page').'

'."\n"; } exit; } 1;