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 # For some strange reason MIME::Parser has started having some problems
88 # with writing out tmp files...
89 $parser->output_to_core(1);
90 $parser->tmp_to_core(1);
92 my $entity = $parser->parse_data($rec->{data});
94 my %header = ParseEmail @{($entity->header)[0]};
97 print start_table ({-align => "center",
103 print start_table ({-align => "center",
104 -bgcolor => 'steelblue',
105 #-bgcolor => "#d4d0c8",
109 -width => "100%"}) . "\n";
110 print "<tbody><tr><td>\n";
111 print start_table ({-align => "center",
116 #-bgcolor => "#ece9d8",
117 -width => "100%"}) . "\n";
119 for (keys (%header)) {
122 my $str = decode_mimewords($header{$_});
125 th ({-align => 'right',
126 -bgcolor => 'steelblue',
127 -style => 'color: white',
128 #-bgcolor => "#ece9d8",
129 -width => "8%"}, ucfirst "$_:") . "\n" .
130 td ({-bgcolor => 'white'}, $str)
138 print start_table ({-align => 'center',
139 -bgcolor => 'steelblue',
143 -width => "100%"}) . "\n";
144 print "<tbody><tr><td>\n";
145 print start_table ({-align => "center",
150 -width => "100%"}) . "\n";
151 print "<tbody><tr><td>\n";
153 my @parts = $entity->parts;
155 if (scalar @parts == 0) {
156 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
157 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
158 print $entity->{ME_Bodyhandle}{MBS_Data};
161 print $entity->print_body;
165 for my $part ($entity->parts) {
166 # We assume here that if this part is multipart/alternative then
167 # there exists at least one part that is text/html and we favor
168 # that (since we're outputing to a web page anyway...
169 if ($part->mime_type eq 'multipart/alternative') {
170 for my $subpart ($part->parts) {
171 if ($subpart->mime_type eq 'text/html') {
172 # There should be an easier way to get this but I couldn't find one.
173 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
174 if ($encoding =~ /base64/) {
175 $subpart->bodyhandle->print;
177 print $subpart->print_body;
180 } elsif ($subpart->mime_type eq 'multipart/related') {
181 # This is stupid - multipart/related? When it's really just HTML?!?
182 $subpart->print_body;
186 } elsif ($part->mime_type eq 'multipart/related') {
187 # Sometimes parts are 'multipart/relative'...
190 if ($part->mime_type =~ /text/) {
193 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
194 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
196 if ($encoding =~ /base64/) {
197 $part->bodyhandle->print();
200 print $part->print_body;
208 print "</td></tr>\n";
210 print "</td></tr>\n";
218 "Email message from $sender",
219 "Email message from $sender",
224 $userid //= $ENV{USER};
227 NavigationBar($userid);
231 Footing($table_name);