################################################################################
#
# File: $RCSfile: display.cgi,v $
-# Revision: $Revision: 1.1 $
+# Revision: $Revision: 1.1 $
# Description: Displays an email message
# Author: Andrew@DeFaria.com
# Created: Fri Nov 29 14:17:21 2002
use warnings;
use FindBin;
-$0 = $FindBin::Script;
+local $0 = $FindBin::Script;
-use lib $FindBin::Bin;
+use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/../../lib";
use MAPS;
use MAPSWeb;
use MIME::Base64;
use MIME::Words qw(:all);
-my $userid = cookie ("MAPSUser");
-my $sender = param ("sender");
-my $msg_nbr = param ("msg_nbr");
-my $table_name = "message";
+my $userid = cookie('MAPSUser');
+my $sender = param('sender');
-sub ParseEmail (@) {
+# CGI will replace '+' with ' ', which many mailers are starting to do,
+# so add it back
+$sender =~ s/ /\+/;
+
+my $msg_date = param('msg_date');
+my $table_name = 'message';
+
+sub ParseEmail(@) {
my (@header) = @_;
my %header;
# First output the header information. Note we'll skip uninteresting stuff
- foreach (@header) {
- last if ($_ eq "" || $_ eq "\cM");
+ for (@header) {
+ last if ($_ eq '' || $_ eq "\cM");
# Escape "<" and ">"
s/\</\<\;/;
$header{date} = $1;
} elsif (/^To:\s*(.*)/i) {
$header{to} = $1;
+ } elsif (/^Content-Transfer-Encoding: base64/) {
+ $header{base64} = 1;
} # if
- } # while
+ } # for
return %header;
} # ParseEmail
-sub Body ($) {
- my ($count) = @_;
-
- $count ||= 1;
-
- my $handle = FindEmail $sender;
+sub Body($) {
+ my ($date) = @_;
- my ($userid, $sender, $subject, $timestamp, $message);
+ # Find unique message using $date
+ my ($err, $msg) = FindEmail(
+ userid => $userid,
+ sender => $sender,
+ timestamp => $date,
+ );
- # Need to handle multiple messages
- for (my $i = 0; $i < $count; $i++) {
- ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle;
- } # for
+ my $rec = GetEmail;
- my $parser = new MIME::Parser;
+ my $parser = MIME::Parser->new();
- $parser->output_to_core (1);
+ # For some strange reason MIME::Parser has started having some problems
+ # with writing out tmp files...
+ $parser->output_to_core(1);
+ $parser->tmp_to_core(1);
- my $entity = $parser->parse_data ($message);
+ my $entity = $parser->parse_data($rec->{data});
my %header = ParseEmail @{($entity->header)[0]};
print p . "\n";
- print start_table ({-align => "center",
- -id => $table_name,
- -border => 0,
- -cellspacing => 0,
- -cellpadding => 0,
- -width => "100%"});
- print start_table ({-align => "center",
- -bgcolor => "#d4d0c8",
- -border => 0,
- -cellspacing => 2,
- -cellpadding => 2,
- -width => "100%"}) . "\n";
+ print start_table ({-align => "center",
+ -id => $table_name,
+ -border => 0,
+ -cellspacing => 0,
+ -cellpadding => 0,
+ -width => "100%"});
+ print start_table ({-align => "center",
+ -bgcolor => 'steelblue',
+ #-bgcolor => "#d4d0c8",
+ -border => 0,
+ -cellspacing => 2,
+ -cellpadding => 2,
+ -width => "100%"}) . "\n";
print "<tbody><tr><td>\n";
- print start_table ({-align => "center",
- -border => 0,
- -cellspacing => 0,
- -cellpadding => 2,
- -bgcolor => "#ece9d8",
- -width => "100%"}) . "\n";
+ print start_table ({-align => "center",
+ -border => 0,
+ -cellspacing => 0,
+ -cellpadding => 2,
+ -bgcolor => 'black',
+ #-bgcolor => "#ece9d8",
+ -width => "100%"}) . "\n";
+
+ for (keys (%header)) {
+ next if /base64/;
- foreach (keys (%header)) {
- my $str = decode_mimewords ($header{$_});
+ my $str = decode_mimewords($header{$_});
print Tr ([
- th ({-align => "right",
- -bgcolor => "#ece9d8",
- -width => "8%"}, "$_:") . "\n" .
- td ({-bgcolor => "white"}, $str)
- ]);
- } # if
+ th ({-align => 'right',
+ -bgcolor => 'steelblue',
+ -style => 'color: white',
+ #-bgcolor => "#ece9d8",
+ -width => "8%"}, ucfirst "$_:") . "\n" .
+ td ({-bgcolor => 'white'}, $str)
+ ]);
+ } # for
print end_table;
print "</td></tr>";
print end_table;
- print start_table ({-align => "center",
- -bgcolor => "black",
- -border => 0,
- -cellspacing => 0,
- -cellpadding => 2,
- -width => "100%"}) . "\n";
+ print start_table ({-align => 'center',
+ -bgcolor => 'steelblue',
+ -border => 0,
+ -cellspacing => 0,
+ -cellpadding => 2,
+ -width => "100%"}) . "\n";
print "<tbody><tr><td>\n";
- print start_table ({-align => "center",
- -border => 0,
- -cellspacing => 0,
- -cellpadding => 2,
- -bgcolor => "white",
- -width => "100%"}) . "\n";
+ print start_table ({-align => "center",
+ -border => 0,
+ -cellspacing => 0,
+ -cellpadding => 2,
+ -bgcolor => 'white',
+ -width => "100%"}) . "\n";
print "<tbody><tr><td>\n";
my @parts = $entity->parts;
if (scalar @parts == 0) {
- print '<pre>';
- $entity->print_body;
- print '</pre>';
+ if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
+ ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
+ print $entity->{ME_Bodyhandle}{MBS_Data};
+ } else {
+ print '<pre>';
+ print $entity->print_body;
+ print '</pre>';
+ } # if
} else {
- foreach my $part ($entity->parts) {
+ for my $part ($entity->parts) {
# We assume here that if this part is multipart/alternative then
# there exists at least one part that is text/html and we favor
# that (since we're outputing to a web page anyway...
if ($part->mime_type eq 'multipart/alternative') {
- foreach my $subpart ($part->parts) {
- if ($subpart->mime_type eq 'text/html') {
- $subpart->print_body;
- last;
- } elsif ($subpart->mime_type eq 'multipart/related') {
- # This is stupid - multipart/related? When it's really just HTML?!?
- $subpart->print_body;
- last;
- } # if
- } # foreach
+ for my $subpart ($part->parts) {
+ if ($subpart->mime_type eq 'text/html') {
+ # There should be an easier way to get this but I couldn't find one.
+ my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
+ if ($encoding =~ /base64/) {
+ $subpart->bodyhandle->print;
+ } else {
+ print $subpart->print_body;
+ } # if
+ last;
+ } elsif ($subpart->mime_type eq 'multipart/related') {
+ # This is stupid - multipart/related? When it's really just HTML?!?
+ $subpart->print_body;
+ last;
+ } # if
+ } # for
+ } elsif ($part->mime_type eq 'multipart/related') {
+ # Sometimes parts are 'multipart/relative'...
+ $part->print_body;
} else {
- if ($part->mime_type =~ /text/) {
- print '<pre>';
- $part->print_body;
- print '</pre>';
- } # if
+ if ($part->mime_type =~ /text/) {
+ my $encoding = '';
+
+ $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
+ if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
+
+ if ($encoding =~ /base64/) {
+ $part->bodyhandle->print();
+ } else {
+ print '<pre>';
+ print $part->print_body;
+ print '</pre>';
+ } # if
+ } # if
} # if
- } # foreach
+ } # for
} # if
print "</td></tr>\n";
print end_table;
} # Body
-$userid = Heading (
- "getcookie",
- "",
+$userid = Heading(
+ 'getcookie',
+ '',
"Email message from $sender",
"Email message from $sender",
- "",
+ '',
$table_name,
);
-SetContext $userid;
-NavigationBar $userid;
+$userid //= $ENV{USER};
+
+SetContext($userid);
+NavigationBar($userid);
-Body $msg_nbr;
+Body($msg_date);
-Footing $table_name;
+Footing($table_name);
projects / clearscm.git / blobdiff