|
49
|
1 package DOM::Site;
|
|
|
2 use strict;
|
|
|
3 use Common;
|
|
|
4 our @ISA = qw(Object);
|
|
|
5
|
|
|
6 our $Name;
|
|
|
7 our @Providers;
|
|
|
8 our $AUTOLOAD;
|
|
|
9
|
|
|
10 BEGIN {
|
|
|
11 DeclareProperty(Objects => ACCESS_READ);
|
|
|
12 DeclareProperty(Providers => ACCESS_NONE);
|
|
|
13 }
|
|
|
14
|
|
|
15 sub RegisterObject {
|
|
|
16 my ($this,$name,$object) = @_;
|
|
|
17
|
|
|
18 $this->{$Objects}->{$name} = $object;
|
|
|
19 }
|
|
|
20
|
|
|
21 sub RegisterProvider {
|
|
|
22 my ($this,$provider) = @_;
|
|
|
23
|
|
|
24 my $refInfo = $provider->GetProviderInfo();
|
|
|
25
|
|
|
26 if ($refInfo->{'Host'} eq __PACKAGE__) {
|
|
|
27 die new Exception("Provider $refInfo->{'Name'} already registered") if exists $this->{$Providers}->{$refInfo->{'Name'}};
|
|
|
28 while (my ($name,$method) = each %{$refInfo->{'Methods'}}) {
|
|
|
29 no strict 'refs';
|
|
|
30 no warnings 'redefine';
|
|
|
31 *{__PACKAGE__ . '::' . $name} = sub {
|
|
|
32 shift;
|
|
|
33 $method->($provider,$this,@_);
|
|
|
34 };
|
|
|
35 }
|
|
|
36
|
|
|
37 while (my ($name,$object) = each %{$refInfo->{'Objects'}}) {
|
|
|
38 $this->{$Objects}->{$refInfo->{'Name'}}->{$name} = $object;
|
|
|
39 }
|
|
|
40
|
|
|
41 $this->{$Providers}->{$refInfo->{'Name'}} = 1;
|
|
|
42 }
|
|
|
43 }
|
|
|
44
|
|
|
45 sub construct {
|
|
|
46 my $self = shift;
|
|
|
47
|
|
|
48 my $site = $self->new();
|
|
|
49 $site->RegisterObject(Site => { Name => $Name});
|
|
|
50 foreach my $provider (@Providers) {
|
|
|
51 my $providerFile = $provider;
|
|
|
52 $providerFile =~ s/::/\//g;
|
|
|
53 $providerFile .= '.pm';
|
|
|
54 eval {
|
|
|
55 require $providerFile;
|
|
|
56 };
|
|
|
57 if ($@) {
|
|
|
58 my $InnerErr = $@;
|
|
|
59 die new Exception("Failed to load provider $provider", $InnerErr);
|
|
|
60 }
|
|
|
61 if ($provider->can('construct')) {
|
|
|
62 $site->RegisterProvider($provider->construct());
|
|
|
63 } else {
|
|
|
64 $site->RegisterProvider($provider);
|
|
|
65 }
|
|
|
66 }
|
|
|
67 return $site;
|
|
|
68 }
|
|
|
69
|
|
|
70 sub Dispose {
|
|
|
71 my ($this) = @_;
|
|
|
72
|
|
|
73 UNIVERSAL::can($_,'Dispose') and $_->Dispose foreach values %{$this->{$Objects} || {}};
|
|
|
74
|
|
|
75 undef %$this;
|
|
|
76
|
|
|
77 $this->SUPER::Dispose;
|
|
|
78 }
|
|
|
79
|
|
|
80 1;
|
