… | |
… | |
627 | $registry = $CB_TYPE[$object_type] ||= []; |
627 | $registry = $CB_TYPE[$object_type] ||= []; |
628 | |
628 | |
629 | } elsif ($type eq "subtype") { |
629 | } elsif ($type eq "subtype") { |
630 | defined $object_type or Carp::croak "subtype specified without type"; |
630 | defined $object_type or Carp::croak "subtype specified without type"; |
631 | my $object_subtype = shift @arg; |
631 | my $object_subtype = shift @arg; |
632 | $registry = $CB_TYPE[$object_type + $object_subtype * NUM_SUBTYPES] ||= []; |
632 | $registry = $CB_TYPE[$object_type + $object_subtype * NUM_TYPES] ||= []; |
633 | |
633 | |
634 | } elsif ($type eq "package") { |
634 | } elsif ($type eq "package") { |
635 | my $pkg = shift @arg; |
635 | my $pkg = shift @arg; |
636 | |
636 | |
637 | while (my ($name, $id) = each %cb_id) { |
637 | while (my ($name, $id) = each %cb_id) { |
… | |
… | |
678 | if (ref $_[0]) { |
678 | if (ref $_[0]) { |
679 | _object_attach @_; |
679 | _object_attach @_; |
680 | } else { |
680 | } else { |
681 | _attach shift->_attach_registry, @_; |
681 | _attach shift->_attach_registry, @_; |
682 | } |
682 | } |
|
|
683 | _recalc_want; |
683 | }; |
684 | }; |
684 | |
685 | |
685 | # all those should be optimised |
686 | # all those should be optimised |
686 | sub cf::attachable::detach { |
687 | sub cf::attachable::detach { |
687 | my ($obj, $name) = @_; |
688 | my ($obj, $name) = @_; |
… | |
… | |
690 | delete $obj->{_attachment}{$name}; |
691 | delete $obj->{_attachment}{$name}; |
691 | reattach ($obj); |
692 | reattach ($obj); |
692 | } else { |
693 | } else { |
693 | Carp::croak "cannot, currently, detach class attachments"; |
694 | Carp::croak "cannot, currently, detach class attachments"; |
694 | } |
695 | } |
|
|
696 | _recalc_want; |
695 | }; |
697 | }; |
696 | |
698 | |
697 | sub cf::attachable::attached { |
699 | sub cf::attachable::attached { |
698 | my ($obj, $name) = @_; |
700 | my ($obj, $name) = @_; |
699 | |
701 | |