1. my class X::Encoding::Unknown { ... }
  2. my class X::Encoding::AlreadyRegistered { ... }
  3. my class Encoding::Registry {
  4. my $lock := Lock.new;
  5. my %lookup; # access for registering builtins at compile time
  6. my $lookup := nqp::getattr(%lookup,Map,'$!storage'); # access for runtime
  7. BEGIN {
  8. my $lookup := nqp::bindattr(%lookup,Map,'$!storage',nqp::hash);
  9. my $encodings := nqp::list(
  10. nqp::list("ascii"),
  11. nqp::list("iso-8859-1","iso_8859-1:1987","iso_8859-1","iso-ir-100",
  12. "latin1","latin-1","csisolatin1","l1","ibm819","cp819"),
  13. nqp::list("utf8","utf-8"),
  14. nqp::list("utf8-c8","utf-8-c8"),
  15. nqp::list("utf16","utf-16"),
  16. nqp::list("utf32","utf-32"),
  17. nqp::list("windows-1252"),
  18. nqp::list("windows-1251")
  19. );
  20. my int $i = -1;
  21. my int $elems = nqp::elems($encodings);
  22. while nqp::islt_i(($i = nqp::add_i($i,1)),$elems) {
  23. my $names := nqp::atpos($encodings,$i);
  24. my $builtin := nqp::create(Encoding::Builtin).SET-SELF(
  25. nqp::shift($names),nqp::clone($names));
  26. nqp::bindkey($lookup,$builtin.name,$builtin);
  27. while nqp::elems($names) {
  28. nqp::bindkey($lookup,nqp::shift($names),$builtin);
  29. }
  30. }
  31. }
  32. method register(Encoding $enc --> Nil) {
  33. $lock.protect: {
  34. nqp::stmts(
  35. nqp::if(
  36. nqp::existskey($lookup,(my str $key = $enc.name.fc)),
  37. X::Encoding::AlreadyRegistered.new(name => $enc.name).throw,
  38. nqp::bindkey($lookup,$key,$enc)
  39. ),
  40. (my $names :=
  41. nqp::getattr($enc.alternative-names,List,'$!reified')),
  42. (my int $elems = nqp::elems($names)),
  43. (my int $i = -1),
  44. nqp::while(
  45. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  46. nqp::if(
  47. nqp::existskey($lookup,($key = nqp::atpos($names,$i).fc)),
  48. X::Encoding::AlreadyRegistered.new(
  49. name => nqp::atpos($names,$i)).throw,
  50. nqp::bindkey($lookup,$key,$enc)
  51. )
  52. )
  53. )
  54. }
  55. }
  56. method find(Str() $name) {
  57. $lock.protect: {
  58. nqp::ifnull(
  59. nqp::atkey($lookup,$name.fc),
  60. X::Encoding::Unknown.new(:$name).throw
  61. )
  62. }
  63. }
  64. }