1# $MirOS: src/gnu/usr.bin/perl/perltoc2.gen,v 1.3 2012/06/29 21:20:01 tg Exp $ 2#- 3# Copyright © 2011, 2012 4# Thorsten Glaser <tg@mirbsd.org> 5# 6# Provided that these terms and disclaimer and all copyright notices 7# are retained or reproduced in an accompanying document, permission 8# is granted to deal in this work without restriction, including un‐ 9# limited rights to use, publicly perform, distribute, sell, modify, 10# merge, give away, or sublicence. 11# 12# This work is provided “AS IS” and WITHOUT WARRANTY of any kind, to 13# the utmost extent permitted by applicable law, neither express nor 14# implied; without malicious intent or gross negligence. In no event 15# may a licensor, author or contributor be held liable for indirect, 16# direct, other damage, loss, or other issues arising in any way out 17# of dealing in the work, even if advised of the possibility of such 18# damage or existence of a defect, except proven that it results out 19# of said person’s immediate fault when using the work as intended. 20#- 21# Associative, multi-dimensional arrays in Pure mksh™ (no exec!) 22#- 23# An item in an assockit array has the following properties: 24# – the base-identifier of the shell array it’s in 25# – the index into the shell array it’s in 26# – an entry called flags 27# • data type: ASSO_{VAL,STR,INT,REAL,BOOL,NULL,AIDX,AASS} 28# – an entry called key 29# – an entry called value, unless NULL/AIDX/AASS 30# Shell array paths are constructed like this: 31# { 'foo': [ { 'baz': 123 } ] } named 'test' becomes: 32# ‣ root-level lookup 33# – Asso__f[16#AE0C1A48] = ASSO_AASS | ASSO_ISSET|ASSO_ALLOC 34# – Asso__k[16#AE0C1A48] = 'test' (hash: AE0C1A48) 35# ‣ Asso_AE0C1A48 = top-level 36# – Asso_AE0C1A48_f[16#BF959A6E] = ASSO_AIDX | ASSO_ISSET|ASSO_ALLOC 37# – Asso_AE0C1A48_k[16#BF959A6E] = 'foo' (hash: BF959A6E) 38# ‣ Asso_AE0C1A48BF959A6E = next-level 39# – Asso_AE0C1A48BF959A6E_f[0] = ASSO_AASS | ASSO_ISSET|ASSO_ALLOC 40# – Asso_AE0C1A48BF959A6E_k[0] = 0 41# ‣ Asso_AE0C1A48BF959A6E00000000 = last-level (below FOO) 42# – FOO_f[16#57F1BA9A] = ASSO_INT | ASSO_ISSET|ASSO_ALLOC 43# – FOO_k[16#57F1BA9A] = 'baz' (hash: 57F1BA9A) 44# – FOO_v[16#57F1BA9A] = 123 45# When assigning a value, by default, the type of the 46# intermediates is set to ASSO_AASS unless it already 47# is ASSO_AIDX; the type of the terminals is ASSO_VAL 48# unless it’s ASSO_{STR,INT,REAL,BOOL,NULL} before. 49 50# check prerequisites 51asso_x=${KSH_VERSION#????MIRBSD KSH R} 52asso_x=${asso_x%% *} 53if [[ $asso_x != +([0-9]) ]] || (( asso_x < 40 )); then 54 print -u2 'assockit.ksh: need at least mksh R40' 55 exit 1 56fi 57 58# set up variables 59typeset -Uui16 -Z11 asso_h=0 asso_f=0 asso_k=0 60typeset asso_b="" 61set -A asso_y 62set -A Asso__f 63set -A Asso__k 64 65# define constants 66typeset -Uui16 -Z11 -r ASSO_VAL=2#000 # type: any Korn Shell scalar 67typeset -Uui16 -Z11 -r ASSO_STR=2#001 # type: string 68typeset -Uui16 -Z11 -r ASSO_INT=2#010 # type: integral 69typeset -Uui16 -Z11 -r ASSO_REAL=2#011 # type: JSON float (string) 70typeset -Uui16 -Z11 -r ASSO_BOOL=2#100 # type: JSON "true" / "false" 71typeset -Uui16 -Z11 -r ASSO_NULL=2#101 # type: JSON "null" 72typeset -Uui16 -Z11 -r ASSO_AIDX=2#110 # type: indexed array 73typeset -Uui16 -Z11 -r ASSO_AASS=2#111 # type: associative array 74typeset -Uui16 -Z11 -r ASSO_MASK_ARR=2#110 # bitmask for array type 75typeset -Uui16 -Z11 -r ASSO_MASK_TYPE=2#111 # bitmask for type 76typeset -Uui16 -Z11 -r ASSO_ISSET=16#40000000 # element is set 77typeset -Uui16 -Z11 -r ASSO_ALLOC=16#80000000 # ksh element is set 78 79# notes: 80# – the code assumes ASSO_VAL=0 < all scalar types with value \ 81# < ASSO_NULL < all array types 82 83# public functions 84 85# set a value 86# example: asso_setv 123 'test' 'foo' 0 'baz' 87function asso_setv { 88 if (( $# < 2 )); then 89 print -u2 'assockit.ksh: syntax: asso_setv value key [key ...]' 90 return 2 91 fi 92 local _v=$1 _f _i 93 shift 94 95 # look up the item, creating paths as needed 96 asso__lookup 1 "$@" 97 # if it’s an array, free that recursively 98 if (( (_f = asso_f) & ASSO_MASK_ARR )); then 99 asso__r_free 1 100 (( _f &= ~ASSO_MASK_TYPE )) 101 fi 102 # if it’s got a type, check for a match 103 if (( _i = (_f & ASSO_MASK_TYPE) )); then 104 asso__typeck $_i "$_v" || (( _f &= ~ASSO_MASK_TYPE )) 105 fi 106 # set the new flags and value 107 asso__r_setfv $_f "$_v" 108} 109 110# get the flags of an item, or return 1 if not set 111# result is in the global variable asso_f 112function asso_isset { 113 if (( $# < 1 )); then 114 print -u2 'assockit.ksh: syntax: asso_isset key [key ...]' 115 return 2 116 fi 117 118 asso__lookup 0 "$@" 119} 120 121# get the type of an item (return 1 if unset, 2 if error) 122# example: x=$(asso_gett 'test' 'foo' 0 'baz') => $((ASSO_VAL)) 123function asso_gett { 124 asso_isset "$@" || return 125 print -n -- $((asso_f & ASSO_MASK_TYPE)) 126} 127 128# get the value of an item (return 1 if unset, 2 if error) 129# example: x=$(asso_getv 'test' 'foo' 0 'baz') => 123 130function asso_getv { 131 asso_loadv "$@" || return 132 print -nr -- "$asso_x" 133} 134 135# get the value of an item, but result is in the global variable asso_x 136function asso_loadv { 137 if (( $# < 1 )); then 138 print -u2 'assockit.ksh: syntax: asso_loadv key [key ...]' 139 return 2 140 fi 141 142 asso__lookup 0 "$@" || return 1 143 if (( (asso_f & ASSO_MASK_TYPE) < ASSO_NULL )); then 144 nameref _Av=${asso_b}_v 145 asso_x=${_Av[asso_k]} 146 else 147 asso_x="" 148 fi 149} 150 151# get all set keys of an item of array type (return 1 if no array) 152# result is in the global variable asso_y 153function asso_loadk { 154 if (( $# < 1 )); then 155 print -u2 'assockit.ksh: syntax: asso_loadv key [key ...]' 156 return 2 157 fi 158 159 asso__lookup 0 "$@" || return 1 160 (( asso_f & ASSO_MASK_ARR )) || return 1 161 nameref _keys=${asso_b}${asso_k#16#}_k 162 set -A asso_y -- ${_keys[*]} 163} 164 165# set a string value 166# example: asso_sets 'abc' 'test' 'foo' 0 'baz' 167function asso_sets { 168 if (( $# < 2 )); then 169 print -u2 'assockit.ksh: syntax: asso_sets value key [key ...]' 170 return 2 171 fi 172 173 asso__settv $ASSO_STR "$@" 174} 175 176# set an integral value 177# example: asso_seti 123 'test' 'foo' 0 'baz' 178function asso_seti { 179 if (( $# < 2 )); then 180 print -u2 'assockit.ksh: syntax: asso_seti value key [key ...]' 181 return 2 182 fi 183 184 if ! asso__typeck $ASSO_INT "$1"; then 185 print -u2 "assockit.ksh: not an integer: '$1'" 186 return 1 187 fi 188 asso__settv $ASSO_INT "$@" 189} 190 191# set a floating point (real) value 192# example: asso_setr -123.45e+67 'test' 'foo' 0 'baz' 193function asso_setr { 194 if (( $# < 2 )); then 195 print -u2 'assockit.ksh: syntax: asso_setr value key [key ...]' 196 return 2 197 fi 198 199 if ! asso__typeck $ASSO_REAL "$1"; then 200 print -u2 "assockit.ksh: not a real: '$1'" 201 return 1 202 fi 203 asso__settv $ASSO_REAL "$@" 204} 205 206# set a boolean value 207# example: asso_setb t 'test' 'foo' 0 'baz' 208function asso_setb { 209 if (( $# < 2 )); then 210 print -u2 'assockit.ksh: syntax: asso_setb value key [key ...]' 211 return 2 212 fi 213 214 if ! asso__typeck $ASSO_BOOL "$1"; then 215 print -u2 "assockit.ksh: not a truth value: '$1'" 216 return 1 217 fi 218 asso__settv $ASSO_BOOL "$@" 219} 220 221# set value to null 222# example: asso_setnull 'test' 'foo' 0 'baz' 223function asso_setnull { 224 if (( $# < 1 )); then 225 print -u2 'assockit.ksh: syntax: asso_setnull key [key ...]' 226 return 2 227 fi 228 229 asso__settv $ASSO_NULL 0 "$@" 230} 231 232# set type and scalar value 233# example: asso_settv $ASSO_INT 123 'test' 'foo' 0 'baz' 234function asso_settv { 235 if (( $# < 3 )) || ! asso__intck "$1" || \ 236 (( $1 != ($1 & ASSO_MASK_TYPE) )); then 237 print -u2 'assockit.ksh: syntax: asso_settv type value key...' 238 return 2 239 fi 240 241 if ! asso__typeck $1 "$2"; then 242 print -u2 "assockit.ksh: wrong type scalar: '$2'" 243 return 1 244 fi 245 asso__settv "$@" 246} 247 248# unset value 249# example: asso_unset 'test' 'foo' 0 'baz' 250function asso_unset { 251 if (( $# < 1 )); then 252 print -u2 'assockit.ksh: syntax: asso_unset key [key ...]' 253 return 2 254 fi 255 256 # look up the item, not creating paths 257 if asso__lookup 0 "$@"; then 258 # free the item recursively 259 asso__r_free 0 260 fi 261 return 0 262} 263 264# make an entry into an indexed array 265# from scalar => data into [0] 266# from associative array => data lost 267function asso_setidx { 268 if (( $# < 1 )); then 269 print -u2 'assockit.ksh: syntax: asso_setidx key [key ...]' 270 return 2 271 fi 272 273 local _f _v 274 275 asso__lookup 1 "$@" 276 if (( !((_f = asso_f) & ASSO_MASK_ARR) )); then 277 nameref _Av=${asso_b}_v 278 _v=${_Av[asso_k]} 279 elif (( (_f & ASSO_MASK_TYPE) == ASSO_AIDX )); then 280 return 0 281 fi 282 asso__r_free 1 283 asso__r_setf $ASSO_AIDX 284 if (( !(_f & ASSO_MASK_ARR) )); then 285 asso__lookup 1 "$@" 0 286 asso__r_setfv $_f "$_v" 287 fi 288} 289 290# make an entry into an associative array 291# from scalar => data lost 292# from indexed array => data converted 293function asso_setasso { 294 if (( $# < 1 )); then 295 print -u2 'assockit.ksh: syntax: asso_setasso key [key ...]' 296 return 2 297 fi 298 299 local _f 300 301 asso__lookup 1 "$@" 302 if (( !((_f = asso_f) & ASSO_MASK_ARR) )); then 303 asso__r_free 1 304 asso__r_setf $ASSO_AASS 305 elif (( (_f & ASSO_MASK_TYPE) == ASSO_AIDX )); then 306 asso__r_idx2ass 307 fi 308 return 0 309} 310 311# private functions 312 313# set type and scalar value, unchecked 314function asso__settv { 315 local _t=$1 _v=$2 _f 316 shift; shift 317 318 # look up the item, creating paths as needed 319 asso__lookup 1 "$@" 320 # if it’s an array, free that recursively 321 if (( (_f = asso_f) & ASSO_MASK_ARR )); then 322 asso__r_free 1 323 fi 324 (( _f = (_f & ~ASSO_MASK_TYPE) | _t )) 325 # set the new flags and value 326 asso__r_setfv $_f "$_v" 327} 328 329# check if this is a numeric (integral) value (0=ok 1=error) 330function asso__intck { 331 local _v=$1 332 333 [[ $_v = ?(+([0-9])'#')+([0-9a-zA-Z]) ]] || return 2 334 { : $((_v)) ; } 2>&- 335} 336 337# map a boolean value (0=false 1=true 2=error) 338function asso__boolmap { 339 local _v=$1 340 341 if asso__intck "$_v"; then 342 (( _v == 0 )) 343 return 344 fi 345 case $_v { 346 ([Tt]?([Rr][Uu][Ee])|[Yy]?([Ee][Ss])|[Oo][NnKk]) 347 return 1 ;; 348 ([Ff]?([Aa][Ll][Ss][Ee])|[Nn]?([Oo])|[Oo][Ff][Ff]) 349 return 0 ;; 350 } 351 return 2 352} 353 354# check if the type matches the value (0=ok 1=error) 355function asso__typeck { 356 if (( $# != 2 )); then 357 print -u2 'assockit.ksh: syntax: asso__typeck type value' 358 return 2 359 fi 360 local _t=$1 _v=$2 361 (( _t == ASSO_VAL || _t == ASSO_STR || _t == ASSO_NULL )) && return 0 362 if (( _t == ASSO_INT )); then 363 asso__intck "$_v" 364 return 365 fi 366 if (( _t == ASSO_BOOL )); then 367 asso__boolmap "$_v" 368 (( $? < 2 )) 369 return 370 fi 371 (( _t & ASSO_MASK_ARR )) && return 1 372 # ASSO_REAL 373 [[ $_v = ?(-)@(0|[1-9]*([0-9]))?(.+([0-9]))?([Ee]?([+-])+([0-9])) ]] 374} 375 376# look up an item ($1=1: create paths as necessary) 377function asso__lookup { 378 local _c=$1 _k _n _r 379 shift 380 381 _n=Asso_ 382 _r=0 383 asso_f=$ASSO_AASS 384 for _k in "$@"; do 385 if (( _r || !(asso_f & ASSO_MASK_ARR) )); then 386 (( _r )) || asso__r_free 1 387 asso__r_setf $ASSO_AASS 388 elif (( (asso_f & ASSO_MASK_TYPE) == ASSO_AIDX )); then 389 asso__intck "$_k" || asso__r_idx2ass 390 fi 391 asso_b=$_n 392 asso__lookup_once "$_k" 393 if (( _r = $? )); then 394 # not found. not create? 395 (( _c )) || return 1 396 asso__r_setk "$_k" 397 fi 398 _n=$_n${asso_k#16#} 399 done 400 return 0 401} 402 403# set flags for asso_b[asso_k] and update asso_f 404function asso__r_setf { 405 nameref _Af=${asso_b}_f 406 407 asso_f=$(($1 | ASSO_ISSET | ASSO_ALLOC)) 408 _Af[asso_k]=$asso_f 409} 410 411# set flags and value for asso_b[asso_k] and update asso_f 412function asso__r_setfv { 413 nameref _Af=${asso_b}_f 414 nameref _Av=${asso_b}_v 415 416 _Av[asso_k]=$2 417 asso_f=$(($1 | ASSO_ISSET | ASSO_ALLOC)) 418 _Af[asso_k]=$asso_f 419} 420 421# set key for not yet existing asso_b[asso_k] and update asso_f 422function asso__r_setk { 423 nameref _Af=${asso_b}_f 424 nameref _Ak=${asso_b}_k 425 426 _Ak[asso_k]=$1 427 asso_f=$((ASSO_ALLOC)) 428 _Af[asso_k]=$asso_f 429} 430 431# in asso_b of type asso_f look up element $1 432# set its asso_f and asso_k or return 1 when not found 433function asso__lookup_once { 434 local _e=$1 _seth=0 435 nameref _Af=${asso_b}_f 436 nameref _Ak=${asso_b}_k 437 438 if (( (asso_f & ASSO_MASK_TYPE) == ASSO_AIDX )); then 439 asso_k=$((_e)) 440 else 441 asso_k=16#${_e@#} 442# asso_k=$(somehash "$_e") 443 while :; do 444 asso_f=${_Af[asso_k]} 445 (( asso_f & ASSO_ALLOC )) || break 446 if (( !(asso_f & ASSO_ISSET) )); then 447 if (( !_seth )); then 448 # save index 449 asso_h=$asso_k 450 _seth=1 451 fi 452 (( --asso_k )) 453 continue 454 fi 455 [[ ${_Ak[asso_k]} = "$_e" ]] && break 456 # iterate 457 (( --asso_k )) 458 done 459 fi 460 asso_f=${_Af[asso_k]} 461 # found? 462 (( asso_f & ASSO_ISSET )) && return 0 463 # not found. 464 if (( _seth )); then 465 # when allocating, use this one instead 466 asso_k=$asso_h 467 fi 468 return 1 469} 470 471# free the currently selected asso_b[asso_k] recursively 472function asso__r_free { 473 local _keepkey=$1 474 nameref _Af=${asso_b}_f 475 476 asso_f=${_Af[asso_k]} 477 (( asso_f & ASSO_ALLOC )) || return 478 if (( asso_f & ASSO_ISSET )); then 479 if (( asso_f & ASSO_MASK_ARR )); then 480 local _ob=$asso_b _ok=$asso_k 481 asso_b=$asso_b${asso_k#16#} 482 nameref _s=${asso_b}_f 483 for asso_k in ${!_s[*]}; do 484 asso__r_free 485 done 486 eval unset ${asso_b}_f ${asso_b}_k ${asso_b}_v 487 asso_b=$_ob asso_k=$_ok 488 fi 489 eval unset $asso_b'_v[asso_k]' 490 (( _keepkey )) || eval unset $asso_b'_k[asso_k]' 491 fi 492 asso_f=$((ASSO_ALLOC)) 493 _Af[asso_k]=$asso_f 494} 495 496# make indexed asso_b[asso_k] into associative array 497function asso__r_idx2ass { 498 print -u2 'assockit.ksh: warning: asso__r_idx2ass not implemented' 499 print -u2 'assockit.ksh: warning: data will be lost' 500 asso__r_free 501 asso__r_setf $ASSO_AASS 502} 503 504#- 505 506set -A manlinks 507for manfile in "$@"; do 508 manname=${manfile%.*} 509 mansect=${manfile##*.?(cat)} 510 x="${manname}(${mansect})" 511 asso_sets "$x" "f" "$manname" 512 manlinks+=("$x") 513done 514 515act_s=0 516function act { 517 [[ $line = =+([0-9a-zA-Z])@([ ])* ]] || return 518 set -A la -- $line 519 if (( act_s )); then 520 [[ ${la[0]} = =back ]] && act_s=0 521 return 522 fi 523 [[ ${la[0]} = =head2 && ${la[1]} = perlglossary ]] && act_s=1 524 [[ ${la[2]} = *(-) ]] || return 525 v=$(asso_getv "f" "${la[1]}") || return 526 line=${line#"${la[0]}"+([ ])"${la[1]}"} 527 line="${la[0]} B<L<$v>>$line" 528} 529 530while IFS= read -r line; do 531 act 532 print -r -- "$line" 533done 534 535print '=head1 SEE ALSO 536 537This is a list of all known Perl manpages in MirOS: 538 539=over 540' 541 542for n in "${manlinks[@]}"; do 543 print -r -- "$n" 544done | sort | while IFS= read -r line; do 545 print -r -- "=item * 546 547B<L<$line>> 548" 549done 550 551print "=back 552" 553