# Copyright Michael Anthony Puls II, http://shadow2531.com/
# Distributed under the Boost Software License, Version 1.0.
# http://boost.org/LICENSE_1_0.txt .

# Rules to follow http://shadow2531.com/opera/testcases/mailto/rfc2368-3.html
# Example c++ versions of these functions are in  
# http://shadow2531.com/cpp/mailto_funcs1.zip
# http://shadow2531.com/cpp/mailto_funcs2.zip
# http://shadow2531.com/cpp/mailto_funcs3.zip
# http://shadow2531.com/cpp/mailto_funcs4.zip
# http://shadow2531.com/cpp/mailto_funcs5.zip
# http://shadow2531.com/cpp/mailto_funcs6.zip
# http://shadow2531.com/cpp/mailto_funcs7.zip
# http://shadow2531.com/cpp/mailto_funcs8.zip
# http://shadow2531.com/cpp/mailto_funcs9.zip
# http://shadow2531.com/cpp/mailto_funcs10.zip
# http://shadow2531.com/cpp/mailto_funcs11.zip
# Example Javascript versions of these functions are in http://shadow2531.com/opera/testcases/mailto/mailto_funcs.js
# Example Java versions of these functions are in http://shadow2531.com/java/MailtoFuncs.java
# Example Ruby versions of these functions are in http://shadow2531.com/ruby/mailto_funcs.rb
# Example Python versions of these functions are at http://shadow2531.com/py/mailto_funcs.py
# Example Perl versions of these functions are at http://shadow2531.com/perl/mailto_funcs.pl
# Newest versions: http://shadow2531.com/opera/testcases/mailto/MailtoURIParserPack.zip

# Trim the protcol (or change the protocol to to=) so that
# the data can be split by &. If it's not a mailto URI, 
# return an empty string.

proc prepareURIForParsing {uri} {
    set check [string tolower $uri]
    if {[string match mailto:\\?* $check] == 1} {
        return [string range $uri 8 [string length $uri] ]
    } elseif {[string match mailto:* $check] == 1} {
        set prep [string rang $uri 7 [string length $uri]]
        set q [string first ? $prep]
        if {$q != -1} {
            set prep [string replace $prep $q $q &]
        }
        return "to=$prep"
    }
    return []
}

# Use the last subject hvalue even if it's empty and even if a previous one is not

proc getSubject {uri} {
    set puri [prepareURIForParsing $uri]
    set hlist [split $puri &]
    set ret []
    foreach i $hlist {
        if {$i == ""} {
            continue
        }
        set eq [string first = $i]
        if {$eq == -1} {
            continue
        }
        set hname [string tolower [string rang $i 0 [expr {$eq - 1}] ] ]
        if {$hname != "subject"} {
            continue
        }
        set ret [string rang $i [expr {$eq + 1}] [string length $i] ]
    }
    return $ret
}

# Join all non-empty hvalues for the hname skey with %2C%20 (TO, CC and BCC rule)

proc getAddresses {uri skey} {
    set skey [string tolower $skey]
    set puri [prepareURIForParsing $uri]
    set hlist [split $puri &]
    set ret []
    foreach i $hlist {
        if {$i == ""} {
            continue
        }
        set eq [string first = $i]
        if {$eq == -1} {
            continue
        }
        set hname [string tolower [string rang $i 0 [expr {$eq - 1}] ] ]
        if {$skey != $hname} {
            continue
        }
        set hvalue [string rang $i [expr {$eq + 1}] [string length $i] ]
        if {$hvalue == ""} {
            continue
        }
        if {$ret != ""} {
            set ret $ret%2C%20
        }
        set ret $ret$hvalue
    }
    return $ret
}

# Join first non-empty body hvalue and all (even if they're empty) body hvalues after that with %0D%0A

proc getBody {uri} {
    set puri [prepareURIForParsing $uri]
    set hlist [split $puri &]
    set ret []
    foreach i $hlist {
        if {$i == ""} {
            continue
        }
        set eq [string first = $i]
        if {$eq == -1} {
            continue
        }
        set hname [string tolower [string rang $i 0 [expr {$eq - 1}] ] ]
        if {$hname != "body"} {
            continue
        }
        set hvalue [string rang $i [expr {$eq + 1}] [string length $i] ]
        if {$hvalue == "" && $ret == ""} {
            continue
        }
        if {$ret != ""} {
            set ret $ret%0D%0A
        }
        set ret $ret$hvalue
    }
    return $ret
}

# Decoded %HH. Treat Invalid %HH literally. Do not decode + to a space because
# mailto clients don't do that.

