--
--  $Id$
--
--  This file is part of the OpenLink Software Virtuoso Open-Source (VOS)
--  project.
--
--  Copyright (C) 1998-2024 OpenLink Software
--
--  This project is free software; you can redistribute it and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation; only version 2 of the License, dated June 1991.
--
--  This program is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--  General Public License for more details.
--
--  You should have received a copy of the GNU General Public License along
--  with this program; if not, write to the Free Software Foundation, Inc.,
--  51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
--

-- URI completion

create procedure
rpid64_str (in n int)
{
  declare s varchar;
  s := '\0\0\0\0\0\0\0\0';
  s := long_set (s, 0,  bit_or (bit_shift (n, -32), 0hex80000000));
  s := long_set (s, 1, bit_and (n, 0hexffffffff));
  return s;
}
;

create procedure
str_inc (in str varchar, in pref int := 0)
{
  -- increment by one for range cmp
  declare len int;
  len := length (str);
carry:
  if (pref = len)
    return subseq (str, 0, pref) || '\377\377\377\377\377\377\377\377';
  str [len - 1] := str[len - 1] + 1;
  if (str[len - 1] = 0)
    {
      len := len - 1;
      goto carry;
    }
  return str;
}
;

create procedure
cmp_find_iri (in str varchar, in no_name int := 0)
{
  /* We look for iris, assuming the full ns is in the name  */
  declare pref, name, next, local, ext varchar;
  declare rp64 varbinary;
  declare id, inx int;
  declare iris any;

  if (no_name)
    {
      pref := str;
      ext := '';
    }
  else
    {
      pref := iri_split (str, local, 1);
      ext := subseq (local, 8);
    }

  id := (select rp_id from rdf_prefix where rp_name = pref);
  if (id is null)
    return null;

  name := concat (rpid64_str (id), ext);
  if (no_name)
    next := rpid64_str (id + 1);
  else
    next := str_inc (name, 8);

  iris := (select vector_agg (ri_name) from (select top 20 ri_name from rdf_iri where ri_name >= name and ri_name < next) ir);
  if (length (iris) < 20 and length (iris) > 1) -- XXX: is next code needed at all?
    iris := (select vector_agg (ri_name) from (select ri_name from rdf_iri where ri_name >= name and ri_name < next order by iri_rank (ri_id) desc) ir);
  for (inx := 0; inx < length (iris); inx := inx + 1)
    {
      iris[inx] := concat (pref, subseq (iris[inx], 8));
    }
  return iris;
}
;

create procedure
cmp_find_ns (in str varchar)
{
  declare nss any;
  nss := (select vector_agg (rp_name)
            from (select top 20 rp_name
                    from rdf_prefix
                    where rp_name >= str and
                          rp_name < str_inc (str)) ns);

  return nss;
}
;


create procedure
cmp_with_ns (in str varchar)
{
  declare pref_str varchar;
  declare col int;

  col := position (':', str);

  if (col = 0)
    return null;

  pref_str := (select ns_url
                 from SYS_XML_PERSISTENT_NS_DECL
                 where ns_prefix = subseq (str, 0, col - 1));
  if (pref_str is null)
    return null;

  str := pref_str || subseq (str, col);
  return str;
}
;


create procedure
cmp_uri (in str varchar)
{
  declare with_ns varchar;
  declare nss, iris, exact_iri any;

--  dbg_printf ('cmp_uri\n');

  if (strstr (str, '://') is null)
    {
      with_ns := cmp_with_ns (str);

      if (with_ns is not null)
	return cmp_find_iri (with_ns);

      -- no protocol and no known prefix
      if (strstr (str, ':') is null)
	str := 'http://' || str;
    }

  nss := cmp_find_ns (str);

--  dbg_obj_print ('ns with ', str, ' = ', nss);

  exact_iri := cmp_find_iri (str);

  vectorbld_init (iris);
  foreach (any x in exact_iri) do
    {
      vectorbld_concat_acc (iris, vector (x));
    }
  foreach (any x in nss) do
    {
      vectorbld_concat_acc (iris, cmp_find_iri (x, 1));
    }
  vectorbld_final (iris);

  return iris;
}
;

create procedure
urilbl_ac_ruin_label (in lbl varchar)
{
  declare tmp any;
  tmp := regexp_replace (lbl, '[''",.]', '', 1, null);
  if (not iswidestring (tmp))
    tmp := charset_recode (tmp, 'UTF-8', '_WIDE_');
  tmp := upper (tmp);
  tmp := subseq (tmp, 0, 50);
  return charset_recode (tmp, '_WIDE_', 'UTF-8');
}
;

create procedure
urilbl_ac_init_log (in msg varchar)
{
--  dbg_printf(msg);
  insert into urilbl_cpl_log (ullog_msg) values (msg);
}
;

create procedure
urilbl_ac_init_state(in info integer := 1)
{
    declare sts integer;
    declare msg varchar;

    sts := cast (registry_get ('urilbl_ac_init_status') as integer);
    msg := case sts
	when 0		then 'Entity Lookup table has not been generated.'
	when 1		then 'Entity Lookup table (re)generation in progress.'
	when 2		then 'Entity Lookup table has been successfully generated.'
	when 4711 	then 'Entity Lookup table generation failed.'
	else 		      sprintf('Entity Lookup table in unknown state: %d', sts)
    end;

    if (info = 1) {
	if (sts = 2) return;
	http (sprintf ('
	    <div class="ac_info">
		<a href="urilbl_status.vsp"><img class="txt_i" alt="info" src="/fct/images/info.png"/></a>
		<span class="ac_info">%V Contact the site administrator.</span>
	    </div>
	', msg));
    } else {
	http(sprintf (' <p>%V</p', msg));
    }
}
;


create procedure
cmp_fill_lang_by_q (in accept varchar)
{
  declare itm varchar;
  declare arr, vec any;
  declare q float;
  declare i, l int;

  vec := vector ();
  arr := split_and_decode (accept, 0, '\0\0,;');
  q := 0;
  l := length (arr);
  for (i := 0; i < l; i := i + 2)
    {
      declare tmp any;
      itm := trim(arr[i]);
      q := arr[i+1];
      if (q is null)
        q := 1.0;
      else
        {
          tmp := split_and_decode (q, 0, '\0\0=');
          if (length (tmp) = 2)
            q := atof (tmp[1]);
          else
            q := 1.0;
        }
      vec := vector_concat (vec, vector (itm, q));
    }
  if (not position ('en', vec))
    vec := vector_concat (vec, vector ('en', 0.002));
  return vec;
}
;

