--
-- create type email under text;
--
-- Elein Mustain, elein@varlena.com, http://www.varlena.com
-- Published 19-Feb-2006 at http://www.varlena.com/GeneralBits/128.php
-- License: BSD, Share and enjoy
--

drop domain email cascade;

--
-- Check constraint isemail for email base type
-- Using "pretty good" but not strict rfc compliant regex
-- cf: http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59886
--
CREATE OR REPLACE FUNCTION isemail(text)
RETURNS BOOLEAN
AS $$
   if ( $_[0] =~ m/
       ^                  # Start.
        (                 # Start of $1
            [A-Z0-9]+     # Must start with some A-Z or 0-9s.
            [._]?         # May have a . or an _ after that
        )                 # End of $1
        {1,}              # One or more of $1.
        [A-Z0-9]+         # More alphanumerics
        \@                # Literal @ sign
        (                 # Start of $2
            (             # Start of $3
                [A-Z0-9]+ # More alphanumerics
                [-]?      # At most one - sign.
            )             # End of $3
            {1,}          # One or more of $3
            [A-Z0-9]+\.   # More alphanumerics
        )                 # End of $2
        {1,}              # One or more of $2.
        [A-Z]{2,4}        # 2-4 letters
        $                 # End.
    /ix ) {
      return TRUE;
   }
   else {
      return FALSE;
   }
$$ LANGUAGE 'plperl' STRICT IMMUTABLE;

--
-- create type email under text
--
CREATE DOMAIN email AS text CHECK ( isemail( VALUE) );

--
-- Comparison and Equality Functions
--
-- cmp: 0 if equal, 1 if greater than, -1 if less than
CREATE OR REPLACE FUNCTION email_cmp(email,email)
RETURNS INTEGER AS
$$
	SELECT CASE WHEN lower($1) = lower($2) THEN 0
	            WHEN lower($1) > lower($2) THEN 1
	ELSE -1
	END;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

-- Equals: lower(text) = lower(text)
CREATE OR REPLACE FUNCTION email_eq (email, email) RETURNS boolean AS
$$
	SELECT CASE WHEN email_cmp($1, $2) = 0 
	THEN TRUE ELSE FALSE END;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

-- Greater than: lower(text) > lower(text)
CREATE OR REPLACE FUNCTION email_gt (email, email) RETURNS boolean AS
$$
	SELECT CASE WHEN email_cmp($1, $2) > 0 
	THEN TRUE ELSE FALSE END;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

-- Less than: lower(text) < lower(text)
CREATE OR REPLACE FUNCTION email_lt (email, email) RETURNS boolean AS
$$
	SELECT CASE WHEN email_cmp($1, $2) < 0 
	THEN TRUE ELSE FALSE END;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

--Greater than or Equals
CREATE OR REPLACE FUNCTION email_gte (email, email) RETURNS boolean AS
$$
	SELECT CASE WHEN email_cmp($1,$2) = 0 OR email_cmp($1,$2) = 1
	THEN TRUE ELSE FALSE end;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

--Less than or Equals
CREATE OR REPLACE FUNCTION email_lte (email, email) RETURNS boolean AS
$$
	SELECT CASE WHEN email_cmp($1,$2) = 0 OR email_cmp($1,$2) = -1
	THEN TRUE ELSE FALSE END;
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

--Like
CREATE OR REPLACE FUNCTION email_like(email, text) RETURNS boolean AS
$$
	SELECT lower($1) LIKE lower($2);
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;

--
-- Operators
--
CREATE OPERATOR =  ( PROCEDURE = email_eq, LEFTARG = email, RIGHTARG = email);
CREATE OPERATOR >  ( PROCEDURE = email_gt, LEFTARG = email, RIGHTARG = email);
CREATE OPERATOR >= ( PROCEDURE = email_gte, LEFTARG = email, RIGHTARG = email);
CREATE OPERATOR <  ( PROCEDURE = email_lt, LEFTARG = email, RIGHTARG = email);
CREATE OPERATOR <= ( PROCEDURE = email_lte, LEFTARG = email, RIGHTARG = email);
CREATE OPERATOR ~~  ( PROCEDURE = email_like, LEFTARG = email, RIGHTARG = text);

--
-- Operator Class
--
CREATE OPERATOR CLASS email_ops
DEFAULT FOR TYPE email USING BTREE AS
	OPERATOR 1 <,
	OPERATOR 2 <=, 
	OPERATOR 3 =,
	OPERATOR 4 >=,
	OPERATOR 5 >,
	FUNCTION 1 email_cmp(email,email)
;

--
-- Accessor functions
--
-- login: before the @ sign
CREATE OR REPLACE FUNCTION email_login (email) RETURNS text AS
$$
	return (split(/\@/, $_[0]))[0];
$$ LANGUAGE 'plperl' IMMUTABLE STRICT;

-- Full Domain: after the @ sign
CREATE OR REPLACE FUNCTION email_fdomain (email) RETURNS text AS
$$
	return  (split /\@/, $_[0])[-1];
$$ LANGUAGE 'plperl' IMMUTABLE STRICT;

-- Top Level Domain:: after the last dot
CREATE OR REPLACE FUNCTION email_domain_type (email) RETURNS text AS
$$
	return (split(   # Split the output of split below
        /\./,  # Split the following on "."
        (
            split(
                /\@/,  # Split whole input on "@"
                $_[0]
            )
        )[-1]  # last part of inner split
    ))[-1];  # last part of outer split
$$ LANGUAGE 'plperl' IMMUTABLE STRICT;

-- Reverse Domain
CREATE OR REPLACE FUNCTION email_reverse_domain(email) RETURNS text AS
$$
   return join(".", reverse split(   # Split the output of split below
        /\./,  # Split the following on "."
        (
            split(
                /\@/,  # Split whole input on "@"
                $_[0]
            )
        )[-1]  # last part of inner split
    ));
$$ LANGUAGE 'plperl' IMMUTABLE STRICT;

-- Nonsense function to ensure func select will choose this one
CREATE OR REPLACE FUNCTION email_n(email, integer) returns text as
$$
	select $1::text || '-' || $2::numeric
$$ LANGUAGE 'SQL' IMMUTABLE STRICT;
create operator * ( PROCEDURE= email_n, LEFTARG=email, RIGHTARG=integer);