proc decode {val} {
    set i 0
    set len [string length $val]
    set hexits "0123456789ABCDEF"
    set ret []
    while { $i < $len } {
        set c [string rang $val $i $i]
        set next [expr {$i + 2}]
        if {$c == "%" && $next < $len} {
            set pnext [expr {$next - 1}]
            set c1 [string rang $val $pnext $pnext]
            set c2 [string rang $val $next $next]
            set pos1 [string first $c1 $hexits]
            set pos2 [string first $c2 $hexits]
            if {$pos1 == -1 || $pos2 == -1} {
                set ret $ret$c
            } else {
                set nval [format "%c" [expr {$pos1 * 16 + $pos2}] ]
                set ret $ret$nval
                set i [expr {$i + 2}]
            }
        } else {
            set ret $ret$c
        }
        set i [expr {$i + 1}]
    }
    # Make sure all newlines are represented as \n in the string
    set ret [string map {\r\n \n} $ret]
    set ret [string map {\r \n} $ret]
    return $ret
}

# Getter function wrappers

proc getEncodedTO {uri} {
    return [getAddresses $uri to]
}
proc getDecodedTO {uri} {
    return [decode [getEncodedTO $uri]]
}
proc getEncodedSubject {uri} {
    return [getSubject $uri]
}
proc getDecodedSubject {uri} {
    return [decode [getEncodedSubject $uri]]
}
proc getEncodedBody {uri} {
    return [getBody $uri]
}
proc getDecodedBody {uri} {
    return [decode [getEncodedBody $uri]]
}
proc getEncodedCC {uri} {
    return [getAddresses $uri cc]
}
proc getDecodedCC {uri} {
    return [decode [getEncodedCC $uri]]
}
proc getEncodedBCC {uri} {
    return [getAddresses $uri bcc]
}
proc getDecodedBCC {uri} {
    return [decode [getEncodedBCC $uri]]
}

# Create a mailto URI with just the basic hnames and no duplicate hnames

proc getNormalizedURI {uri} {
    return mailto:[getEncodedTO $uri]?subject=[getEncodedSubject $uri]&body=[getEncodedBody $uri]&cc=[getEncodedCC $uri]&bcc=[getEncodedBCC $uri]
}

# %w = original mailto uri
# %n = normalized
# %t = decoded TO
# %T = encoded TO
# %S = encoded Subject
# %s = decoded Subject
# %m = decoded Body
# %M = encoded Body
# %c = decoded CC
# %C = Encoded CC
# %b = decoded BCC
# %B = encoded BCC
# %% = %

# Replaced each key in s with its value
# Invalid keys are treated literally.

proc resolveCommandFormatString {uri s} {
    set i 0
    set len [string length $s]
    set ret []
    while {$i < $len} {
        set c [string rang $s $i $i]
        set next [expr {$i + 1}]
        if {$c == "%" && $next < $len} {
            set c1 [string rang $s $next $next]
            if {$c1 == "%"} {
                set ret $ret%
            } elseif {$c1 == "w"} {
                set ret $ret$uri
            } elseif {$c1 == "n"} {
                set ret $ret[getNormalizedURI $uri]
            } elseif {$c1 == "T"} {
                set ret $ret[getEncodedTO $uri]
            } elseif {$c1 == "t"} {
                set ret $ret[getDecodedTO $uri]
            } elseif {$c1 == "S"} {
                set ret $ret[getEncodedSubject $uri]
            } elseif {$c1 == "s"} {
                set ret $ret[getDecodedSubject $uri]
            } elseif {$c1 == "M"} {
                set ret $ret[getEncodedBody $uri]
            } elseif {$c1 == "m"} {
                set ret $ret[getDecodedBody $uri]
            } elseif {$c1 == "C"} {
                set ret $ret[getEncodedCC $uri]
            } elseif {$c1 == "c"} {
                set ret $ret[getDecodedCC $uri]
            } elseif {$c1 == "B"} {
                set ret $ret[getEncodedBCC $uri]
            } elseif {$c1 == "b"} {
                set ret $ret[getDecodedBCC $uri]
            } else {
                set ret $ret$c
                continue
            }
            set i [expr {$i + 1}]
        } else {
            set ret $ret$c
        }
        set i [expr {$i + 1}]
    }
    return $ret
}

proc test {t in out} {
    if {$in == $out} {
        puts "$t = pass"
    } else {
        puts "$t = fail"
        puts begin_$in\_end
    }
}

