Thunk.pm 1.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455
  1. package Logos::Generator::Thunk;
  2. use strict;
  3. our $AUTOLOAD;
  4. my %subrefCache;
  5. sub AUTOLOAD {
  6. my $self = shift;
  7. my $method = $AUTOLOAD;
  8. return if $method eq "DESTROY";
  9. $method =~ s/.*:://;
  10. my $fullyQualified = $self->{PACKAGE}."::".$method;
  11. my $subref = $subrefCache{$fullyQualified};
  12. $subref = $self->can($method) if !$subref;
  13. unshift @_, $self->{OBJECT} if $self->{OBJECT};
  14. goto &$subref;
  15. }
  16. sub can {
  17. my $self = shift;
  18. my $method = shift;
  19. my $subref = $self->SUPER::can($method);
  20. return $subref if $subref;
  21. $method =~ s/.*:://;
  22. my $fullyQualified = $self->{PACKAGE}."::".$method;
  23. return $subrefCache{$fullyQualified} if $subrefCache{$fullyQualified};
  24. $subref = sub {unshift @_, $self->{PACKAGE}; goto &{$self->{PACKAGE}->can($method)}};
  25. $subrefCache{$fullyQualified} = $subref;
  26. return $subref;
  27. }
  28. sub DESTROY {
  29. my $self = shift;
  30. $self->SUPER::destroy();
  31. }
  32. sub for {
  33. my $proto = shift;
  34. my $class = ref($proto) || $proto;
  35. my $self = {};
  36. $self->{PACKAGE} = shift;
  37. $self->{OBJECT} = shift;
  38. bless($self, $class);
  39. return $self;
  40. }
  41. 1;