| … | |
… | |
| 454 | =cut |
454 | =cut |
| 455 | |
455 | |
| 456 | ############################################################################# |
456 | ############################################################################# |
| 457 | # object support |
457 | # object support |
| 458 | |
458 | |
|
|
459 | sub reattach { |
|
|
460 | # basically do the same as instantiate, without calling instantiate |
|
|
461 | my ($obj) = @_; |
|
|
462 | |
|
|
463 | my $registry = $obj->registry; |
|
|
464 | |
|
|
465 | @$registry = (); |
|
|
466 | |
|
|
467 | delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} }; |
|
|
468 | |
|
|
469 | for my $name (keys %{ $obj->{_attachment} || {} }) { |
|
|
470 | if (my $attach = $attachment{$name}) { |
|
|
471 | for (@$attach) { |
|
|
472 | my ($klass, @attach) = @$_; |
|
|
473 | _attach $registry, $klass, @attach; |
|
|
474 | } |
|
|
475 | } else { |
|
|
476 | warn "object uses attachment '$name' that is not available, postponing.\n"; |
|
|
477 | } |
|
|
478 | } |
|
|
479 | } |
|
|
480 | |
| 459 | cf::attachable->attach ( |
481 | cf::attachable->attach ( |
| 460 | prio => -1000000, |
482 | prio => -1000000, |
| 461 | on_instantiate => sub { |
483 | on_instantiate => sub { |
| 462 | my ($obj, $data) = @_; |
484 | my ($obj, $data) = @_; |
| 463 | |
485 | |
| … | |
… | |
| 467 | my ($name, $args) = @$_; |
489 | my ($name, $args) = @$_; |
| 468 | |
490 | |
| 469 | $obj->attach ($name, %{$args || {} }); |
491 | $obj->attach ($name, %{$args || {} }); |
| 470 | } |
492 | } |
| 471 | }, |
493 | }, |
| 472 | on_reattach => sub { |
494 | on_reattach => \&reattach, |
| 473 | # basically do the same as instantiate, without calling instantiate |
|
|
| 474 | my ($obj) = @_; |
|
|
| 475 | my $registry = $obj->registry; |
|
|
| 476 | |
|
|
| 477 | @$registry = (); |
|
|
| 478 | |
|
|
| 479 | delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} }; |
|
|
| 480 | |
|
|
| 481 | for my $name (keys %{ $obj->{_attachment} || {} }) { |
|
|
| 482 | if (my $attach = $attachment{$name}) { |
|
|
| 483 | for (@$attach) { |
|
|
| 484 | my ($klass, @attach) = @$_; |
|
|
| 485 | _attach $registry, $klass, @attach; |
|
|
| 486 | } |
|
|
| 487 | } else { |
|
|
| 488 | warn "object uses attachment '$name' that is not available, postponing.\n"; |
|
|
| 489 | } |
|
|
| 490 | } |
|
|
| 491 | }, |
|
|
| 492 | on_clone => sub { |
495 | on_clone => sub { |
| 493 | my ($src, $dst) = @_; |
496 | my ($src, $dst) = @_; |
| 494 | |
497 | |
| 495 | @{$dst->registry} = @{$src->registry}; |
498 | @{$dst->registry} = @{$src->registry}; |
| 496 | |
499 | |
