2 ################################################################################
4 # File: $RCSfile: display.cgi,v $
5 # Revision: $Revision: 1.1 $
6 # Description: Displays an email message
7 # Author: Andrew@DeFaria.com
8 # Created: Fri Nov 29 14:17:21 2002
9 # Modified: $Date: 2013/06/12 14:05:47 $
12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
19 $0 = $FindBin::Script;
21 use lib "$FindBin::Bin/../lib";
26 use CGI qw/:standard *table/;
27 use CGI::Carp "fatalsToBrowser";
31 use MIME::Words qw(:all);
33 my $userid = cookie('MAPSUser');
34 my $sender = param('sender');
36 # CGI will replace '+' with ' ', which many mailers are starting to do,
40 my $msg_date = param('msg_date');
41 my $table_name = 'message';
48 # First output the header information. Note we'll skip uninteresting stuff
50 last if ($_ eq '' || $_ eq "\cM");
56 if (/^from:\s*(.*)/i) {
58 } elsif (/^subject:\s*(.*)/i) {
59 $header{Subject} = $1;
60 } elsif (/^date:\s*(.*)/i) {
62 } elsif (/^To:\s*(.*)/i) {
64 } elsif (/^Content-Transfer-Encoding: base64/) {
75 # Find unique message using $date
76 my $handle = FindEmail $sender, $date;
78 my ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle;
80 my $parser = MIME::Parser->new();
82 # For some strange reason MIME::Parser has started having some problems
83 # with writing out tmp files...
84 $parser->output_to_core(1);
85 $parser->tmp_to_core(1);
87 my $entity = $parser->parse_data ($message);
89 my %header = ParseEmail @{($entity->header)[0]};
92 print start_table ({-align => "center",
98 print start_table ({-align => "center",
99 -bgcolor => "#d4d0c8",
103 -width => "100%"}) . "\n";
104 print "<tbody><tr><td>\n";
105 print start_table ({-align => "center",
109 -bgcolor => "#ece9d8",
110 -width => "100%"}) . "\n";
112 for (keys (%header)) {
115 my $str = decode_mimewords($header{$_});
118 th ({-align => "right",
119 -bgcolor => "#ece9d8",
120 -width => "8%"}, "$_:") . "\n" .
121 td ({-bgcolor => "white"}, $str)
129 print start_table ({-align => "center",
134 -width => "100%"}) . "\n";
135 print "<tbody><tr><td>\n";
136 print start_table ({-align => "center",
141 -width => "100%"}) . "\n";
142 print "<tbody><tr><td>\n";
144 my @parts = $entity->parts;
146 if (scalar @parts == 0) {
147 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
148 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
149 print $entity->{ME_Bodyhandle}{MBS_Data};
156 for my $part ($entity->parts) {
157 # We assume here that if this part is multipart/alternative then
158 # there exists at least one part that is text/html and we favor
159 # that (since we're outputing to a web page anyway...
160 if ($part->mime_type eq 'multipart/alternative') {
161 for my $subpart ($part->parts) {
162 if ($subpart->mime_type eq 'text/html') {
163 # There should be an easier way to get this but I couldn't find one.
164 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
165 if ($encoding =~ /base64/) {
166 $subpart->bodyhandle->print();
168 $subpart->print_body;
171 } elsif ($subpart->mime_type eq 'multipart/related') {
172 # This is stupid - multipart/related? When it's really just HTML?!?
173 $subpart->print_body;
177 } elsif ($part->mime_type eq 'multipart/related') {
178 # Sometimes parts are 'multipart/relative'...
181 if ($part->mime_type =~ /text/) {
184 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
185 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
187 if ($encoding =~ /base64/) {
188 $part->bodyhandle->print();
199 print "</td></tr>\n";
201 print "</td></tr>\n";
209 "Email message from $sender",
210 "Email message from $sender",
216 NavigationBar($userid);
220 Footing($table_name);