--
-- Glyn Astill 09/02/2014
-- Plperl untrusted functions to do conversion from DOS cp850 native through Latin1 to UTF8 and vice versa
--

-- The following functions require the user to know what their client_encoiding is and call the appropriate function

DROP FUNCTION IF EXISTS cp850_to_latin1(text);
CREATE OR REPLACE FUNCTION cp850_to_latin1(text)
RETURNS text AS
$BODY$
	use Encode;
        return encode( 'utf8', decode('cp850', $_[0] ));
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.cp850_to_latin1(text) IS 'Converts text from cp850 to current latin1';

--

DROP FUNCTION IF EXISTS cp850_to_utf8(text);
CREATE OR REPLACE FUNCTION cp850_to_utf8(text)
RETURNS text AS
$BODY$
	use Encode;
        return encode( 'iso-8859-1', decode('cp850', $_[0] ));
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.cp850_to_utf8(text) IS 'Converts text from cp850 to current utf8';

--

DROP FUNCTION IF EXISTS latin1_to_cp850(text);
CREATE OR REPLACE FUNCTION latin1_to_cp850(text)
RETURNS text AS
$BODY$
	use Encode;
        return encode( 'cp850', decode('utf8', $_[0] ));
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.latin1_to_cp850(text) IS 'Converts text from current latin1 to cp850';

--

DROP FUNCTION IF EXISTS utf8_to_cp850(text);
CREATE OR REPLACE FUNCTION utf8_to_cp850(text)
RETURNS text AS
$BODY$
	use Encode;
        return encode( 'cp850', decode('iso-8859-1', $_[0] ));
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.utf8_to_cp850(text) IS 'Converts text from current utf8 to cp850';

-- The following functions do not require the user to know what their client_encoiding is

DROP FUNCTION IF EXISTS public.to_cp850(text);
CREATE OR REPLACE FUNCTION public.to_cp850(text)
RETURNS text AS
$BODY$
	use Encode;
	my $string;
	my $rv = spi_exec_query('SELECT pg_client_encoding();', 1);
	my $encoding = $rv->{rows}[0]->{pg_client_encoding};
	
	eval {
		if ($encoding eq 'UTF8') {
			$string = encode( 'cp850', decode('iso-8859-1', $_[0] ));
		}
		elsif (($encoding eq 'LATIN1') || ($encoding eq 'SQL_ASCII')){
			$string = encode( 'cp850', decode('utf8', $_[0] ));
		}
		else {
			elog(ERROR, "to_cp850 currently does not support client_encoding $encoding");
		}
	};
	if ($@) {
		elog(WARNING, "Re-encoding failed, stripping non alphanumerics: $@");
		$string = $_[0] =~ s/[\x01-\x7f]/?/g;
	}
        return $string;
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.to_cp850(text) IS 'Converts text from current client_encoding to cp850';

--

DROP FUNCTION IF EXISTS public.from_cp850(text);
CREATE OR REPLACE FUNCTION public.from_cp850(text)
RETURNS text AS
$BODY$
	use Encode;
	my $string;
	my $rv = spi_exec_query('SELECT pg_client_encoding();', 1);
	my $encoding = $rv->{rows}[0]->{pg_client_encoding};
	
	eval {
		if ($encoding eq 'UTF8') {
			$string = encode( 'iso-8859-1', decode('cp850', $_[0] ));
		}
		elsif (($encoding eq 'LATIN1') || ($encoding eq 'SQL_ASCII')){
			$string = encode( 'utf8', decode('cp850', $_[0] ));
		}
		else {
			elog(ERROR, "from_cp850 currently does not support client_encoding $encoding");
		}
	};
	if ($@) {
		elog(WARNING, "Re-encoding failed: $@");
		$string = $_[0];
	}
        return $string;

        
$BODY$
LANGUAGE 'plperlu' IMMUTABLE;

COMMENT ON FUNCTION public.from_cp850(text) IS 'Converts text from cp850 to current client_encoding';