Advertisement
Guest User

Untitled

a guest
Sep 9th, 2015
181
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.73 KB | None | 0 0
  1. #!perl6
  2.  
  3. class Person { ... }
  4. class Thing { ... }
  5. class Container { ... }
  6. class Place { ... }
  7. class Nowhere { ... }
  8.  
  9. class Entity {
  10. use JSON::Tiny;
  11. my %cache;
  12.  
  13. has $.id is rw;
  14.  
  15. multi method Str (Entity:D: ) { self.id }
  16.  
  17. method load(Entity: $id) {
  18. return Nowhere if $id eq 'nowhere';
  19. return %cache{$id} if %cache{$id}:exists;
  20.  
  21. my %hash = from-json slurp "$id.json";
  22. my $class = %hash<class>:delete;
  23.  
  24. if (%hash<location>:exists) {
  25. %hash<location> = Entity.load(%hash<location>);
  26. }
  27. %hash<id> = $id;
  28.  
  29. $class ~~ /^ [ Person | Place | Container | Thing ] $/
  30. or die "Invalid class '$class' for $id";
  31.  
  32. return %cache{$id} = ::($class).new(|%hash);
  33. }
  34.  
  35. method json {
  36. my %hash;
  37. for self.^attributes -> $a {
  38. my $value = $a.get_value(self);
  39. if (defined $value) {
  40. %hash{ $a.Str.substr(2) } = $a.get_value(self).Str
  41. }
  42. };
  43. %hash<class> = self.^name;
  44. return to-json %hash;
  45. }
  46.  
  47. method would-recurse (Mu $to-be-contained) {
  48. say self;
  49. say $to-be-contained;
  50. die;
  51. return 0;
  52. }
  53. }
  54.  
  55. class Place is Entity {
  56. has Place $.location is rw;
  57. }
  58.  
  59. class Person is Entity {
  60. has Place $.location is rw = Nowhere;
  61. }
  62.  
  63. class Container is Entity {
  64. has Entity $.location is rw where Place|Container = Nowhere;
  65. }
  66.  
  67. class Thing is Entity {
  68. has Entity $.location is rw where Place|Container|Person = Nowhere;
  69. }
  70.  
  71. class Nowhere is Place {
  72. method Str { "nowhere" }
  73. }
  74.  
  75.  
  76. my $t = Entity.load("foo");
  77. say $t.perl;
  78. say $t.json;
  79. say $t.location.perl;
  80. say $t.location.json;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement