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";
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 ($err, $msg) = FindEmail(
84 my $parser = MIME::Parser->new();
86 $parser->output_to_core(1);
87 $parser->tmp_to_core(1);
89 my $entity = $parser->parse_data($rec->{data});
91 my %header = ParseEmail @{($entity->header)[0]};
94 print start_table ({-align => "center",
100 print start_table ({-align => "center",
101 -bgcolor => 'steelblue',
102 #-bgcolor => "#d4d0c8",
106 -width => "100%"}) . "\n";
107 print "<tbody><tr><td>\n";
108 print start_table ({-align => "center",
113 #-bgcolor => "#ece9d8",
114 -width => "100%"}) . "\n";
116 for (keys (%header)) {
119 my $str = decode_mimewords($header{$_});
122 th ({-align => 'right',
123 -bgcolor => 'steelblue',
124 -style => 'color: white',
125 #-bgcolor => "#ece9d8",
126 -width => "8%"}, ucfirst "$_:") . "\n" .
127 td ({-bgcolor => 'white'}, $str)
135 print start_table ({-align => 'center',
136 -bgcolor => 'steelblue',
140 -width => "100%"}) . "\n";
141 print "<tbody><tr><td>\n";
142 print start_table ({-align => "center",
147 -width => "100%"}) . "\n";
148 print "<tbody><tr><td>\n";
150 my @parts = $entity->parts;
152 if (scalar @parts == 0) {
153 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
154 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
155 print $entity->{ME_Bodyhandle}{MBS_Data};
158 print $entity->print_body;
162 for my $part ($entity->parts) {
163 # We assume here that if this part is multipart/alternative then
164 # there exists at least one part that is text/html and we favor
165 # that (since we're outputing to a web page anyway...
166 if ($part->mime_type eq 'multipart/alternative') {
167 for my $subpart ($part->parts) {
168 if ($subpart->mime_type eq 'text/html') {
169 # There should be an easier way to get this but I couldn't find one.
170 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
171 if ($encoding =~ /base64/) {
172 $subpart->bodayhandle->print;
174 print $subpart->print_body;
177 } elsif ($subpart->mime_type eq 'multipart/related') {
178 # This is stupid - multipart/related? When it's really just HTML?!?
179 $subpart->print_body;
183 } elsif ($part->mime_type eq 'multipart/related') {
184 # Sometimes parts are 'multipart/relative'...
187 if ($part->mime_type =~ /text/) {
190 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
191 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
193 if ($encoding =~ /base64/) {
194 $part->bodyhandle->print();
197 print $part->print_body;
205 print "</td></tr>\n";
207 print "</td></tr>\n";
215 "Email message from $sender",
216 "Email message from $sender",
221 $userid //= $ENV{USER};
224 NavigationBar($userid);
228 Footing($table_name);