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_nbr = param('msg_nbr');
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/) {
77 my $handle = FindEmail $sender;
79 my ($userid, $sender, $subject, $timestamp, $message);
81 # Need to handle multiple messages
82 for (my $i = 0; $i < $count; $i++) {
83 ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle;
86 my $parser = MIME::Parser->new();
88 $parser->output_to_core (1);
90 my $entity = $parser->parse_data ($message);
92 my %header = ParseEmail @{($entity->header)[0]};
95 print start_table ({-align => "center",
101 print start_table ({-align => "center",
102 -bgcolor => "#d4d0c8",
106 -width => "100%"}) . "\n";
107 print "<tbody><tr><td>\n";
108 print start_table ({-align => "center",
112 -bgcolor => "#ece9d8",
113 -width => "100%"}) . "\n";
115 foreach (keys (%header)) {
118 my $str = decode_mimewords ($header{$_});
121 th ({-align => "right",
122 -bgcolor => "#ece9d8",
123 -width => "8%"}, "$_:") . "\n" .
124 td ({-bgcolor => "white"}, $str)
132 print start_table ({-align => "center",
137 -width => "100%"}) . "\n";
138 print "<tbody><tr><td>\n";
139 print start_table ({-align => "center",
144 -width => "100%"}) . "\n";
145 print "<tbody><tr><td>\n";
147 my @parts = $entity->parts;
149 if (scalar @parts == 0) {
150 if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
151 ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
152 print $entity->{ME_Bodyhandle}{MBS_Data};
159 for my $part ($entity->parts) {
160 # We assume here that if this part is multipart/alternative then
161 # there exists at least one part that is text/html and we favor
162 # that (since we're outputing to a web page anyway...
163 if ($part->mime_type eq 'multipart/alternative') {
164 for my $subpart ($part->parts) {
165 if ($subpart->mime_type eq 'text/html') {
166 # There should be an easier way to get this but I couldn't find one.
167 my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
168 if ($encoding =~ /base64/) {
169 $subpart->bodyhandle->print();
171 $subpart->print_body;
174 } elsif ($subpart->mime_type eq 'multipart/related') {
175 # This is stupid - multipart/related? When it's really just HTML?!?
176 $subpart->print_body;
180 } elsif ($part->mime_type eq 'multipart/related') {
181 # Sometimes parts are 'multipart/relative'...
184 if ($part->mime_type =~ /text/) {
187 $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
188 if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
190 if ($encoding =~ /base64/) {
191 $part->bodyhandle->print();
202 print "</td></tr>\n";
204 print "</td></tr>\n";
212 "Email message from $sender",
213 "Email message from $sender",
219 NavigationBar($userid);
223 Footing($table_name);