#!/usr/bin/perl -wT
# ---------------------------------------------------------
# Converts email addresses to a format suitable for mailto:
# links, one that is reportedly more difficult for spammers
# to harvest.
#
# Note: mailto: tags have other problems.  Feedback scripts 
# may be more effective defenses; however, this can be used
# by your HTML "designers" while you're working on a better
# solution (Hint: combine CGI.pm with MIME::Lite).
#
# Revision log and contact info provided in __DATA__  Share
# and Enjoy...so long as I get credit, too.
# ---------------------------------------------------------

use strict;
use CGI qw( :standard );

$CGI::HEADERS_ONCE = 1;
$CGI::POST_MAX = 1_024;
$CGI::DISABLE_UPLOADS = 1;

#use CGI::Carp qw( fatalsToBrowser );
#use CGI::Pretty;
use HTML::Entities;

my $field = "emailaddr";
my $error = cgi_error;
if ( $error )
   {
      printForm( "There was a problem with your " . 
                 "request.\n\nDetails: $error." );
   }
elsif ( param( $field ) )
   {
      encodeEmail( param( $field ) );
   }
else 
   { 
      printForm( "This encodes a simple email address " .
                 '(user@example.com) to a MAILTO: tag ' . 
                 "that is more difficult for spammers " .
                 "to harvest.\n\n" . 
                 "Please submit the email address you " . 
                 "want to encode:\n" );
   }

exit 1;


sub coinFlip   
# -----------------------------------------------------
# Note that this is weighted heavily in favor of the 
# codes.
# -----------------------------------------------------
{ return ( rand() < 0.75 ) ? 1 : 0; }


sub encodeEmail
# -----------------------------------------------------
# Encodes an email address by randomly converting most
# of its characters to ASCII codes.  Note weighting in 
# coinFlip(); according to rumor, this works best when
# most, but not all characters are encoded.
# -----------------------------------------------------
{
   my $input = shift;
   my @chars = split //, $input;
   my @codes = map 
               { encode_entities( $_, '\x00-\xff' ) } 
               @chars;

   # See Camel book discussion of srand
   srand( time() ^ ( $$ + ( $$ << 15 ) ) );

   my $result = $input;
   while ( $result eq $input )        # just in case.
   {
      $result = "";
      foreach my $index ( 0..$#chars )
      {
         $result .= coinFlip() 
                    ? $codes[ $index ]
                    : $chars[ $index ] ;
      }
   }
   printForm( "Your encoded email address " . 
              "is shown below:", $input, $result );
}

sub printForm
# -----------------------------------------------------
# Prints the HTML.  The first parameter is explanatory 
# text displayed to the user.  The second and third 
# parameters are optional and (respectively) contain 
# the email address entered by the user and its encoded 
# version.
# -----------------------------------------------------
{
   my $text   = shift;
   my $email  = shift;
   my $mailto = shift;
   my $title  = "Simple Email Address Encoder";
   my $type   = "application/x-www-form-urlencoded";

   my $source = a( { href=>"http://webdeveloper.com/" .
                     "drweb/19990329-drweb.html" },
                   "article" );

   print header(),
         start_html( -title => $title ),
         h1( $title ),
         p( $text ),

         start_form( "post", url(), $type );
         
   if ( $mailto ) 
   { 
      my $link = '<a href="mailto:' . "$mailto" . 
                 '">' . "$mailto</a>";
      print p( "Your link appears like this: $link" ),

            p( "The value for the mailto link tag is:",
               br, 
               textarea( -name    => "encoded", 
                         -default => $mailto,
                         -rows    => 3,
                         -columns => 58,
                         -wrap    => "virtual" ) );
   }
   
   print hr,
         p( 'Enter an e-mail address to encode:',
            br, textfield( $field, $email, 60, 50 ) ),
         p( submit(), reset() ),

         end_form, 
         p( "For more information, please see this ",
            $source, "." ), 
         end_html;
}

__DATA__

Contact Info on my home node:
   http://perlmonks.com/index.pl?node_id=33117

To do list:

-- Detect the slight risk of returning all codes and 
   re-run should that happen.  I've been told a mixed
   string is the most effective.
-- Fix problems with multiple submissions.  There are 
   two, though I think they're from the same bug.
-- Podify
-- Look for further (reasonable) streamlining.
   
Updates:

v0.0.0, 19 Jun 01 - First posted to perlmonks.com
v0.0.1, 19 Jun 01:
-- Added in HTML::Entities, per [Ovid]. (Yay!)
-- Revised coinFlip() and calling code to clarify
   intent (codes returned 75% of the time).