CREATE OR REPLACE FUNCTION tools.session__set(p_key TEXT, value TEXT) RETURNS VOID AS $$ BEGIN { strict->import(); } my $p_key = shift; my $value = shift; # remove hash element if NULL is passed as a value if (!defined $value) { delete $_SHARED{$p_key}; return; } # perform assignment only if the hash slot holds a value and not a hash reference if (exists $_SHARED{$p_key} && ref $_SHARED{$p_key}) { die sprintf '%s{%s} is a reference', '%_SHARED', "$p_key"; } $_SHARED{$p_key} = $value; $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__set(p_key1 TEXT, p_key2 TEXT, value TEXT) RETURNS VOID AS $$ BEGIN { strict->import(); } my $p_key1 = shift; my $p_key2 = shift; my $value = shift; if (exists $_SHARED{$p_key1} && ref $_SHARED{$p_key1} ne "HASH") { die sprintf '%s{%s} is not a hash reference', '%_SHARED', "$p_key1"; } # remove hash element if NULL is passed as a value if (!defined $value) { delete $_SHARED{$p_key1}{$p_key2}; return; } # perform assignment only if the hash slot holds a value and not a hash reference if (exists $_SHARED{$p_key1}{$p_key2} && ref $_SHARED{$p_key1}{$p_key2}) { die sprintf '%s{%s}{%s} is a reference', '%_SHARED', "$p_key1", "$p_key2"; } if (!exists $_SHARED{$p_key1}) { $_SHARED{$p_key1} = {$p_key2 => $value}; } else { $_SHARED{$p_key1}{$p_key2} = $value ; } $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__set(p_key1 TEXT, p_key2 TEXT, p_key3 TEXT, value TEXT) RETURNS VOID AS $$ BEGIN { strict->import(); } my $p_key1 = shift; my $p_key2 = shift; my $p_key3 = shift; my $value = shift; if (exists $_SHARED{$p_key1}{$p_key2} && ref $_SHARED{$p_key1}{$p_key2} ne "HASH") { die sprintf '%s{%s}{%s} is not a hash reference', '%_SHARED', "$p_key1", "$p_key2"; } # remove hash element if NULL is passed as a value if (!defined $value) { delete $_SHARED{$p_key1}{$p_key2}{$p_key3}; return; } elsif (!exists $_SHARED{$p_key1}) { $_SHARED{$p_key1} = {$p_key2 => {$p_key3 => $value}}; } elsif (!exists $_SHARED{$p_key1}{$p_key2}) { $_SHARED{$p_key1}{$p_key2} = {$p_key3 => $value}; } else { $_SHARED{$p_key1}{$p_key2}{$p_key3} = $value; } $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__get(p_key TEXT) RETURNS TEXT AS $$ BEGIN { strict->import(); } my $p_key = shift; my $value = $_SHARED{$p_key}; if (ref $value) { die sprintf "%s{%s} is a reference", '$_SHARED', "$p_key"; } return $value; $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__get(p_key1 TEXT, p_key2 TEXT) RETURNS TEXT AS $$ BEGIN { strict->import(); } my $p_key1 = shift; my $p_key2 = shift; my $hashref = $_SHARED{$p_key1}; return undef if (!defined $hashref); if (ref $hashref eq "HASH") { return $_SHARED{$p_key1}{$p_key2} unless ref $_SHARED{$p_key1}{$p_key2}; die sprintf "%s{%s}{%s} is a reference", '%_SHARED', "$p_key1", "$p_key2"; } else { die sprintf "%s{%s} is not a hash reference", '$_SHARED', "$p_key1"; } $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__get(p_key1 TEXT, p_key2 TEXT, p_key3 TEXT) RETURNS TEXT AS $$ BEGIN { strict->import(); } my $p_key1 = shift; my $p_key2 = shift; my $p_key3 = shift; return undef if (!defined $_SHARED{$p_key1}); my $hashref = $_SHARED{$p_key1}{$p_key2}; return undef if (!defined $hashref); if (ref $hashref eq "HASH") { # note that unlike 2 arguments _get we don't check whether the result is a reference # due to the fact that we don't provide an API for creating 3-level nested hashes. return $_SHARED{$p_key1}{$p_key2}{$p_key3}; } else { die sprintf "%s{%s}{%s} is not a hash reference", '$_SHARED', "$p_key1", "$p_key2"; } $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__clean(mode TEXT, source_keys TEXT) RETURNS VOID AS $$ BEGIN { strict->import(); } my $mode = shift; my $key_string = shift; my (@source_keys, @target_keys); # parse the string and form the keys list. foreach my $key (split (/,*\s/, $key_string)) { push @source_keys, $key; } if (lc($mode) eq "delete") { @target_keys = @source_keys; } elsif (lc($mode) eq "keep") { # get only those keys that are not in the list of source_keys my %source_hash = map {$_ => 1} @source_keys; @target_keys = grep $source_hash{$_} != 1, (keys %_SHARED); } else { die "Invalid value for the \'mode\' argument: $mode"; } # remove elements from the hash foreach (@target_keys) { delete $_SHARED{$_}; } $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__list() RETURNS TEXT AS $$ BEGIN { strict->import(); } my $result = ""; foreach my $key (sort keys %_SHARED) { if (! ref $_SHARED{$key}) { $result.= $key." => ".$_SHARED{$key}."\n"; } elsif (ref $_SHARED{$key} eq "HASH") { foreach my $key2 (sort keys %{$_SHARED{$key}}) { if (! ref $_SHARED{$key}{$key2}) { $result.= $key. ", ".$key2." => ".$_SHARED{$key}{$key2}."\n"; } else { foreach my $key3 (sort keys %{$_SHARED{$key}{$key2}}) { $result.= $key.", ".$key2.", ".$key3." => ".$_SHARED{$key}{$key2}{$key3}."\n"; } } } } else { die sprintf "Reference %s{%s} is not a hash reference", '$_SHARED', $key; } } return $result; $$ LANGUAGE plperl SECURITY DEFINER; CREATE OR REPLACE FUNCTION tools.session__reset() RETURNS VOID AS $$ BEGIN { strict->import(); } %_SHARED = (); $$ LANGUAGE plperl SECURITY DEFINER;