test 1 [getEncodedTO []] []
test 2 [getEncodedTO mailto:] []
test 3 [getEncodedTO mailto:?] []
test 4 [getEncodedTO mailto:email%40site.com] email%40site.com
test 5 [getEncodedTO mailto:?to=email%40site.com] email%40site.com
test 6 [getEncodedTO mailto:email1%40site.com%2C%20email2%40site.com?to=email3%40site.com%2C%20email4%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com%2C%20email4%40site.com
test 7 [getEncodedTO mailto:?to=email1%40site.com&to=email2%40site.com&to=email3%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com
test 8 [getEncodedTO mailto:?to=&to=&to=&to=&to=&to=&to=&to=&to=&to=&to=&to=&to=] []
test 9 [getEncodedTO mailto:?to=&to=email1%40site.com&to=&to=email2%40site.com&to=] email1%40site.com%2C%20email2%40site.com
test 10 [getEncodedSubject mailto:?subject=bark%20bark] bark%20bark
test 11 [getEncodedSubject mailto:?subject=] []
test 12 [getEncodedSubject mailto:?subject=&subject=] []
test 13 [getEncodedSubject mailto:?subject=1&subject=2&subject=last%20one] last%20one
test 14 [getEncodedSubject mailto:?subject=1&subject=] []
test 15 [getEncodedBody mailto:?body=line1%0D%0Aline2] line1%0D%0Aline2
test 16 [getEncodedBody mailto:?body=line1&body=line2] line1%0D%0Aline2
test 17 [getEncodedBody mailto:?body=&body=&body=line1] line1
test 18 [getEncodedBody mailto:?body=&body=&body=line1&body=&body=&body=line4&body=&body=] line1%0D%0A%0D%0A%0D%0Aline4%0D%0A%0D%0A
test 19 [getEncodedBody mailto:?body=line1&body=] line1%0D%0A
test 20 [getNormalizedURI mailto:email1%40site.com?to=&to=email2%40site.com&subject=1&subject=&subject=2&subject=&body=&body=&body=line1&body=&body=&body=line4&body=&cc=zam%40site.com&bcc=bam%40site.com] mailto:email1%40site.com%2C%20email2%40site.com?subject=&body=line1%0D%0A%0D%0A%0D%0Aline4%0D%0A&cc=zam%40site.com&bcc=bam%40site.com
set big mailto:%22a%5C%5Cb%22%20%3Cemail1%40site.com%3E%2C%20email2%40site.com?to=&to=email3%40site.com%2C%20email4%40site.com&to=email5%40site.com%2C%20email6%40site.com&to=&to=&subject=You%20should%20not%20see%20me%2E&subject=last%20call%20for%20cats%20%26%20dogs%2E&body=&body=&body=&body=line1%0D%0Aline2&body=&body=&body=&body=line6&body=line7%0D%0A1+2+3+4+5%0D%0AColumn1A%09Column1B%09Column1C%09Column1D%0D%0A%E2%88%9A&cc=%22a%5C%5Cb%22%20%3Csomeone1%40site.com%3E%2C%20someone2%40site.com&cc=&cc=someone3%40site.com%2C%20someone4%40site.com%2C%20%22foo%20%5C%22bar%5C%22%22%20%3Cfoo%40bar%2Ecom%3E&cc=&cc=&bcc=%22a%5C%5Cb%22%20%3Csomeoneelse1%40site.com%3E%2C%20someoneelse2%40site.com&bcc=&bcc=someoneelse3%40site.com%2C%20someoneelse4%40site.com&bcc=&bcc=
test 21 [getNormalizedURI $big] mailto:%22a%5C%5Cb%22%20%3Cemail1%40site.com%3E%2C%20email2%40site.com%2C%20email3%40site.com%2C%20email4%40site.com%2C%20email5%40site.com%2C%20email6%40site.com?subject=last%20call%20for%20cats%20%26%20dogs%2E&body=line1%0D%0Aline2%0D%0A%0D%0A%0D%0A%0D%0Aline6%0D%0Aline7%0D%0A1+2+3+4+5%0D%0AColumn1A%09Column1B%09Column1C%09Column1D%0D%0A%E2%88%9A&cc=%22a%5C%5Cb%22%20%3Csomeone1%40site.com%3E%2C%20someone2%40site.com%2C%20someone3%40site.com%2C%20someone4%40site.com%2C%20%22foo%20%5C%22bar%5C%22%22%20%3Cfoo%40bar%2Ecom%3E&bcc=%22a%5C%5Cb%22%20%3Csomeoneelse1%40site.com%3E%2C%20someoneelse2%40site.com%2C%20someoneelse3%40site.com%2C%20someoneelse4%40site.com
test 22 [resolveCommandFormatString $big "\"c:\\program files\\program\\program.exe\" \"%T\" \"%S\" \"%M\" \"%C\" \"%B\""] "\"c:\\program files\\program\\program.exe\" \"%22a%5C%5Cb%22%20%3Cemail1%40site.com%3E%2C%20email2%40site.com%2C%20email3%40site.com%2C%20email4%40site.com%2C%20email5%40site.com%2C%20email6%40site.com\" \"last%20call%20for%20cats%20%26%20dogs%2E\" \"line1%0D%0Aline2%0D%0A%0D%0A%0D%0A%0D%0Aline6%0D%0Aline7%0D%0A1+2+3+4+5%0D%0AColumn1A%09Column1B%09Column1C%09Column1D%0D%0A%E2%88%9A\" \"%22a%5C%5Cb%22%20%3Csomeone1%40site.com%3E%2C%20someone2%40site.com%2C%20someone3%40site.com%2C%20someone4%40site.com%2C%20%22foo%20%5C%22bar%5C%22%22%20%3Cfoo%40bar%2Ecom%3E\" \"%22a%5C%5Cb%22%20%3Csomeoneelse1%40site.com%3E%2C%20someoneelse2%40site.com%2C%20someoneelse3%40site.com%2C%20someoneelse4%40site.com\""
test 23 [resolveCommandFormatString $big %%T] %T
test 24 [getDecodedSubject mailto:?subject=%E2%88%9A] \xE2\x88\x9A
test 25 [getDecodedSubject mailto:?subject=1+2+3+4+5] 1+2+3+4+5
test 26 [getDecodedSubject mailto:?subject=%G3] %G3
test 27 [getDecodedSubject mailto:?subject=%%%] %%%
test 28 [getDecodedSubject mailto:?subject=%] %
test 29 [getDecodedBody mailto:?body=%0A%0D%0A%0D] \n\n\n
test 30 [getEncodedBody mailto:?&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&body=line1] line1
test 31 [getEncodedCC []] []
test 32 [getEncodedCC mailto:] []
test 33 [getEncodedCC mailto:?] []
test 34 [getEncodedCC mailto:?cc=email%40site.com] email%40site.com
test 35 [getEncodedCC mailto:?cc=email1%40site.com%2C%20email2%40site.com&cc=email3%40site.com%2C%20email4%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com%2C%20email4%40site.com
test 36 [getEncodedCC mailto:?cc=email1%40site.com&cc=email2%40site.com&cc=email3%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com
test 37 [getEncodedCC mailto:?cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=&cc=] []
test 38 [getEncodedCC mailto:?cc=&cc=email1%40site.com&cc=&cc=email2%40site.com&cc=] email1%40site.com%2C%20email2%40site.com
test 39 [getEncodedBCC []] []
test 40 [getEncodedBCC mailto:] []
test 41 [getEncodedBCC mailto:?] []
test 42 [getEncodedBCC mailto:?bcc=email%40site.com] email%40site.com
test 43 [getEncodedBCC mailto:?bcc=email1%40site.com%2C%20email2%40site.com&bcc=email3%40site.com%2C%20email4%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com%2C%20email4%40site.com
test 44 [getEncodedBCC mailto:?bcc=email1%40site.com&bcc=email2%40site.com&bcc=email3%40site.com] email1%40site.com%2C%20email2%40site.com%2C%20email3%40site.com
test 45 [getEncodedBCC mailto:?bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=&bcc=] []
test 46 [getEncodedBCC mailto:?bcc=&bcc=email1%40site.com&bcc=&bcc=email2%40site.com&bcc=] email1%40site.com%2C%20email2%40site.com
test 47 [getDecodedSubject mailto:?subject=m%26m%09bob] m&m\tbob
test 48 [resolveCommandFormatString mailto:email%40site.com %%%%%t] %%email@site.com
test 49 [getDecodedCC mailto:?cc=email%40site.com] email@site.com
test 50 [getDecodedTO mailto:?to=email%40site.com] email@site.com
test 51 [getDecodedBCC MaIlTo:?BcC=email%40site.com] email@site.com
set fmt "program_that_wants_decoded_values -to \"%t\" -subj \"%s\" -cc \"%c\" -bcc \"%b\" -body \"%m\""
set check "program_that_wants_decoded_values -to \"\"a\\\\b\" <email1@site.com>, email2@site.com, email3@site.com, email4@site.com, email5@site.com, email6@site.com\" -subj \"last call for cats & dogs.\" -cc \"\"a\\\\b\" <someone1@site.com>, someone2@site.com, someone3@site.com, someone4@site.com, \"foo \\\"bar\\\"\" <foo@bar.com>\" -bcc \"\"a\\\\b\" <someoneelse1@site.com>, someoneelse2@site.com, someoneelse3@site.com, someoneelse4@site.com\" -body \"line1\nline2\n\n\n\nline6\nline7\n1+2+3+4+5\nColumn1A\tColumn1B\tColumn1C\tColumn1D\n\xE2\x88\x9A\""
test 52 [resolveCommandFormatString $big $fmt] $check
test 53 [getEncodedTO []] []
test 54 [getEncodedBCC []] []
test 55 [getEncodedBody []] []
test 56 [getEncodedSubject []] []
test 57 [getNormalizedURI []] mailto:?subject=&body=&cc=&bcc=
test 58 [getDecodedTO []] []
test 59 [getDecodedBCC []] []
test 60 [getDecodedCC []] []
test 61 [getDecodedBody []] []
test 62 [getDecodedSubject []] []