/usr/share/tcltk/tcllib1.17/base32/base32hex.tcl is in tcllib 1.17-dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | # -*- tcl -*-
# This code is hereby put into the public domain.
# ### ### ### ######### ######### #########
## Overview
# Base32 encoding and decoding of small strings.
#
# Management code for switching between Tcl and C accelerated
# implementations.
#
# RCS: @(#) $Id: base32hex.tcl,v 1.3 2008/03/22 23:46:42 andreas_kupries Exp $
# @mdgen EXCLUDE: base32hex_c.tcl
package require Tcl 8.4
namespace eval ::base32::hex {}
# ### ### ### ######### ######### #########
## Management of base32 std implementations.
# ::base32::hex::LoadAccelerator --
#
# Loads a named implementation, if possible.
#
# Arguments:
# key Name of the implementation to load.
#
# Results:
# A boolean flag. True if the implementation
# was successfully loaded; and False otherwise.
proc ::base32::hex::LoadAccelerator {key} {
variable accel
set isok 0
switch -exact -- $key {
critcl {
# Critcl implementation of base32 requires Tcl 8.4.
if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
if {[catch {package require tcllibc}]} {return 0}
set isok [llength [info commands ::base32::hex::critcl_encode]]
}
tcl {
variable selfdir
if {[catch {source [file join $selfdir base32hex_tcl.tcl]}]} {return 0}
set isok [llength [info commands ::base32::hex::tcl_encode]]
}
default {
return -code error "invalid accelerator $key:\
must be one of [join [KnownImplementations] {, }]"
}
}
set accel($key) $isok
return $isok
}
# ::base32::hex::SwitchTo --
#
# Activates a loaded named implementation.
#
# Arguments:
# key Name of the implementation to activate.
#
# Results:
# None.
proc ::base32::hex::SwitchTo {key} {
variable accel
variable loaded
if {[string equal $key $loaded]} {
# No change, nothing to do.
return
} elseif {![string equal $key ""]} {
# Validate the target implementation of the switch.
if {![info exists accel($key)]} {
return -code error "Unable to activate unknown implementation \"$key\""
} elseif {![info exists accel($key)] || !$accel($key)} {
return -code error "Unable to activate missing implementation \"$key\""
}
}
# Deactivate the previous implementation, if there was any.
if {![string equal $loaded ""]} {
foreach c {encode decode} {
rename ::base32::hex::$c ::base32::hex::${loaded}_$c
}
}
# Activate the new implementation, if there is any.
if {![string equal $key ""]} {
foreach c {encode decode} {
rename ::base32::hex::${key}_$c ::base32::hex::$c
}
}
# Remember the active implementation, for deactivation by future
# switches.
set loaded $key
return
}
# ::base32::hex::Implementations --
#
# Determines which implementations are
# present, i.e. loaded.
#
# Arguments:
# None.
#
# Results:
# A list of implementation keys.
proc ::base32::hex::Implementations {} {
variable accel
set res {}
foreach n [array names accel] {
if {!$accel($n)} continue
lappend res $n
}
return $res
}
# ::base32::hex::KnownImplementations --
#
# Determines which implementations are known
# as possible implementations.
#
# Arguments:
# None.
#
# Results:
# A list of implementation keys. In the order
# of preference, most prefered first.
proc ::base32::hex::KnownImplementations {} {
return {critcl tcl}
}
proc ::base32::hex::Names {} {
return {
critcl {tcllibc based}
tcl {pure Tcl}
}
}
# ### ### ### ######### ######### #########
## Initialization: Data structures.
namespace eval ::base32::hex {
variable selfdir [file dirname [info script]]
variable loaded {}
variable accel
array set accel {tcl 0 critcl 0}
}
# ### ### ### ######### ######### #########
## Initialization: Choose an implementation,
## most prefered first. Loads only one of the
## possible implementations. And activates it.
namespace eval ::base32::hex {
variable e
foreach e [KnownImplementations] {
if {[LoadAccelerator $e]} {
SwitchTo $e
break
}
}
unset e
namespace export encode decode
}
# ### ### ### ######### ######### #########
## Ready
package provide base32::hex 0.1
|