#!f:/apache/perl/bin/perl.exe
#!/usr/bin/perl -w

use strict;
require 5.004;

use Exporter ();
use vars qw (@ISA @EXPORT);

@ISA    = qw(Exporter);
@EXPORT = qw(ParseSpecial FixAddr);

sub FixAddr {
    my $addr = $_[0];
    my $ret  = "";

    ## Enable the folowing lines to debug
    #open ("AKA",">/tmp/ala.txt") or die "No pude: $!";
    #print AKA $addr . "\n";
    #close("AKA");

    if ( $addr =~ m/^(.*)?\<(.*)\@(.*)\>$/ ) {    # I need a normalized email
        my $a = $1;
        my $b = '<' . $2 . '@' . $3 . ">";

        $a =~ s/\"//g;                            # I get rid of the quotes
        $ret = '"' . $a . '" ' . $b;
    }
    elsif ( $addr =~ m/^(\<)?(\w*|\d*)+\@(\w*|\.|\d*)(\>)?$/ ) {
        $ret = '<' . $2 . '@' . $3 . '>';
    }
    else {
        $ret = $addr;
    }

    return $ret;
}

sub ParseSpecial {
    my $subject = $_[0];
    my $ret     = "";

    #my $spch    = "\xe1\xe9\xed\xf3\xfa\xc1\xc9\xcd\xd3\xda\xe4\xeb\xef\xf6" .
    #    "\xfc\xc4\xcb\xcf\xd6\xdc\xe0\xe8\xec\xf2\xf9\xc0\xc8I\xd2\xd9" .
    #    "\xe2\xea\xee\xf4\xfb\xc2\xca\xce\xd4\xdb\xf1\xd1";
    my $aragon =
        "(\xe1|\xe9|\xed|\xf3|\xfa|\xc1|\xc9|\xcd|\xd3|\xda|\xe4|"
      . "\xeb|\xef|\xf6|\xfc|\xc4|\xcb|\xcf|\xd6|\xdc|\xe0|\xe8|\xec|"
      . "\xf2|\xf9|\xc0|\xc8|\xcc|\xd2|\xd9|\xe2|\xea|\xee|\xf4|\xfb|"
      . "\xc2|\xca|\xce|\xd4|\xdb|\xf1|\xd1)"; #|_)";

    my %stra;
    $stra{"á"} = "=E1";
    $stra{"é"} = "=E9";
    $stra{"í"} = "=ED";
    $stra{"ó"} = "=F3";
    $stra{"ú"} = "=FA";

    $stra{"Á"} = "=C1";
    $stra{"É"} = "=C9";
    $stra{"Í"} = "=CD";
    $stra{"Ó"} = "=D3";
    $stra{"Ú"} = "=DA";

    $stra{"ä"} = "=E4";
    $stra{"ë"} = "=EB";
    $stra{"ï"} = "=EF";
    $stra{"ö"} = "=F6";
    $stra{"ü"} = "=FC";

    $stra{"Ä"} = "=C4";
    $stra{"Ë"} = "=CB";
    $stra{"Ï"} = "=CF";
    $stra{"Ö"} = "=D6";
    $stra{"Ü"} = "=DC";

    $stra{"à"} = "=E0";
    $stra{"è"} = "=E8";
    $stra{"ì"} = "=EC";
    $stra{"ò"} = "=F2";
    $stra{"ù"} = "=F9";

    $stra{"À"} = "=C0";
    $stra{"È"} = "=C8";
    $stra{"Ì"} = "=CC";
    $stra{"Ò"} = "=D2";
    $stra{"Ù"} = "=D9";

    $stra{"â"} = "=E2";
    $stra{"ê"} = "=EA";
    $stra{"î"} = "=EE";
    $stra{"ô"} = "=F4";
    $stra{"û"} = "=FB";

    $stra{"Â"} = "=C2";
    $stra{"Ê"} = "=CA";
    $stra{"Î"} = "=CE";
    $stra{"Ô"} = "=D4";
    $stra{"Û"} = "=DB";

    $stra{"ñ"} = "=F1";
    $stra{"Ñ"} = "=D1";

    #$stra{'_'} = "=5F";

    my @tmpSplit = split( /\s/, $subject );

    #my $i = 0;

    ## Enable de folowing lines to debug
    #open("AKA",">/tmp/debug_arpro") || die "No pude: $!";
    #print AKA "subject: '$subject'\n";

    if (1) {
        foreach my $tmp (@tmpSplit) {

            #print STDERR "Paso número: " . $i++ . ": " . $tmp . "\n";
            if ( $tmp =~ m/$aragon/ ) {
                while ( $tmp =~ m/$aragon{1}/ ) {
                    my $a = $1;
                    $tmp =~ s/$a/$stra{$a}/g;
                }
                if ( $tmp =~ m/^\"/ ) {
                    $tmp =~ s/^\"//;
                    $tmp = '"=?ISO-8859-1?Q?' . $tmp . '?=';
                }
                elsif ( $tmp =~ m/\"$/ ) {
                    $tmp =~ s/\"$//;
                    $tmp = '"=?ISO-8859-1?Q?' . $tmp . '?="';
                }
                else {
                    $tmp = '=?ISO-8859-1?Q?' . $tmp . '?=';
                }
            }

            #print AKA "tmp es: '" . $tmp . "'\n";
            if ( ( $ret =~ m/\?=\s$/ ) && ( $tmp =~ m/^\=\?ISO/ ) ) {
                $ret =~ s/\?\=\s$//;
                $tmp =~ s/^\=\?ISO\-8859\-1\?Q\?/_/;

                #print AKA "+tmp ahora es: '$tmp' \n";
                $ret .= $tmp . " ";

                #print AKA "+ret: '$ret' \n";
            }
            else {
                $ret .= $tmp . " ";

                #print AKA "-tmp es: '$tmp'\n";
                #print AKA "-ret es: '$ret'\n";
            }
        }

        $ret =~ s/\s+$//;

        #close("AKA");

        #print STDERR "Subject: '" . $ret . "'\n";
        return $ret;
    }
}
1;
__END__

=head1 ParseSpecial

Esta subrutina simplemente convierte texto con acentos (ISO-8859-15/1)
a texto con escapes (quoted-printable).

Esta función fue creada para solventar el problema de que los mensajes
de correo, si no tienen esta secuencia de escape, no son vistos correctamente
por todos los MUAs.

=head1 Ejemplos:

        use ParseSpecial;

        my $string = "áéíóú, son vocales acentuadas";

        print ParseSpecial($string) . "\n";


Lo anterior, si todo fue bien, devolverá algo como:

        =?ISO-8859-1?Q?=E1=E9=ED=F3=FA,?= son vocales

En sí es una función extremadamente simple, pero el ponerla en
el archivo que la requería era algo engorroso, por eso creé este
módulo.

Existen ciertas falencias en este módulo, pero por ahora todo lo más
importante fue corregido.


=head1 Author

Matías Palomec-Daniel Farias  <programmers_arg@yahoo.com.ar>

=head1 Versión

$ ParseSpecial.pm,v 1.2  $
=cut
