… | |
… | |
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 | |
… | |
… | |
1223 | # reload cf.pm |
1226 | # reload cf.pm |
1224 | $msg->("reloading cf.pm"); |
1227 | $msg->("reloading cf.pm"); |
1225 | require cf; |
1228 | require cf; |
1226 | cf::_connect_to_perl; # nominally unnecessary, but cannot hurt |
1229 | cf::_connect_to_perl; # nominally unnecessary, but cannot hurt |
1227 | |
1230 | |
1228 | |
|
|
1229 | # load config and database again |
1231 | # load config and database again |
1230 | cf::cfg_load; |
1232 | cf::cfg_load; |
1231 | cf::db_load; |
1233 | cf::db_load; |
1232 | |
1234 | |
1233 | # load extensions |
1235 | # load extensions |