#!/usr/local/bin/perl -w

my $version="0.01 (beta)";

#  Copyright (C) 1999 Axel Beckert <abe@deuxchevaux.org>
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#  You can reach the author by snail-mail at the following address:
#  
#  Axel Beckert
#  Saarbrücker Straße 267a
#  D-66125 Saarbrücken, Germany

# Scrambles eMail addresses or parts of them in HTML-Files in various
# ways by replacing different characters by their entity, e.g. "@" is
# replaced by "&#064;".

# Parameters:
# -href    Scramble only in href attributes.
# -@	   Scramble ats
# -.	   Scramble dots
# -:	   Scramble colons
# -mailto  Scramble all mailto links

# Example: scrambleat.pl -@ -: -. 
#
# * Before:
# <A HREF="mailto:abe@cs.uni-sb.de">abe@cs.uni-sb.de</A>
#
# * After:
# <A HREF="mailto&#058;abe&#064;cs&#046;uni-sb&#046;de">abe&#064;cs&#046;uni-sb&#046;de</A>

my $text="";
my $all=0;

my $rest = 0;
my $mailto = 0;
my $href = 0;
my $chars = "";

while ($_ = shift) {
    if ($_ eq "-@") {
	$rest = 1;
	$chars .= "@";
    } elsif ($_ eq "-:") {
	$rest = 1;
	$chars .= ":";
    } elsif ($_ eq "-.") {
	$rest = 1;
	$chars .= ".";
    } elsif ($_ eq "-hrefonly") {
	$href = 1;
    } elsif ($_ eq "-mailto") {
	$mailto = 1;
    }
}
while(<>){$text.=$_;}

$text =~ s/mailto:[-_.\w+]+@[-_.\w+]+/&replaceAll($&)/ges if $mailto;

if ($href) {
    $text =~ s/mailto:[-_.\w+]+@[-_.\w+]+/&replace($&,$chars)/ges;
} elsif ($rest) {
    $text =~ s/./&replaceChar($&,$chars)/ges;
}

print $text;

sub replaceAll {
    return join('',map{$_=sprintf("&#%03d;",ord$_);}split('',shift));
}
sub replace {
    my $s = shift;
    my $c = shift;
    return join('',map{$_=sprintf("&#%03d;",ord$_)if/^[$c]$/;}split('',$s));
}
sub replaceChar {
    my $s = shift;
    my $c = shift;
    return ($s =~ /^[$c]$/?sprintf("&#%03d;",ord($s)):$s);
}