Re: mod_perl 2.0 - redirect

Graf László Thu, 06 Apr 2006 04:54:09 -0700

The module's source:

#file:Wimap/Wimap.pm
#----------------------
package Wimap::Wimap;


use strict;
use warnings;

use Apache2::Const -compile => qw(OK);
use Apache2::Log;
use Apache2::RequestIO ();
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::ServerRec ();
use Apache2::SubRequest ();
use AppConfig qw/:argcount/;
use Data::Dumper;
use IO::File;
use MIME::WordDecoder;
use Mail::IMAPClient;
use ModPerl::MethodLookup;

sub datum
{
my $str = $_[0];
my $pattern = "(.+?), (.*?) (.*?) (.*?) (.*?):(.*?):(.*?) [+/-](.*?)";
my $nap_szoveg = '';
my $nap = '';
my $honap = '';
my $ev = '';
my $idopont = '';

if($str =~ m|^.$pattern.$|s)
{
$nap_szoveg = $1||'';
$nap = $2||'';
$honap = $3||'';
$ev = $4||'';
$idopont = $5.':'.$6.':'.$7;
return $ev.". ".$honap." ".$nap.". ".$idopont;
}
else
{
return $str;
}
}

sub handler {

my $config = AppConfig->new();
my $r = shift;
$r->content_type("text/html");
my $log = $r->server->log;

my $hint;
my @modules;
($hint, @modules) = ModPerl::MethodLookup::lookup_method("lookup_uri");

#$log->error(" Wimap: hint '".$hint."'");
$log->error(" Wimap: document_root '".$r->document_root."'");

my $file = $r->document_root."/wimap/index.html";
#$log->error(" Wimap: file '".$file."'");

open(ALLOMANY, ">$file") || die "HIBA ! A(z) muuu.html allomany nemnyithato meg. {$!}";print(ALLOMANY "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0Transitional//EN\">\n<html>\n<head>\n");print(ALLOMANY "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=iso-8859-2\">\n");

print(ALLOMANY "<title>wimap</title>\n");
print(ALLOMANY "<link rel=\"stylesheet\" href=\"index.css\">\n");
print(ALLOMANY "</head>\n");
print(ALLOMANY "<body>\n");

$config->define("EXPUNGE" => { ARGCOUNT => ARGCOUNT_NONE,DEFAULT => 1 },
"SAVEDIR" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "/home/grafl/imap" },
"VERBOSE" => { ARGCOUNT => ARGCOUNT_NONE,DEFAULT => 0 },
"BACKUP" => { ARGCOUNT => ARGCOUNT_NONE,DEFAULT => 0 },
"HOST" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "imap_server_name" },
"AUTHINFO" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "~/.authinfo" },
"PORT" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => 143 },
"USER" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "username" },
"PASSWORD" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "password" },
"MAILBOX" => { ARGCOUNT => ARGCOUNT_ONE, DEFAULT => "INBOX" },
"TO" => { ARGCOUNT => ARGCOUNT_ONE },
"N" => { ARGCOUNT => ARGCOUNT_ONE },
"DUMP" => { ARGCOUNT => ARGCOUNT_NONE },
"CRAMMD5" => { ARGCOUNT => ARGCOUNT_NONE },
# Dangerous!!!
"DELETE_MAILBOX_REALLY" => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0 },
"EXPUNGE_OFTEN" => { ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0 },
);

$config->args();

my $filename = $config->AUTHINFO;
my $afh = new IO::File(glob($filename));

if ($afh)
{
while (my $auth = <$afh>)
{
my %values;
foreach my $keyword (qw/machine login password port/)
{
if ($auth =~ m/$keyword\s+(\S+)/)
{
$values{$keyword} = $1;
}
}

$values{machine} = "" unless defined $values{machine}; # avoid the undefcomparison

next unless $config->HOST() eq $values{machine};
$config->USER($values{login}) if exists $values{login};
$config->PASSWORD($values{password}) if exists $values{password};
$config->PORT($values{port}) if exists $values{port};
}
}

# returns a new, authenticated Mail::IMAPClient object
my $imap = Mail::IMAPClient->new(Server => $config->HOST(),
User => $config->USER(),
Port => $config->PORT(),
Password => $config->PASSWORD(),
Peek => 1,
) or die "Cannot connect: $@";

if ($config->CRAMMD5())
{
my $authmech = "CRAM-MD5";
if ($imap->has_capability($authmech))
{
print(ALLOMANY "Switching to $authmech authentication\n");
$imap->Authmechanism($authmech);
}
}

my $count = 0;

