You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

931 lines
26 KiB

#Do not update version of this file. Update sqids-buildversion.txt and run make.tcl to update the version in this file and copy to modules folder.
package require Tcl 8.6-
#MIT license
#Julian Noble 2026
#example:
# % package require sqids
# % set s1 [sqids::idscope new]
# ::oo::Obj275
# % $s1 encode {1 2 3}
# 86Rf07
# % $s1 decode 86Rf07
# 1 2 3
namespace eval sqids {
oo::class create idscope {
variable o_alphabet
variable o_alphabet_configured
variable o_alpha_re
variable o_minlength
variable o_blocklist
variable o_maxsafeinteger
#note that methods beginning with uppercase letters are private.
constructor {args} {
set defaults [dict create {*}{
-alphabet ""
-minlength ""
-blocklist ""
-maxsafeinteger ""
}]
if {[llength $args] %2 !=0} {
error "sqids::idscope constructor: Require option value pairs. Known options:[dict keys $defaults]."
}
set useropts [dict create]
set explicit_empty_blocklist 0 ;#as opposed to default due to being unspecified.
dict for {k v} $args {
set fullmatch [tcl::prefix::match -error "" {-alphabet -minlength -blocklist -maxsafeinteger} $k]
switch -exact -- $fullmatch {
-alphabet - -minlength - -maxsafeinteger {
dict set useropts $fullmatch $v
}
-blocklist {
if {[llength $v] == 0} {
set explicit_empty_blocklist 1
}
dict set useropts -blocklist $v
}
default {
error "sqids::idscope constructor: unknown option '$k'. Known options:[dict keys $defaults]."
}
}
}
set opts [dict merge $defaults $useropts]
set opt_alphabet [dict get $opts -alphabet]
if {$opt_alphabet eq ""} {
set o_alphabet $::sqids::data::default_alphabet
} else {
if {[string length $opt_alphabet] < 3} {
error "sqids::idscope constructor: -alphabet length must be at least 3."
}
#review - deny multibyte
if {[regexp {[^\u00-\u7F]} $opt_alphabet]} {
error "sqids::idscope constructor: -alphabet must not contain multibyte characters."
}
if {[regexp {(.).*\1} $opt_alphabet]} {
error "sqids::idscope constructor: -alphabet must contain unique characters."
}
set o_alphabet $opt_alphabet
}
set o_alphabet_configured $o_alphabet ;#for use in public method alphabet, which returns the configured alphabet in the order it was configured, not the shuffled order used for encoding.
set alphamatch [string map [list . \\. \[ \\\[ \] \\\] \{ \\\{ \} \\\}] $o_alphabet] ;#review
set o_alpha_re "^\[$alphamatch\]+\$" ;#independent of shuffled order.
set o_alphabet [my shuffle $o_alphabet[set o_alphabet {}]]
set opt_minlength [dict get $opts -minlength]
if {$opt_minlength eq ""} {
set o_minlength $::sqids::data::default_minlength
} else {
set maxval 255
if {![string is integer -strict $opt_minlength] || $opt_minlength < 0 || $opt_minlength > $maxval} {
error "sqids constructor: -minlength must be an integer from 0 to $maxval inclusive."
}
set o_minlength $opt_minlength
}
set opt_blocklist [dict get $opts -blocklist]
if {!$explicit_empty_blocklist && $opt_blocklist eq ""} {
set o_blocklist $::sqids::data::default_blocklist
#default blocklist is already in lowercase.
} else {
set o_blocklist $opt_blocklist
set o_blocklist [string tolower $o_blocklist]
}
#Considered pruning blocklist entries that are 3 chars or less,
#or that contain characters not in the alphabet, as they will never match any id and just add overhead
#to the is_blocked method.
#This however adds some object instantiation overhead.
#counterpoint - caller should provide an appropriate blocklist for the supplied alphabet.
set opt_maxsafeinteger [dict get $opts -maxsafeinteger]
if {$opt_maxsafeinteger eq ""} {
set o_maxsafeinteger $::sqids::data::MAX_SAFE_INTEGER
} else {
#accept arbitrarily large values as long as they're valid bignum integers.
if {[package vsatisfies [info tclversion] 8.7-]} {
if {![string is integer -strict $opt_maxsafeinteger] || $opt_maxsafeinteger < 0} {
error "sqids constructor: -maxsafeinteger must be a non-negative integer."
}
} else {
if {![string is entier -strict $opt_maxsafeinteger] || $opt_maxsafeinteger < 0} {
error "sqids constructor: -maxsafeinteger must be a non-negative integer."
}
}
set o_maxsafeinteger $opt_maxsafeinteger
}
}
method config {{option {}}} {
#introspection method.
#return a dict of the configured options if no option specified, otherwise return the value of the specified option.
#no facility is provided to change options after construction as a new idscope object should be used for different configurations (different scope of sqid ids).
#note that -alphabet refers to the configured alphabet in the order it was configured, not the shuffled order used for encoding.
if {$option eq ""} {
#
return [dict create {*}{
} -blocklist $o_blocklist {*}{
} -maxsafeinteger $o_maxsafeinteger {*}{
} -minlength $o_minlength {*}{
} -alphabet $o_alphabet_configured {*}{
}
]
}
set fullmatch [tcl::prefix::match -error "" {-alphabet -minlength -blocklist -maxsafeinteger} $option]
switch -exact -- $fullmatch {
-alphabet {return $o_alphabet_configured}
-minlength {return $o_minlength}
-blocklist {return $o_blocklist}
-maxsafeinteger {return $o_maxsafeinteger}
default {
error "sqids::idscope config: unknown option '$option'. Known options:-alphabet -minlength -blocklist -maxsafeinteger."
}
}
}
#review tcl8.7 behaves like tcl 9
#tcl 8.7 wasn't ever officially released (and won't be) - but it was available for a while and may exist in the wild.
if {[package vsatisfies [info tclversion] 8.7-]} {
#'string is integer' for tcl versions 8.7 and above supports bignums, which can be arbitrarily large.
method encode {numlist} {
if {[llength $numlist] == 0} {return}
#cannot encode negative numbers, or non-integers.
foreach num $numlist {
if {![string is integer -strict $num] || $num < 0 || $num > $o_maxsafeinteger} {
error "sqids encode: can only encode integers from 0 to $o_maxsafeinteger. Invalid value: '$num'"
}
}
return [my EncodeNumbers $numlist]
}
} else {
#In tcl 8.6, 'string is integer' is limited to 2**32-1, use the now deprecated 'string is entier'.
#Otherwise - integer operations still support bignums.
#(versions below 8.6 not supported by this modules)
method encode {numlist} {
if {[llength $numlist] == 0} {return}
#cannot encode negative numbers, or non-integers.
foreach num $numlist {
if {![string is entier -strict $num] || $num < 0 || $num > $o_maxsafeinteger} {
error "sqids encode: can only encode integers from 0 to $o_maxsafeinteger. Invalid value: '$num'"
}
}
return [my EncodeNumbers $numlist]
}
}
method EncodeNumbers {numlist {increment 0}} {
#assert number of letters in o_alphabet and number of letters in local alpha are the same and don't effectively change during this function.
#('set alpha {}' in calls to my shuffle is an optimization to avoid shared string and copy-on-write overhead. As alpha is set to the result, it doesn't violate the previous assertion.)
set alpha_len [string length $o_alphabet]
if {$increment > $alpha_len} {
error "sqids EncodeNumbers: Reached max attempts to re-generate the ID"
}
set offset [llength $numlist]
set i -1
foreach v $numlist {
incr i
set x [scan [string index $o_alphabet [expr {$v % $alpha_len}]] %c]
set offset [expr {$offset + $x + $i}]
}
set offset [expr {$offset % $alpha_len}]
set offset [expr {($offset + $increment) % $alpha_len}]
set alpha [string range $o_alphabet $offset end][string range $o_alphabet 0 $offset-1]
set prefix [string index $alpha 0]
set alpha [string reverse $alpha]
set id $prefix
set i -1
foreach num $numlist {
incr i
append id [my ToId $num [string range $alpha 1 end]]
if {$i < [llength $numlist]-1} {
append id [string index $alpha 0]
set alpha [my shuffle $alpha[set alpha {}]]
}
}
if {$o_minlength > [string length $id]} {
append id [string index $alpha 0]
while {$o_minlength - [string length $id] > 0} {
set alpha [my shuffle $alpha[set alpha {}]]
set numchars [expr {min($o_minlength - [string length $id],$alpha_len)}]
append id [string range $alpha 0 $numchars-1]
}
}
if {[my is_blocked $id]} {
set id [my EncodeNumbers $numlist [expr {$increment+1}]]
}
return $id
}
method is_blocked {id} {
#deliberately public method.
if {![llength $o_blocklist]} {
return 0
}
#o_blocklist is stored in lowercase, so compare against lowercase id.
set idtest [string tolower $id]
set idlen [string length $idtest]
if {$idlen < 3} {
#sqids rule: short ids less than 3 chars will not be blocked.
#(this is from the FAQ - but spec (code in isblocked) seems to contradict - saying <= 3 must match exactly)
#however - most implementations filter out blocklist entries shorter than 3 at construction time.
#- so effectively the FAQ seems right but the reference code implements it in a very roundabout and unintuitive way.
#REVIEW. Why are there no tests regarding such short ids?
return 0
}
if {$idlen == 3} {
if {$idtest in $o_blocklist} {
return 1
}
} else {
foreach blocked $o_blocklist {
if {[string length $blocked] <= 3} {
#sqids rule: blocklist entries of 3 chars will only be blocked if they match the entire id exactly,
#so skip them in this loop as we've already checked for exact matches of the whole id when idlen == 3.
#note blocklist entries of 0 1 or 2 chars will never match any id - but in this implementation we leave
#it to the caller to provide a sensible blocklist. Nevertheless if we encounter them we will just skip them here.
continue
}
set posn [string first $blocked $idtest]
if {$posn == -1} {
continue
}
if {$posn == 0} {
#whether leetspeak or not, blocklist entries that match at the beginning of the id will be blocked.
return 1
}
if {[regexp {[0-9]} $blocked]} {
#sqids rule: blocklist entries with digits (leetspeak) will only be blocked if the match is at the beginning or end of the id.
#we've already checked the beginning, so check the end now.
set endpos [expr {$idlen - [string length $blocked]}]
if {$posn == $endpos} {
return 1
}
} else {
#sqids rule: blocklist entries without digits will be blocked if they match anywhere in the id.
return 1
}
}
}
return 0
}
method ToId {num alpha} {
set id ""
set alpha_len [string length $alpha]
while 1 {
set id [string index $alpha [expr {$num % $alpha_len}]]$id
set num [expr {$num / $alpha_len}]
if {$num == 0} break
}
return $id
}
method ToNumber {id alpha} {
set number 0
set alpha_len [string length $alpha]
for {set i 0} {$i < [string length $id]} {incr i} {
set posn [string first [string index $id $i] $alpha]
set number [expr {($number * $alpha_len) + $posn}]
}
return $number
}
method shuffle {alpha} {
#public method. Primarily for internal use but can be used externally to examine the shuffled alphabet being used for encoding.
#e.g myscopeobject shuffle [myscopeobject config -alphabet] would show the shuffled alphabet being used for encoding.
#consistent shuffle (always produce the same result for same input)
set alpha_len [string length $alpha]
if {$alpha_len < 2} {
return $alpha
}
set chars [split $alpha ""]
for {set i 0; set j [expr {$alpha_len-1}]} {$j > 0} {incr i; incr j -1} {
set iv [scan [lindex $chars $i] %c]
set jv [scan [lindex $chars $j] %c]
set r [expr {($i * $j + $iv + $jv) % $alpha_len}]
set item2 [lindex $chars $r]
lset chars $r [lindex $chars $i]
lset chars $i $item2
}
return [join $chars ""]
}
method decode {id} {
if {$id eq ""} {return}
set result [list]
if {![regexp $o_alpha_re $id]} {
puts stderr "sqids decode: ID contains characters not in the alphabet. re: $o_alpha_re id: $id"
return [list]
}
set prefix [string index $id 0]
set offset [string first $prefix $o_alphabet]
set alpha [string range $o_alphabet $offset end][string range $o_alphabet 0 $offset-1]
set alpha [string reverse $alpha]
set id [string range $id 1 end]
while {[string length $id] > 0} {
set separator [string index $alpha 0]
#split on first occurrence of separator only.
set sep_posn [string first $separator $id]
if {$sep_posn == -1} {
set parts [list $id]
} else {
set parts [list [string range $id 0 $sep_posn-1] [string range $id $sep_posn+1 end]]
}
#assert parts has 1 or 2 elements
if {[lindex $parts 0] eq ""} {
#separator was at start of the id - done.
return $result
}
lappend result [my ToNumber [lindex $parts 0] [string range $alpha 1 end]]
if {[llength $parts] == 2} {
set alpha [my shuffle $alpha[set alpha {}]]
set id [lindex $parts 1]
} else {
set id ""
}
}
return $result
}
}
}
namespace eval sqids::data {
variable default_alphabet {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789}
variable default_minlength 0
#arbitrary 1 googol limit (approx 2**332). We could go much higher e.g [string repeat 9 1000]
#Tcl bignums are limited by available memory and max string length (e.g approx 2**30 bytes?)
#- but speed of encoding and decoding will degrade as the number increases.
#Can be overridden by providing a -maxsafeinteger option to the idscope constructor.
variable MAX_SAFE_INTEGER [expr {"1[string repeat 0 100]"}]
variable default_blocklist {
0rgasm
1d10t
1d1ot
1di0t
1diot
1eccacu10
1eccacu1o
1eccacul0
1eccaculo
1mbec11e
1mbec1le
1mbeci1e
1mbecile
a11upat0
a11upato
a1lupat0
a1lupato
aand
ah01e
ah0le
aho1e
ahole
al1upat0
al1upato
allupat0
allupato
ana1
ana1e
anal
anale
anus
arrapat0
arrapato
arsch
arse
ass
b00b
b00be
b01ata
b0ceta
b0iata
b0ob
b0obe
b0sta
b1tch
b1te
b1tte
ba1atkar
balatkar
bastard0
bastardo
batt0na
battona
bitch
bite
bitte
bo0b
bo0be
bo1ata
boceta
boiata
boob
boobe
bosta
bran1age
bran1er
bran1ette
bran1eur
bran1euse
branlage
branler
branlette
branleur
branleuse
c0ck
c0g110ne
c0g11one
c0g1i0ne
c0g1ione
c0gl10ne
c0gl1one
c0gli0ne
c0glione
c0na
c0nnard
c0nnasse
c0nne
c0u111es
c0u11les
c0u1l1es
c0u1lles
c0ui11es
c0ui1les
c0uil1es
c0uilles
c11t
c11t0
c11to
c1it
c1it0
c1ito
cabr0n
cabra0
cabrao
cabron
caca
cacca
cacete
cagante
cagar
cagare
cagna
cara1h0
cara1ho
caracu10
caracu1o
caracul0
caraculo
caralh0
caralho
cazz0
cazz1mma
cazzata
cazzimma
cazzo
ch00t1a
ch00t1ya
ch00tia
ch00tiya
ch0d
ch0ot1a
ch0ot1ya
ch0otia
ch0otiya
ch1asse
ch1avata
ch1er
ch1ng0
ch1ngadaz0s
ch1ngadazos
ch1ngader1ta
ch1ngaderita
ch1ngar
ch1ngo
ch1ngues
ch1nk
chatte
chiasse
chiavata
chier
ching0
chingadaz0s
chingadazos
chingader1ta
chingaderita
chingar
chingo
chingues
chink
cho0t1a
cho0t1ya
cho0tia
cho0tiya
chod
choot1a
choot1ya
chootia
chootiya
cl1t
cl1t0
cl1to
clit
clit0
clito
cock
cog110ne
cog11one
cog1i0ne
cog1ione
cogl10ne
cogl1one
cogli0ne
coglione
cona
connard
connasse
conne
cou111es
cou11les
cou1l1es
cou1lles
coui11es
coui1les
couil1es
couilles
cracker
crap
cu10
cu1att0ne
cu1attone
cu1er0
cu1ero
cu1o
cul0
culatt0ne
culattone
culer0
culero
culo
cum
cunt
d11d0
d11do
d1ck
d1ld0
d1ldo
damn
de1ch
deich
depp
di1d0
di1do
dick
dild0
dildo
dyke
encu1e
encule
enema
enf01re
enf0ire
enfo1re
enfoire
estup1d0
estup1do
estupid0
estupido
etr0n
etron
f0da
f0der
f0ttere
f0tters1
f0ttersi
f0tze
f0utre
f1ca
f1cker
f1ga
fag
fica
ficker
figa
foda
foder
fottere
fotters1
fottersi
fotze
foutre
fr0c10
fr0c1o
fr0ci0
fr0cio
fr0sc10
fr0sc1o
fr0sci0
fr0scio
froc10
froc1o
froci0
frocio
frosc10
frosc1o
frosci0
froscio
fuck
g00
g0o
g0u1ne
g0uine
gandu
go0
goo
gou1ne
gouine
gr0gnasse
grognasse
haram1
harami
haramzade
hund1n
hundin
id10t
id1ot
idi0t
idiot
imbec11e
imbec1le
imbeci1e
imbecile
j1zz
jerk
jizz
k1ke
kam1ne
kamine
kike
leccacu10
leccacu1o
leccacul0
leccaculo
m1erda
m1gn0tta
m1gnotta
m1nch1a
m1nchia
m1st
mam0n
mamahuev0
mamahuevo
mamon
masturbat10n
masturbat1on
masturbate
masturbati0n
masturbation
merd0s0
merd0so
merda
merde
merdos0
merdoso
mierda
mign0tta
mignotta
minch1a
minchia
mist
musch1
muschi
n1gger
neger
negr0
negre
negro
nerch1a
nerchia
nigger
orgasm
p00p
p011a
p01la
p0l1a
p0lla
p0mp1n0
p0mp1no
p0mpin0
p0mpino
p0op
p0rca
p0rn
p0rra
p0uff1asse
p0uffiasse
p1p1
p1pi
p1r1a
p1rla
p1sc10
p1sc1o
p1sci0
p1scio
p1sser
pa11e
pa1le
pal1e
palle
pane1e1r0
pane1e1ro
pane1eir0
pane1eiro
panele1r0
panele1ro
paneleir0
paneleiro
patakha
pec0r1na
pec0rina
pecor1na
pecorina
pen1s
pendej0
pendejo
penis
pip1
pipi
pir1a
pirla
pisc10
pisc1o
pisci0
piscio
pisser
po0p
po11a
po1la
pol1a
polla
pomp1n0
pomp1no
pompin0
pompino
poop
porca
porn
porra
pouff1asse
pouffiasse
pr1ck
prick
pussy
put1za
puta
puta1n
putain
pute
putiza
puttana
queca
r0mp1ba11e
r0mp1ba1le
r0mp1bal1e
r0mp1balle
r0mpiba11e
r0mpiba1le
r0mpibal1e
r0mpiballe
rand1
randi
rape
recch10ne
recch1one
recchi0ne
recchione
retard
romp1ba11e
romp1ba1le
romp1bal1e
romp1balle
rompiba11e
rompiba1le
rompibal1e
rompiballe
ruff1an0
ruff1ano
ruffian0
ruffiano
s1ut
sa10pe
sa1aud
sa1ope
sacanagem
sal0pe
salaud
salope
saugnapf
sb0rr0ne
sb0rra
sb0rrone
sbattere
sbatters1
sbattersi
sborr0ne
sborra
sborrone
sc0pare
sc0pata
sch1ampe
sche1se
sche1sse
scheise
scheisse
schlampe
schwachs1nn1g
schwachs1nnig
schwachsinn1g
schwachsinnig
schwanz
scopare
scopata
sexy
sh1t
shit
slut
sp0mp1nare
sp0mpinare
spomp1nare
spompinare
str0nz0
str0nza
str0nzo
stronz0
stronza
stronzo
stup1d
stupid
succh1am1
succh1ami
succhiam1
succhiami
sucker
t0pa
tapette
test1c1e
test1cle
testic1e
testicle
tette
topa
tr01a
tr0ia
tr0mbare
tr1ng1er
tr1ngler
tring1er
tringler
tro1a
troia
trombare
turd
twat
vaffancu10
vaffancu1o
vaffancul0
vaffanculo
vag1na
vagina
verdammt
verga
w1chsen
wank
wichsen
x0ch0ta
x0chota
xana
xoch0ta
xochota
z0cc01a
z0cc0la
z0cco1a
z0ccola
z1z1
z1zi
ziz1
zizi
zocc01a
zocc0la
zocco1a
zoccola
}
}
package provide sqids [namespace eval sqids {
variable version
set version 0.3.1
}]