Listing 2: better-print-mail.pl, an improved version of print-mail.pl

#!/usr/bin/perl -wT

use strict;
use diagnostics;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Net::POP3;

# Force flushing
$| = 1;

# What headers should we display?
my %KEEP = ("To" => 1,
	    "From" => 1,
	    "Subject" => 1,
	    "Date" => 1);

# ------------------------------------------------------------
# Create a new CGI object
my $query = new CGI;

# Send a MIME header
print $query->header("text/html");

# Get a bunch of information
my $mailserver = $query->param("mailserver");
my $username = $query->param("username");
my $password = $query->param("password");
my $to_view = $query->param("to_view") || 0;

# Print a nice beginning 
print $query->start_html(-title => "Your mail");
print "<H1>Your mail</H1>\n";

# ------------------------------------------------------------
# Create a new POP object
print "<P>Connecting to server \"$mailserver\" as \"$username\"</P>\n";
my $pop = new Net::POP3($mailserver,
			-Timeout => 20);
die "Error connecting" unless (defined $pop);

# Log into the server
my $num_messages = $pop->login($username, $password);
die "Error logging in" unless (defined $num_messages);

# Tell the user what messages are waiting
print "You have $num_messages message",
    ($num_messages == 1) ? "" : "s", " waiting.\n";

# View a particular message, or all of them?
my @message_indices;

if ($query->param("to_view"))
{
    @message_indices = $query->param("to_view");
}
else
{
    @message_indices = (1 .. $num_messages);
}

# ------------------------------------------------------------
# Iterate through each message, printing it
foreach my $index (@message_indices)
{
    print "<H2>Message $index</H2>\n";
    
    print "<pre>\n";

    # Grab the message contents
    my $message_ref = $pop->get($index);

    # Get the entire message as a scalar
    my $contents = join "", @$message_ref;

    # ------------------------------------------------------------
    # Turn special characters into entities
    $contents =~ s/</&lt;/g;
    $contents =~ s/>/&gt;/g;

    # Make e-mail addresses clickable
    $contents =~ 
	s|([\w-.]+@[\w-.]+\.[a-z]{2,3})|<a href="mailto:$1">$1</a>|gi;

    # Make URLs clickable
    $contents =~ 
	s|(\w+tps?://[^\s&\"\']+[\w/])|<a href="$1">$1</a>|gi;

    # ------------------------------------------------------------
    # Break the message into headers and body
    my ($headers, $body) = split "\n\n", $contents, 2;

    # Print the message headers
    my @headers = split "\n", $headers;
    my $previous = "";

    foreach my $line (@headers)
    {
	# If this is a new header, put its name in $previous
	# If we are on a continuation line, this won't match
	if ($line =~ m/^([\w-]+):/i)
	{
	    $previous = $1;
	}

	# Print the line, if it is in %KEEP
	print $line, "\n" if $KEEP{$previous};
    }

    # Print the message
    print "\n\n", $body, "\n</pre><HR>\n";
}

# Log off from the POP server
$pop->quit;

# Finish the CGI program
print $query->end_html;