maps/bin/display.cgi

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   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 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16 use warnings;
  17
  18 use FindBin;
  19 $0 = $FindBin::Script;
  20
  21 use lib $FindBin::Bin;
  22
  23 use MAPS;
  24 use MAPSWeb;
  25
  26 use CGI qw/:standard *table/;
  27 use CGI::Carp "fatalsToBrowser";
  28
  29 use MIME::Parser;
  30 use MIME::Base64;
  31 use MIME::Words qw(:all);
  32
  33 my $userid      = cookie ("MAPSUser");
  34 my $sender      = param ("sender");
  35 my $msg_nbr     = param ("msg_nbr");
  36 my $table_name  = "message";
  37
  38 sub ParseEmail (@) {
  39   my (@header) = @_;
  40
  41   my %header;
  42
  43   # First output the header information. Note we'll skip uninteresting stuff
  44   foreach (@header) {
  45     last if ($_ eq "" || $_ eq "\cM");
  46
  47     # Escape "<" and ">"
  48     s/\</\&lt\;/;
  49     s/\>/\&gt\;/;
  50
  51     if (/^from:\s*(.*)/i) {
  52       $header{From} = $1;
  53     } elsif (/^subject:\s*(.*)/i) {
  54       $header{Subject} = $1;
  55     } elsif (/^date:\s*(.*)/i) {
  56       $header{date} = $1;
  57     } elsif (/^To:\s*(.*)/i) {
  58       $header{to} = $1;
  59     } # if
  60   } # while
  61
  62   return %header;
  63 } # ParseEmail
  64
  65 sub Body ($) {
  66   my ($count) = @_;
  67
  68   $count ||= 1;
  69
  70   my $handle = FindEmail $sender;
  71
  72   my ($userid, $sender, $subject, $timestamp, $message);
  73
  74   # Need to handle multiple messages
  75   for (my $i = 0; $i < $count; $i++) {
  76     ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle;
  77   } # for
  78
  79   my $parser = new MIME::Parser;
  80
  81   $parser->output_to_core (1);
  82
  83   my $entity = $parser->parse_data ($message);
  84
  85   my %header = ParseEmail @{($entity->header)[0]};
  86
  87   print p . "\n";
  88     print start_table ({-align          => "center",
  89                         -id             => $table_name,
  90                         -border         => 0,
  91                         -cellspacing    => 0,
  92                         -cellpadding    => 0,
  93                         -width          => "100%"});
  94     print start_table ({-align          => "center",
  95                         -bgcolor        => "#d4d0c8",
  96                         -border         => 0,
  97                         -cellspacing    => 2,
  98                         -cellpadding    => 2,
  99                         -width          => "100%"}) . "\n";
 100     print "<tbody><tr><td>\n";
 101     print start_table ({-align          => "center",
 102                         -border         => 0,
 103                         -cellspacing    => 0,
 104                         -cellpadding    => 2,
 105                         -bgcolor        => "#ece9d8",
 106                         -width          => "100%"}) . "\n";
 107
 108     foreach (keys (%header)) {
 109       my $str = decode_mimewords ($header{$_});
 110
 111       print Tr ([
 112               th ({-align       => "right",
 113                    -bgcolor     => "#ece9d8",
 114                    -width       => "8%"}, "$_:") . "\n" .
 115               td ({-bgcolor     => "white"}, $str)
 116             ]);
 117     } # if
 118
 119     print end_table;
 120     print "</td></tr>";
 121     print end_table;
 122
 123   print start_table ({-align            => "center",
 124                       -bgcolor          => "black",
 125                       -border           => 0,
 126                       -cellspacing      => 0,
 127                       -cellpadding      => 2,
 128                       -width            => "100%"}) . "\n";
 129   print "<tbody><tr><td>\n";
 130   print start_table ({-align            => "center",
 131                       -border           => 0,
 132                       -cellspacing      => 0,
 133                       -cellpadding      => 2,
 134                       -bgcolor          => "white",
 135                       -width            => "100%"}) . "\n";
 136   print "<tbody><tr><td>\n";
 137
 138   my @parts = $entity->parts;
 139
 140   if (scalar @parts == 0) {
 141     print '<pre>';
 142     $entity->print_body;
 143     print '</pre>';
 144   } else {
 145     foreach my $part ($entity->parts) {
 146       # We assume here that if this part is multipart/alternative then
 147       # there exists at least one part that is text/html and we favor
 148       # that (since we're outputing to a web page anyway...
 149       if ($part->mime_type eq 'multipart/alternative') {
 150         foreach my $subpart ($part->parts) {
 151           if ($subpart->mime_type eq 'text/html') {
 152             $subpart->print_body;
 153             last;
 154           } elsif ($subpart->mime_type eq 'multipart/related') {
 155             # This is stupid - multipart/related? When it's really just HTML?!?
 156             $subpart->print_body;
 157             last;
 158           } # if
 159         } # foreach
 160       } else {
 161         if ($part->mime_type =~ /text/) {
 162           print '<pre>';
 163           $part->print_body;
 164           print '</pre>';
 165         } # if
 166       } # if
 167     } # foreach
 168   } # if
 169
 170   print "</td></tr>\n";
 171   print end_table;
 172   print "</td></tr>\n";
 173   print end_table;
 174   print end_table;
 175 } # Body
 176
 177 $userid = Heading (
 178   "getcookie",
 179   "",
 180   "Email message from $sender",
 181   "Email message from $sender",
 182   "",
 183   $table_name,
 184 );
 185
 186 SetContext $userid;
 187 NavigationBar $userid;
 188
 189 Body $msg_nbr;
 190
 191 Footing $table_name;