Subclass.pm 1.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. package Logos::Subclass;
  2. use Logos::Class;
  3. our @ISA = ('Logos::Class');
  4. sub new {
  5. my $proto = shift;
  6. my $class = ref($proto) || $proto;
  7. my $self = $class->SUPER::new();
  8. $self->{SUPERCLASS} = undef;
  9. $self->{PROTOCOLS} = {};
  10. $self->{IVARS} = [];
  11. $self->{OVERRIDDEN} = 1;
  12. bless($self, $class);
  13. return $self;
  14. }
  15. ##################### #
  16. # Setters and Getters #
  17. # #####################
  18. sub superclass {
  19. my $self = shift;
  20. if(@_) { $self->{SUPERCLASS} = shift; }
  21. return $self->{SUPERCLASS};
  22. }
  23. sub ivars {
  24. my $self = shift;
  25. return $self->{IVARS};
  26. }
  27. sub protocols {
  28. my $self = shift;
  29. return $self->{PROTOCOLS};
  30. }
  31. sub initRequired {
  32. my $self = shift;
  33. return 1; # Subclasses must always be initialized.
  34. }
  35. ##### #
  36. # END #
  37. # #####
  38. sub addProtocol {
  39. my $self = shift;
  40. my $protocol = shift;
  41. $self->{PROTOCOLS}{$protocol}++;
  42. }
  43. sub addIvar {
  44. my $self = shift;
  45. my $ivar = shift;
  46. $ivar->class($self);
  47. push(@{$self->{IVARS}}, $ivar);
  48. }
  49. sub getIvarNamed {
  50. my $self = shift;
  51. my $name = shift;
  52. foreach(@{$self->{IVARS}}) {
  53. return $_ if $_->name eq $name;
  54. }
  55. return undef;
  56. }
  57. 1;