| … | |
… | |
| 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 | |
