view Lib/DOM/Site.pm @ 7:94d47b388442

Улучшены тесты Исправлены ошибки Улучшена документация Работа над схемой DOM
author Sergey
date Mon, 24 Aug 2009 01:05:34 +0400
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

package DOM::Site;
use strict;
use Common;
our @ISA = qw(Object);

our $Name;
our @Providers;
our $AUTOLOAD;

BEGIN {
    DeclareProperty(Objects => ACCESS_READ);
    DeclareProperty(Providers => ACCESS_NONE);
}

sub RegisterObject {
    my ($this,$name,$object) = @_;
    
    $this->{$Objects}->{$name} = $object;
}

sub RegisterProvider {
    my ($this,$provider) = @_;
    
    my $refInfo = $provider->GetProviderInfo();
    
    if ($refInfo->{'Host'} eq __PACKAGE__) {
        die new Exception("Provider $refInfo->{'Name'} already registered") if exists $this->{$Providers}->{$refInfo->{'Name'}};
        while (my ($name,$method) = each %{$refInfo->{'Methods'}}) {
            no strict 'refs';
            no warnings 'redefine';
            *{__PACKAGE__ . '::' . $name} = sub {
                shift;
                $method->($provider,$this,@_);
            };
        }
        
        while (my ($name,$object) = each %{$refInfo->{'Objects'}}) {
            $this->{$Objects}->{$refInfo->{'Name'}}->{$name} = $object;
        }
        
        $this->{$Providers}->{$refInfo->{'Name'}} = 1;
    }
}

sub construct {
    my $self = shift;
    
    my $site = $self->new();
    $site->RegisterObject(Site => { Name => $Name});
    foreach my $provider (@Providers) {
        my $providerFile = $provider;
        $providerFile =~ s/::/\//g;
        $providerFile .= '.pm';
        eval {
            require $providerFile;
        };
        if ($@) {
            my $InnerErr = $@;
            die new Exception("Failed to load provider $provider", $InnerErr);
        }
        if ($provider->can('construct')) {
            $site->RegisterProvider($provider->construct());
        } else {
            $site->RegisterProvider($provider);
        }
    }
    return $site;
}

sub Dispose {
    my ($this) = @_;
    
    UNIVERSAL::can($_,'Dispose') and $_->Dispose foreach values %{$this->{$Objects} || {}};
    
    undef %$this;
    
    $this->SUPER::Dispose;
}

1;