view Lib/IMPL/Config.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children a9b70d836b28
line wrap: on
line source

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

use base qw(IMPL::Object 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) = @_;

    foreach my $info ($this->get_meta('IMPL::Class::PropertyInfo')) {
        next if $info->Access != IMPL::Class::Member::MOD_PUBLIC; # save only public properties

        my $name = $info->Name;
        $ctx->AddVar($name => $this->$name()) if $this->$name();
    }
}

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;
}

sub CTOR {
    my $this = shift;
    $this->superCTOR(@_);

    $this->MyClass(new IMPL::Config::Class(Type => MyClass)) unless $this->MyClass;
}

=head1 DESCRIPTION

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

=head1 MEMBERS

=item static LoadXMLFile($fileName)
Создает из XML файла экземпляр приложения

=item SaveXMLFile($fileName)
Сохраняет приложение в файл

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

=cut