Mercurial > pub > Impl
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