view Lib/IMPL/Config.pm @ 63:76b878ad6596

Added serialization support for the IMPL::Object::List More intelligent Exception message Fixed encoding support in the actions Improoved tests Minor fixes
author wizard
date Mon, 15 Mar 2010 02:38:09 +0300
parents b0c068da93ac
children 2f31ecabe9ea
line wrap: on
line source

package IMPL::Config;
use strict;
use warnings;

use base qw(IMPL::Object::Accessor IMPL::Object::Serializable IMPL::Object::Autofill);

__PACKAGE__->PassThroughArgs;

use IMPL::Class::Member;
use IMPL::Class::PropertyInfo;
use IMPL::Exception;

use IMPL::Serialization;
use IMPL::Serialization::XmlFormatter;



sub LoadXMLFile {
    my ($self,$file) = @_;
    
    my $class = ref $self || $self;
    
    my $serializer = new IMPL::Serializer(
        Formatter => new IMPL::Serialization::XmlFormatter(
            IdentOutput => 1,
            SkipWhitespace => 1
        )
    );
    
    open my $hFile,'<',$file or die new IMPL::Exception("Failed to open file",$file,$!);
    
    my $obj;
    eval {
        $obj = $serializer->Deserialize($hFile);
    };
    
    if ($@) {
        my $e=$@;
        die new IMPL::Exception("Can't load the configuration file",$file,$e);
    }
    return $obj;
}

sub SaveXMLFile {
    my ($this,$file) = @_;
    
    my $serializer = new IMPL::Serializer(
        Formatter => new IMPL::Serialization::XmlFormatter(
            IdentOutput => 1,
            SkipWhitespace => 1
        )
    );
    
    open my $hFile,'>',$file or die new IMPL::Exception("Failed to open file",$file,$!);
    
    $serializer->Serialize($hFile, $this);
}

sub xml {
    my $this = shift;
    my $serializer = new IMPL::Serializer(
        Formatter => new IMPL::Serialization::XmlFormatter(
            IdentOutput => 1,
            SkipWhitespace => 1
        )
    );
    my $str = '';
    open my $hFile,'>',\$str or die new IMPL::Exception("Failed to open stream",$!);
    
    $serializer->Serialize($hFile, $this);
    
    undef $hFile;
    
    return $str;
}

sub save {
    my ($this,$ctx) = @_;
    
    my $val;

    $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta(
    	'IMPL::Class::PropertyInfo',
    	sub {
    		$_->Access == IMPL::Class::Member::MOD_PUBLIC and
    		$_->canGet;
    	},
    	1);    
}

sub spawn {
	goto &LoadXMLFile;
}

sub get {
	my $this = shift;
	
	if (@_ == 1) {
		my $obj = $this->SUPER::get(@_);
		return UNIVERSAL::isa($obj,'IMPL::Config::Activator') ? $obj->activate : $obj;
	} else {
		my @objs = $this->SUPER::get(@_);	
		return map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @objs ;	
	}
}

sub rawGet {
	my $this = shift;
	return $this->SUPER::get(@_);
}

sub Exists {
	$_[0]->SUPER::get($_[1]) ? 1 : 0;
}

1;
__END__

=pod

=h1 SYNOPSIS

package App::Config
use base qw(IMPL::Config)

use IMPL::Class::Property;
use IMPL::Config::Class;

BEGIN {
    public property SimpleString => prop_all;
    public property MyClass => prop_all;
    public property DataSource => prop_all; 
}

sub CTOR {
    my $this = shift;

    $this->MyClass(new IMPL::Config::Class(Type => 'MyClass'')) unless $this->MyClass;
    $this->DataSource(
    	new IMPL::Config::Activator(
    		type => 'MyDataSource',
    		args=>{
    			host => 'localhost',
    			user => 'dbuser'
    		}
    	)
    ) unless $this->Exists('DataSource');
}

# in some script

my $app = spawn App::Config('default.xml');

$app->Run();

=head1 DESCRIPTION

Позволяет сохранить/загрузить конфигурацию. Также все классы конфигурации
должны наследоваться от данного класса, и все Public свойства будут
автоматически сохраняться и восстанавливаться.

=head1 MEMBERS

=over

=item C<< IMPL::Config->LoadXMLFile($fileName) >>

Создает из XML файла экземпляр приложения

=item C<< $instance->SaveXMLFile($fileName) >>

Сохраняет приложение в файл

=item C<< xml >>

Сохраняет конфигурацию приложения в XML строку

=item C<< IMPL::Config->spawn($file) >>

Синоним для C<LoadXMLFile>

=back

=cut