view Lib/IMPL/Config.pm @ 8:fffb153be599

DOM Schema
author Sergey
date Tue, 25 Aug 2009 17:36:37 +0400
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