X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=maps%2Fbin%2Fdisplay.cgi;h=0a0cfcd9ca38fbecc7ffff3232a7c942373d0fbd;hb=88c9cb9f6ed80dd31981b083593b1746695083b9;hp=5482c4816f2cc1166e98e7e2e7a051c69f6d69fb;hpb=c77c34e14483b55db7958a0fdbdc165bcfe89485;p=clearscm.git diff --git a/maps/bin/display.cgi b/maps/bin/display.cgi index 5482c48..0a0cfcd 100755 --- a/maps/bin/display.cgi +++ b/maps/bin/display.cgi @@ -16,9 +16,10 @@ use strict; use warnings; use FindBin; -$0 = $FindBin::Script; +local $0 = $FindBin::Script; -use lib $FindBin::Bin; +use lib "$FindBin::Bin/../lib"; +use lib "$FindBin::Bin/../../lib"; use MAPS; use MAPSWeb; @@ -30,18 +31,23 @@ use MIME::Parser; use MIME::Base64; use MIME::Words qw(:all); -my $userid = cookie('MAPSUser'); -my $sender = param('sender'); -my $msg_nbr = param('msg_nbr'); -my $table_name = 'message'; +my $userid = cookie('MAPSUser'); +my $sender = param('sender'); -sub ParseEmail (@) { +# CGI will replace '+' with ' ', which many mailers are starting to do, +# so add it back +$sender =~ s/ /\+/; + +my $msg_date = param('msg_date'); +my $table_name = 'message'; + +sub ParseEmail(@) { my (@header) = @_; my %header; # First output the header information. Note we'll skip uninteresting stuff - foreach (@header) { + for (@header) { last if ($_ eq '' || $_ eq "\cM"); # Escape "<" and ">" @@ -59,30 +65,31 @@ sub ParseEmail (@) { } elsif (/^Content-Transfer-Encoding: base64/) { $header{base64} = 1; } # if - } # while + } # for return %header; } # ParseEmail -sub Body ($) { - my ($count) = @_; +sub Body($) { + my ($date) = @_; - $count ||= 1; + # Find unique message using $date + my ($err, $msg) = FindEmail( + userid => $userid, + sender => $sender, + timestamp => $date, + ); - my $handle = FindEmail $sender; - - my ($userid, $sender, $subject, $timestamp, $message); - - # Need to handle multiple messages - for (my $i = 0; $i < $count; $i++) { - ($userid, $sender, $subject, $timestamp, $message) = GetEmail $handle; - } # for + my $rec = GetEmail; - my $parser = new MIME::Parser; + my $parser = MIME::Parser->new(); - $parser->output_to_core (1); + # For some strange reason MIME::Parser has started having some problems + # with writing out tmp files... + $parser->output_to_core(1); + $parser->tmp_to_core(1); - my $entity = $parser->parse_data ($message); + my $entity = $parser->parse_data($rec->{data}); my %header = ParseEmail @{($entity->header)[0]}; @@ -94,7 +101,8 @@ sub Body ($) { -cellpadding => 0, -width => "100%"}); print start_table ({-align => "center", - -bgcolor => "#d4d0c8", + -bgcolor => 'steelblue', + #-bgcolor => "#d4d0c8", -border => 0, -cellspacing => 2, -cellpadding => 2, @@ -104,28 +112,31 @@ sub Body ($) { -border => 0, -cellspacing => 0, -cellpadding => 2, - -bgcolor => "#ece9d8", + -bgcolor => 'black', + #-bgcolor => "#ece9d8", -width => "100%"}) . "\n"; - foreach (keys (%header)) { + for (keys (%header)) { next if /base64/; - my $str = decode_mimewords ($header{$_}); + my $str = decode_mimewords($header{$_}); print Tr ([ - th ({-align => "right", - -bgcolor => "#ece9d8", - -width => "8%"}, "$_:") . "\n" . - td ({-bgcolor => "white"}, $str) + th ({-align => 'right', + -bgcolor => 'steelblue', + -style => 'color: white', + #-bgcolor => "#ece9d8", + -width => "8%"}, ucfirst "$_:") . "\n" . + td ({-bgcolor => 'white'}, $str) ]); - } # if + } # for print end_table; print ""; print end_table; - print start_table ({-align => "center", - -bgcolor => "black", + print start_table ({-align => 'center', + -bgcolor => 'steelblue', -border => 0, -cellspacing => 0, -cellpadding => 2, @@ -135,34 +146,35 @@ sub Body ($) { -border => 0, -cellspacing => 0, -cellpadding => 2, - -bgcolor => "white", + -bgcolor => 'white', -width => "100%"}) . "\n"; print "\n"; my @parts = $entity->parts; if (scalar @parts == 0) { - if (${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) { + if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and + ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) { print $entity->{ME_Bodyhandle}{MBS_Data}; } else { print '
';
-      $entity->print_body;
+      print $entity->print_body;
       print '
'; } # if } else { - foreach my $part ($entity->parts) { + for my $part ($entity->parts) { # We assume here that if this part is multipart/alternative then # there exists at least one part that is text/html and we favor # that (since we're outputing to a web page anyway... if ($part->mime_type eq 'multipart/alternative') { - foreach my $subpart ($part->parts) { + for my $subpart ($part->parts) { if ($subpart->mime_type eq 'text/html') { # There should be an easier way to get this but I couldn't find one. my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}; if ($encoding =~ /base64/) { - $subpart->bodyhandle->print(); + $subpart->bodyhandle->print; } else { - $subpart->print_body; + print $subpart->print_body; } # if last; } elsif ($subpart->mime_type eq 'multipart/related') { @@ -170,15 +182,27 @@ sub Body ($) { $subpart->print_body; last; } # if - } # foreach + } # for + } elsif ($part->mime_type eq 'multipart/related') { + # Sometimes parts are 'multipart/relative'... + $part->print_body; } else { if ($part->mime_type =~ /text/) { - print '
';
-          $part->print_body;
-          print '
'; + my $encoding = ''; + + $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} + if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}; + + if ($encoding =~ /base64/) { + $part->bodyhandle->print(); + } else { + print '
';
+            print $part->print_body;
+            print '
'; + } # if } # if } # if - } # foreach + } # for } # if print "\n"; @@ -188,7 +212,7 @@ sub Body ($) { print end_table; } # Body -$userid = Heading ( +$userid = Heading( 'getcookie', '', "Email message from $sender", @@ -197,9 +221,11 @@ $userid = Heading ( $table_name, ); -SetContext $userid; -NavigationBar $userid; +$userid //= $ENV{USER}; + +SetContext($userid); +NavigationBar($userid); -Body $msg_nbr; +Body($msg_date); -Footing $table_name; +Footing($table_name);