/* *********************************************************************
This source file is a part of the standard library of Scol
For the latest info, see http://www.scolring.org
Copyright (c) 2013 Stephane Bisaro aka Iri
Some functions has been originally written to the Openspace3d project.
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.
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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA 02111-1307, USA, or go to
http://www.gnu.org/copyleft/lesser.txt
********************************************************************* */
/*
* Standard functions for string
* See http://redmine.scolring.org/projects/tutorials/wiki/Scol_usage
* for more informations
*/
/*! \file string.pkg
* \author Scol team
* \version 0.2
* \copyright GNU Lesser General Public License 2.0 or later
* \brief Scol Standard Library - String API
*
* \details This API provides an high level method to easily include string manipulations
*
**/
/*! \brief Check if a string is empty (nil or "")
*
* \ingroup std_string
* Prototype: fun [S] I
*
* \param S : the string to test
*
* \return I : 1 if empty else 0
**/
fun std_szIsEmpty (str)=
((str == nil) || (!strcmp str ""));;
/*! \brief Check if the first string is found to be less than
* the second string. This function is case-sensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if less otherwise 0
**/
fun std_szLesser (s1, s2)=
(strcmp s1 s2) < 0;;
/*! \brief Check if the first string is found to be greater than
* the second string. This function is case-sensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if greater 0 otherwise
**/
fun std_szGreater (s1, s2)=
(strcmp s1 s2) > 0;;
/*! \brief Check if the first string is found to be less than
* the second string. This function is case-insensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if less otherwise 0
**/
fun std_sziLesser (s1, s2)=
(strcmpi s1 s2) < 0;;
/*! \brief Check if the first string is found to be greater than
* the second string. This function is case-insensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if greater 0 otherwise
**/
fun std_sziGreater (s1, s2)=
(strcmpi s1 s2) > 0;;
/*! \brief Check if the first string is found to be equal, less or greater than
* the second string. This function is case-sensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : a negative value if lesser, a positive value if greater
* 0 if equal
**/
fun std_szCmp (s1, s2)=
strcmp s1 s2;;
/*! \brief Check if two strings are equals. This function is case-sensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if equal, otherwise 0
**/
fun std_szIsEqual (s1, s2)=
!strcmp s1 s2;;
/*! \brief Check if the first string is found to be equal, less or greater than
* the second string. This function is case-insensitive.
*
* \ingroup std_string
* Prototype: fun [S S] I
*
* \param S : first string to test
* \param S : second string to test
*
* \return I : a negative value if lesser, a positive value if greater
* 0 if equal
**/
fun std_sziCmp (s1, s2)=
strcmpi s1 s2;;
/*! \brief Check if two strings are equals. This function is case-insensitive.
*
* Prototype: fun [S S] I
*
* \ingroup std_string
* \param S : first string to test
* \param S : second string to test
*
* \return I : 1 if equal, otherwise 0
**/
fun std_sziIsEqual (s1, s2)=
!strcmpi s1 s2;;
/*! \brief Test if a string exist in a list.
* This function is case-sensitive.
*
* Prototype: fun [[S r1] S] I
*
* \ingroup std_string
* \param [S r1] : list
* \param S : string to search
*
* \return I : 1 if the string exist in the list 0 otherwise
**/
fun std_szInList (list, string)=
(list != nil) && ((!strcmp string hd list) || (std_szInList tl list string));;
/*! \brief Test if a string exist in a list.
* This function is case-insensitive.
*
* Prototype: fun [[S r1] S] I
*
* \ingroup std_string
* \param [S r1] : list
* \param S : string to search
*
* \return I : 1 if the string exist in the list 0 otherwise
**/
fun std_sziInList (list, string)=
(list != nil) && ((!strcmpi string hd list) || (std_sziInList tl list string));;
/*! \brief Test if a string exist in a list from a given position.
* This function is case-sensitive.
*
* Prototype: fun [[S r1] S I I] I
*
* \ingroup std_string
* \param [S r1] : list
* \param S : string to search
*
* \return I : 1 if the string exist in the list 0 otherwise
**/
fun std_szInListFromPos (list, string, pos, length)=
(list != nil) && ((!strcmp string (substr (hd list) pos length)) || (std_szInListFromPos tl list string pos length));;
/*! \brief Test if a string exist in a list from a given position.
* This function is case-insensitive.
*
* Prototype: fun [[S r1] S I I] I
*
* \ingroup std_string
* \param [S r1] : list
* \param S : string to search
*
* \return I : 1 if the string exist in the list 0 otherwise
**/
fun std_sziInListFromPos (list, string, pos, length)=
(list != nil) && ((!strcmpi string (substr (hd list) pos length)) || (std_sziInListFromPos tl list string pos length));;
/*! \brief Add a string element as unique. This function is
* case-sensitive.
*
* Prototype: fun [[S r1] S] [S r1]
*
* \ingroup std_string
* \param [S r1] : list
* \param S : element to add
*
* \return [S r1] : new list
**/
fun std_szAddUnique (list, str)=
if (std_szInList list str) then
list
else
str :: list;;
/*! Add a string element as unique. This function is case-sensitive.
*
* Prototype: fun [[S r1] [S I]] [S r1]
*
* \ingroup std_string
* \param [S r1] : list
* \param [S I] : string to add and the result : 1 is set if the string is added, else 0
*
* \return [S r1] : new list
*
*
(...)
_showconsole;
let "aa" :: "az" :: "12" :: "sdf" :: "aa" :: "ws" :: nil -> ls in
let ["as" nil] -> tuple1 in
let ["aa" nil] -> tuple2 in
(
_fooSList std_szAddUniqueResult ls tuple1; // "as:"aa":"az":"12":"sdf":"aa":"ws";nil
_fooS sprintf "%s %i" tuple1; // string added and result (1)
_fooSList std_szAddUniqueResult ls tuple2; // "aa":"az":"12":"sdf":"aa":"ws";nil
_fooS sprintf "%s %i" tuple2; // string added and result (0, "aa" is already in the list)
(...)
*
**/
fun std_szAddUniqueResult (list, tuple)=
let tuple -> [str result] in
if (std_szInList list str) then
(
mutate tuple <- [str 0];
list
)
else
(
mutate tuple <- [str 1];
str :: list;
);;
/*! \brief Add a string element as unique. This function is
* case-insensitive.
*
* \ingroup std_string
* Prototype: fun [[S r1] S] [S r1]
*
* \param [S r1] : list
* \param S : element to add
*
* \return [S r1] : new list
**/
fun std_sziAddUnique (list, str)=
if (std_sziInList list str) then
list
else
str :: list;;
/*! \brief Add a string element as unique. This function is
* case-insensitive.
*
* Prototype: fun [[S r1] [S I]] [S r1]
*
* \param [S r1] : list
* \param [S I] : string to add and the result : 1 is set if the string is added, else 0
*
* \ingroup std_string
* \return [S r1] : new list
**/
fun std_sziAddUniqueResult (list, tuple)=
let tuple -> [str result] in
if (std_sziInList list str) then
(
mutate tuple <- [str 0];
list
)
else
(
mutate tuple <- [str 1];
str :: list;
);;
/*fun std_sziAddUniqueResult2 (tuple)=
let tuple -> [list str] in
if (std_sziInList list str) then
0
else
(
mutate tuple <- [str :: list _];
1
);;*/
fun std_szgetposinlist (list, string, n, flag)=
if list == nil then
nil
else
if flag == 0 then // insensitive
if (!strcmpi hd list string) then
n
else
std_szgetposinlist tl list string n+1 flag
else // sensitive
if (!strcmp hd list string) then
n
else
std_szgetposinlist tl list string n+1 flag;;
/*! \brief Get the position of a string in a list. This function is
* case-sensitive.
*
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : list
* \param S : a string to found
*
* \ingroup std_string
* \return I : the position or nil if not found
**/
fun std_szGetPosInList (list, string)=
std_szgetposinlist list string 0 1;;
/*! \brief Get the position of a string in a list. This function is
* case-insensitive.
*
* Prototype: fun [[S r1] S] I
*
* \param [S r1] : list
* \param S : a string to found
*
* \ingroup std_string
* \return I : the position or nil if not found
**/
fun std_sziGetPosInList (list, string)=
std_szgetposinlist list string 0 0;;
/*! \brief Remove the last char of any string
*
* Prototype: fun [S] S
*
* \param S : a string
*
* \ingroup std_string
* \return S : the same string less the last char
**/
fun std_szRemoveLastChar (str)=
substr str 0 (strlen str)-1;;
/*! \brief Check the last char of a string
*
* Prototype: fun [S S] I
*
* \param S : a string
* \param S : a string (if more one char, the only first char is taken)
*
* \return I : 1 if equal, otherwise 0
* \ingroup std_string
**/
fun std_szCheckLastChar (str, c)=
(nth_char c 0) == nth_char str (strlen str)-1;;
fun std_szstrfindr (str, sub, pos, flag)=
let if flag then strfind sub str 0 else strfindi sub str 0 -> p in
if p == nil then
pos
else
std_szstrfindr substr str p+1 strlen str sub p+pos+1 flag;;
/*! \brief Find the last position of a given substring.
* Function case-sensitive.
*
* Prototype: fun [S S] I
*
* \param S : a string
* \param S : a sub-string
*
* \return I : the last position or -1 if not found
* \ingroup std_string
**/
fun std_szStrfindR (str, substr)=
std_szstrfindr str substr (-1) 1;;
/*! \brief Find the last position of a given substring.
* Function case-insensitive.
*
* Prototype: fun [S S] I
*
* \param S : a string
* \param S : a sub-string
*
* \return I : the last position or -1 if not found
* \ingroup std_string
**/
fun std_sziStrfindR (str, substr)=
std_szstrfindr str substr (-1) 0;;
/*! \brief Return if a string contains digits only (0123456789)
*
* Prototype: fun [S] I
*
* \param S : a string
*
* \return I : 1 if ok else 0
* \ingroup std_string
**/
fun std_szIsDigit (str)=
let "0123456789" -> ref in
let 0 -> i in
let 1 -> r in
(
while ((i < (strlen str)) && (r == 1)) do
let strfind substr str i 1 ref 0 -> p in
if p == nil then
set r = 0
else
set i = i+1;
r
);;
fun std_szbuildpattern (pattern)=
// alpha + lower
let strfind "[az]" pattern 0 -> poslower in
set pattern = if poslower != nil then
let "abcdefghijklmnopqrstuvwxyz" -> s in
strcat substr pattern 0 poslower
strcat s substr pattern poslower+4 strlen pattern
else
pattern;
// alpha + upper
let strfind "[AZ]" pattern 0 -> posupper in
set pattern = if posupper != nil then
let "ABCDEFGHIJKLMNOPQRSTUVWXYZ" -> s in
strcat substr pattern 0 posupper
strcat s substr pattern posupper+4 strlen pattern
else
pattern;
// alpha + lower and upper
let strfind "[aZ]" pattern 0 -> posalpha in
set pattern = if posalpha != nil then
let "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -> s in
strcat substr pattern 0 posalpha
strcat s substr pattern posalpha+4 strlen pattern
else
pattern;
// digit
let strfind "[09]" pattern 0 -> posnum in
set pattern = if posnum != nil then
let "0123456789" -> s in
strcat substr pattern 0 posnum
strcat s substr pattern posnum+4 strlen pattern
else
pattern;
pattern;;
/*! \brief Return if a string contains the characters pattern only
*
* _fooId std_szIsPattern "mississipi" "mpsie"; // 1
* _fooId std_szIsPattern "michigan" "mpsie"; // 0
*
* Prototype: fun [S] I
*
* \param S : a string
* \param S : a pattern
*
* \return I : 1 if ok else 0.
*
* \remark "[az]" is equal at "abcdefghijklmnopqrstuvwxyz",
* "[AZ]" is equal at "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
* "[aZ]" is equalt at "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" and
* "[09]" is equal at "0123456789". So a pattern such as
* "+-.=[az][09]" is valid and it is equal at "+-.=abcdefghijklmnopqrstuvwxyz0123456789".
* There are no 'joker' supported.
*
* \remark to include a double quote ("), escape it.
* \ingroup std_string
**/
fun std_szIsPattern (str, pattern)=
if (std_szIsEmpty str) || (std_szIsEmpty pattern) then
0
else
let 0 -> i in
let 1 -> r in
(
set pattern = std_szbuildpattern pattern;
while ((i < (strlen str)) && (r == 1)) do
//let strfind substr str i 1 pattern 0 -> p in
let strfind ctoa nth_char str i pattern 0 -> p in
if p == nil then
set r = 0
else
set i = i+1;
r
);;
/*! \brief Cut a string when the first seperator is found
*
* _fooS sprintf "%s %s" std_szCutFromSep "lib/std/string.pkg" "/"; // lib std/string.pkg
*
* Prototype: fun [S S] [S S]
*
* \param S : a string
* \param S : any separator (one or more chars)
*
* \return I : a tuple with the two sub-strings or nil if separator is not found
* \ingroup std_string
**/
fun std_szCutFromSep (str, sep)=
if (str == nil) || (sep == nil) then
[str str]
else
[(substr str 0 (strfind sep str 0)) (substr str ((strfind sep str 0) + 1) strlen str)];;
/*! \brief Cut a string with all seperator found
*
* _fooSList std_szCutFromSepAll "lib/std/string.pkg" "/"; // lib :: std :: string.pkg :: nil
*
* Prototype: fun [S S] [S r1]
*
* \ingroup std_string
* \param S : a string
* \param S : any separator (one or more chars)
*
* \return I : a list of sub-strings. If no seperator found, the list has only one no-nil element
* with the entire string.
**/
fun std_szCutFromSepAll (str, sep)=
let strfind sep str 0 -> pos in
if pos == nil then
str :: nil
else
let std_szCutFromSep str sep -> [szFirst szNext] in
szFirst :: std_szCutFromSepAll szNext sep;;
/*! \brief Get the boolean value of a string. This function is insensitive-case.
*
* \ingroup std_string
* Prototype: fun [S] I
*
* \param S : the boolean value "enable" "1" "on" "true" "yes"
*
* \return I : 1 if the boolean value is correct, 0 otherwise
**/
fun std_szGetBoolean (str)=
if (!strcmpi strtrim str "enable")
|| (!strcmpi strtrim str "on")
|| (!strcmpi strtrim str "true")
|| (!strcmpi strtrim str "yes")
|| ((atoi str) == 1) then
1
else
0;;
/*! \brief Compare if a sub string is in a string at a given position.
* This function is sensitive-case.
*
* \ingroup std_string
* Prototype: fun [S S I] I
*
* \param S : the full string
* \param S : the substring to compare
* \param I : a position (if nil, the position will be 0)
*
* \return I : 1 if ok, 0 otherwise
**/
fun std_szCheckSubPos (str, sub, pos)=
pos == strfind sub str 0;;
/*! \brief Compare if a sub string is in a string at a given position.
* This function is insensitive-case.
*
* \ingroup std_string
* Prototype: fun [S S I] I
*
* \param S : the full string
* \param S : the substring to compare
* \param I : a position (if nil, the position will be 0)
*
* \return I : 1 if ok, 0 otherwise
**/
fun std_sziCheckSubPos (str, sub, pos)=
pos == strfindi sub str 0;;
/*! \brief Replace a string in an another string. Case sensitive.
* \remark you can use the SYSPACK API : \c strreplace (fun [S S S I] S)
* faster but the syspack library is required on the client.
*
* \ingroup std_string
* Prototype: fun [S S S] S
*
* \param S : the string to change
* \param S : the string to find
* \param S : the string to replace with
*
* \return S : the new string
**/
fun std_szReplace (s, from, to)=
let 0 -> pos in
let strlen from -> fsize in
let strlen to -> tsize in
if ((fsize <= 0) || (tsize <= 0)) then nil else
while ((set pos = strfind from s pos) != nil) do
(
set s = strcatn (substr s 0 pos)::to::(substr s (pos + fsize) ((strlen s) - pos))::nil;
set pos = pos + tsize;
);
s;;
/*! \brief Replace a string in an another string. Case insensitive.
*
* \ingroup std_string
* Prototype: fun [S S S] S
*
* \param S : the string to change
* \param S : the string to find
* \param S : the string to replace with
*
* \return S : the new string
**/
fun std_sziReplace (s, from, to)=
let 0 -> pos in
let strlen from -> fsize in
let strlen to -> tsize in
if ((fsize <= 0) || (tsize <= 0)) then nil else
while ((set pos = strfindi from s pos) != nil) do
(
set s = strcatn (substr s 0 pos)::to::(substr s (pos + fsize) ((strlen s) - pos))::nil;
set pos = pos + tsize;
);
s;;
/*! \brief replace key by value position in arg list ("my string is $1 with $2" "val1"::"val2"::nil)
* \remark you can use the SYSPACK API : \c sprintf (fun [S u0] S)
* faster but the syspack library is required on the client.
*
* \ingroup std_string
* Prototype: fun [S S [S r1]] S
*
* \param S : string
* \param S : the key "$" for example
* \param [S r1] : list of arguments
*
* \return S : the converted string
**/
fun std_szReplaceKeys (s, key, args)=
let sizelist args -> size in
(
while (size > 0) do
(
if nil == strfind key s 0 then set size = 0 else 0; // more element in list than keys
set s = std_szReplace s (strcat key (itoa size)) (nth_list args (size - 1));
set size = size - 1;
);
s;
);;
/*! \brief Concat a string list with a defined separator
*
* \ingroup std_string
* Prototype: fun [[S r1] S] S
*
* \param [S r1] : the string list
* \param S : the separator to use
*
* \return S : the new string
**/
fun std_szCatSep (list, sep)=
let sizelist list -> size in
let nil -> ndata in
let 0 -> i in
(
while i < size do
(
let nth_list list i -> elem in
if i == 0 then
set ndata = elem
else
set ndata = strcatn ndata::sep::elem::nil;
set i = i + 1;
);
ndata;
);;
/*! \brief Protect special character with a '\'
*
* \ingroup std_string
* Prototype: fun [S [I r1]] S
*
* \param S : the string to protect
* \param S : a list of ascii char to escape (% -> 37, & -> 38, ...)
*
* \return S : the new string
**/
fun std_szAddEscape (str, lAsc)=
let "" -> szOut in
let strlen str -> len in
let 0 -> i in
(
while (i < len) do
let nth_char str i -> char in
(
if !std_lIsInList lAsc char then
set szOut = strcatn szOut :: "\\" :: (ctoa char) :: nil
else
set szOut = strcat szOut ctoa char;
set i = i + 1;
);
szOut
);;
// 1 if is an url, 0 if not
fun std_szisurl (url, lP)=
if lP == nil then
0
else
if !std_szIsPattern url "&~#_=+%/!:.[aZ][09]" then
0
else
if !strcmp hd lP substr url 0 strlen hd lP then
let strlen hd lP -> lenp in
let strfind "." url lenp -> posdot in
let strfind "/" url lenp -> posslash in
let strfind ":" url lenp -> posport in
if posdot == nil then
0
else if ((posslash != nil) && (posport != nil)) && ((posdot > posslash) || (posdot > posport)) then // !
0
else if (posslash != nil) && (posdot > posslash) then
0
else if (posport != nil) && (posdot > posport) then
0
else
// doit y avoir au moins un caractere, un . et un tld de 2 lettres minimum
if (posdot <= lenp) ||
((posslash != nil) && (posslash < lenp+4)) ||
((posport != nil) && (posport < lenp+4))
then
0
else
1
else
std_szisurl url tl lP;;
/*! \brief Check if a string is an url
*
* \ingroup std_string
* Prototype: fun [S] I
*
* \param S : the string to test
*
* \return I : 1 if ok else 0
* \remark Known protocols : http, https, file, ftp, ftps, sftp, scol.
**/
fun std_szIsUrl (url)=
let "https://"::"http://"::"file://"::"ftp://"::"sftp://"::"ftps://"::"scol://"::nil -> lProtocol in
std_szisurl url lProtocol;;
/*! \brief Perform a xor operation between a string and a key
*
* The string is splitted in word of key lenght. For each word, the xor
* operation is performed : the string becomes "ciphered".
* To "uncipher", call this same function with the same key to retrieve the
* initial string.
*
* This is very easy to use : any string and the same key to cipher / uncipher.
* However, it is easy to uncipher the ciphered string. This function should
* not be used in a critical secure environment.
*
* \ingroup std_string
* Prototype: fun [S S] S
*
* \param S : the string to cipher/uncipher
* \param S : the key
*
* \return S : the ciphered/unciphered string.
*
* \see std_sfXor in std/systemfiles.pkg to cipher/uncipher a file.
**/
fun std_szXor (szToDo, szKey)=
let strlen szToDo -> lenToDo in
let strlen szKey -> lenKey in
let [0 0] -> [i k] in
let szToDo -> szOut in
while (i < ((lenToDo-(mod lenToDo lenKey)) / lenKey)) do
let 0 -> j in
(
while (j < lenKey) do
(
set szOut = set_nth_char szOut k ((nth_char szToDo k) ^ (nth_char szKey j));
set j = j+1;
set k = k+1;
);
set i = i+1;
szOut
);;