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 $parser->output_to_core(1);
84 my $entity = $parser->parse_data ($message);
86 my %header = ParseEmail @{($entity->header)[0]};
89 print start_table ({-align => "center",
95 print start_table ({-align => "center",
96 -bgcolor => "#d4d0c8",
100 -width => "100%"}) . "\n";
101 print "<tbody><tr><td>\n";
102 print start_table ({-align => "center",
106 -bgcolor => "#ece9d8",
107 -width => "100%"}) . "\n";
109 for (keys (%header)) {
112 my $str = decode_mimewords($header{$_});
115 th ({-align => "right",
116 -bgcolor => "#ece9d8",
117 -width => "8%"}, "$_:") . "\n" .
118 td ({-bgcolor => "white"}, $str)
126 print start_table ({-align => "center",
131 -width => "100%"}) . "\n";
132 print "<tbody><tr><td>\n";
133 print start_table ({-align => "center",
138 -width => "100%"}) . "\n";
139 print "<tbody><tr><td>\n";
141 my @parts = $entity->parts;
143 if (scalar @parts == 0) {
144 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
145 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
146 print $entity->{ME_Bodyhandle}{MBS_Data};
153 for my $part ($entity->parts) {
154 # We assume here that if this part is multipart/alternative then
155 # there exists at least one part that is text/html and we favor
156 # that (since we're outputing to a web page anyway...
157 if ($part->mime_type eq 'multipart/alternative') {
158 for my $subpart ($part->parts) {
159 if ($subpart->mime_type eq 'text/html') {
160 # There should be an easier way to get this but I couldn't find one.
161 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
162 if ($encoding =~ /base64/) {
163 $subpart->bodyhandle->print();
165 $subpart->print_body;
168 } elsif ($subpart->mime_type eq 'multipart/related') {
169 # This is stupid - multipart/related? When it's really just HTML?!?
170 $subpart->print_body;
174 } elsif ($part->mime_type eq 'multipart/related') {
175 # Sometimes parts are 'multipart/relative'...
178 if ($part->mime_type =~ /text/) {
181 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
182 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
184 if ($encoding =~ /base64/) {
185 $part->bodyhandle->print();
196 print "</td></tr>\n";
198 print "</td></tr>\n";
206 "Email message from $sender",
207 "Email message from $sender",
213 NavigationBar($userid);
217 Footing($table_name);