if ($config->DELETE_MAILBOX_REALLY)
{

$imap->delete($config->MAILBOX) or warn "Could not delete mailbox " .$config->MAILBOX . "\n";

}
elsif ($config->BACKUP)
{
my $dir = $config->SAVEDIR;
die "Can't access directory $dir for writing" unless -d $dir && -w $dir;
my @folders = $imap->folders;
foreach my $f (@folders)
{
next if $f =~ /^\./;
$imap->select($f);
unless (-d "$dir/$f")
{
mkdir "$dir/$f" or die "Couldn't create folder $dir/$f";
}
my @msg_list = $imap->search('UNDELETED');
print(ALLOMANY "Saw message list [EMAIL PROTECTED]") if $config->VERBOSE;
foreach my $message (@msg_list)
{
my $filename = "$dir/$f/$message";
next if -e $filename;

print(ALLOMANY "saving message $f/$message to $filename\n") if$config->VERBOSE;

my $data_fh = new IO::File $filename, "w";
my $data = $imap->message_string($message);

warn "Empty message data for $f/$message" unless defined $data && length$data;

$data_fh->print(ALLOMANY $data);
}
}
}
else
{
my $wd = default MIME::WordDecoder;
$wd = supported MIME::WordDecoder "ISO-8859-2";
$imap->select($config->MAILBOX);
my @msg_list = $imap->search('UNSEEN');
my @sorszam = @msg_list;

print(ALLOMANY "<h4>Saw message list [EMAIL PROTECTED]</h4>\n") if$config->VERBOSE;print(ALLOMANY "<table border=\"0\" cellspacing=\"1\" cellpadding=\"4\"bgcolor=\"#cccccc\" align=\"center\">\n");

print(ALLOMANY "<tr>\n");
print(ALLOMANY "<th class=\"td_kek\">\&nbsp;</th>\n");
print(ALLOMANY "<th class=\"td_kek\">Cím</th>\n");
print(ALLOMANY "<th class=\"td_kek\">Tárgy</th>\n");
print(ALLOMANY "<th class=\"td_kek\">Időpont</th>\n");
print(ALLOMANY "</tr>\n");
foreach my $message (@msg_list)
{
$count++;
print(ALLOMANY "<tr>");
my $data = $imap->parse_headers($message, "Subject", "From", "Date");
my $address = $data->{From}->[0];
my $subject = $data->{Subject}->[0];
my $date = $data->{Date}->[0];

$subject = $wd->decode($subject);
print(ALLOMANY "<td class=\"td_feher\">".$count."</td>\n");
$address = $1
if ($address =~ m/[<"]?([EMAIL PROTECTED]@[^\s@>"]+)"?>?/);
print(ALLOMANY "<td class=\"td_feher\">".$address."</td>\n");

print(ALLOMANY "<td class=\"td_feher\">".((defined$data->{Subject}->[0]) ? $subject : '')."</td>\n");

print(ALLOMANY "<td class=\"td_feher\">".datum($date)."</td>\n");
if ($config->DUMP)
{

my $string = $imap->body_string($message) or die "Could notbody_string($message): [EMAIL PROTECTED]";

print "\n===\n\n$string\n===\n\n<br>";
}
if ($config->TO)
{

die "Could not move message $message: $!" unless$imap->move($config->TO, $message);

print "Moved message $message to " . $config->TO, "\n";
$imap->expunge() if $config->EXPUNGE_OFTEN;
last if $count >= $config->N;
}
print(ALLOMANY "</tr>\n");
}
if ($config->TO)
{
$imap->expunge();
}
}
print(ALLOMANY "</table>\n");
print(ALLOMANY "</body>\n");
close(ALLOMANY);
$r->internal_redirect("/wimap/index.html");
return Apache2::Const::OK;
}

1;

Graf László



Sean Davis wrote:

I think it would help if you could give some more information (like how you
are writing the index.html file).  Some code?

Sean


On 4/6/06 7:32 AM, "Graf László" <[EMAIL PROTECTED]> wrote:

Hi all,

I made a mod_perl 2.0 module that connects to an IMAP server,
retrieves the undeleted mails and generates HTML output.

OK, it works fine. When I access 'http://localhost/wimap',
the module generates the content and displays it.

But what if I want to write the output into a file in the
Apache2's document root? Let's name the output file index.html.

Now, if I access 'http://localhost/wimap/index.html', all my
log messages are written 11 times and it complains that the
request exceeded the limit of 10 internal redirects.

" Request exceeded the limit of 10 internal redirects due
  to probable configuration error. Use 'LimitInternalRecursion'
  to increase the limit if necessary. Use 'LogLevel debug' to
  get a backtrace."

My httpd.conf contains these lines:

LoadModule perl_module modules/mod_perl.so
PerlRequire /usr/local/apache2/conf/mod_perl/imap_start.pl
<Location /wimap>
    SetHandler perl-script
    PerlResponseHandler Wimap::Wimap
</Location>

Thank you,

Re: mod_perl 2.0 - redirect

Reply via email to