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 local $0 = $FindBin::Script;
21 use lib "$FindBin::Bin/../lib";
22 use lib "$FindBin::Bin/../../lib";
27 use CGI qw/:standard *table/;
28 use CGI::Carp "fatalsToBrowser";
32 use MIME::Words qw(:all);
34 my $userid = cookie('MAPSUser');
35 my $sender = param('sender');
37 # CGI will replace '+' with ' ', which many mailers are starting to do,
41 my $msg_date = param('msg_date');
42 my $table_name = 'message';
49 # First output the header information. Note we'll skip uninteresting stuff
51 last if ($_ eq '' || $_ eq "\cM");
57 if (/^from:\s*(.*)/i) {
59 } elsif (/^subject:\s*(.*)/i) {
60 $header{Subject} = $1;
61 } elsif (/^date:\s*(.*)/i) {
63 } elsif (/^To:\s*(.*)/i) {
65 } elsif (/^Content-Transfer-Encoding: base64/) {
76 # Find unique message using $date
77 my ($err, $msg) = FindEmail(
85 my $parser = MIME::Parser->new();
87 $parser->output_to_core(1);
88 $parser->tmp_to_core(1);
90 my $entity = $parser->parse_data($rec->{data});
92 my %header = ParseEmail @{($entity->header)[0]};
95 print start_table ({-align => "center",
101 print start_table ({-align => "center",
102 -bgcolor => 'steelblue',
103 #-bgcolor => "#d4d0c8",
107 -width => "100%"}) . "\n";
108 print "<tbody><tr><td>\n";
109 print start_table ({-align => "center",
114 #-bgcolor => "#ece9d8",
115 -width => "100%"}) . "\n";
117 for (keys (%header)) {
120 my $str = decode_mimewords($header{$_});
123 th ({-align => 'right',
124 -bgcolor => 'steelblue',
125 -style => 'color: white',
126 #-bgcolor => "#ece9d8",
127 -width => "8%"}, ucfirst "$_:") . "\n" .
128 td ({-bgcolor => 'white'}, $str)
136 print start_table ({-align => 'center',
137 -bgcolor => 'steelblue',
141 -width => "100%"}) . "\n";
142 print "<tbody><tr><td>\n";
143 print start_table ({-align => "center",
148 -width => "100%"}) . "\n";
149 print "<tbody><tr><td>\n";
151 my @parts = $entity->parts;
153 if (scalar @parts == 0) {
154 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
155 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
156 print $entity->{ME_Bodyhandle}{MBS_Data};
159 print $entity->print_body;
163 for my $part ($entity->parts) {
164 # We assume here that if this part is multipart/alternative then
165 # there exists at least one part that is text/html and we favor
166 # that (since we're outputing to a web page anyway...
167 if ($part->mime_type eq 'multipart/alternative') {
168 for my $subpart ($part->parts) {
169 if ($subpart->mime_type eq 'text/html') {
170 # There should be an easier way to get this but I couldn't find one.
171 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
172 if ($encoding =~ /base64/) {
173 $subpart->bodayhandle->print;
175 print $subpart->print_body;
178 } elsif ($subpart->mime_type eq 'multipart/related') {
179 # This is stupid - multipart/related? When it's really just HTML?!?
180 $subpart->print_body;
184 } elsif ($part->mime_type eq 'multipart/related') {
185 # Sometimes parts are 'multipart/relative'...
188 if ($part->mime_type =~ /text/) {
191 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
192 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
194 if ($encoding =~ /base64/) {
195 $part->bodyhandle->print();
198 print $part->print_body;
206 print "</td></tr>\n";
208 print "</td></tr>\n";
216 "Email message from $sender",
217 "Email message from $sender",
222 $userid //= $ENV{USER};
225 NavigationBar($userid);
229 Footing($table_name);