VPF::Чтение файлов конфигурации с блочной структурой

n4n0bit

Дата 11.11.2008, 15:03 (ссылка)

(голосов:1)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

Код


#!/usr/bin/perl
use strict;
use warnings;

use Data::Dumper;

my %conf;

my($a,$b,$c,$d);

while( <DATA> )
{
    chomp;

    s/\s+//g;
        
    if( /^(\w+){/ ) { $a = $1; }
    elsif( /^user:(.+)/ ) {$b = $1; }
    elsif( /^file_acl:(.+)/ ) {$c = $1; }
    elsif( /^resource_acl:(.+)/ ) { $d = $1; }
    elsif( /}/ )
    {
    $conf{$a} =
    {
        user => [ split(/,/,$b) ],
        file_acl => [ split(/,/,$c) ],
        resource_acl => [ split(/,/,$d) ]
    };
    }
}

print Dumper %conf;

###################################
# --- КОНФИГУРАЦИОННЫЕ ДАННЫЕ --- #
###################################

__DATA__
# --- Группа --- #
admin {
    user         : root,farella
    file_acl     : avi,mpg,mp3,swf,flv
    resource_acl : porno,music,video
}

Кто как читает конфиги блочного вида?

ps: хотелосьбы обайтись без CPAN.

Это сообщение отредактировал(а) n4n0bit - 11.11.2008, 15:06

ginnie

Дата 11.11.2008, 15:16 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

Цитата(n4n0bit @ 11.11.2008, 15:03

)

ps: хотелосьбы обайтись без CPAN.

Какой смысл изобретать велосипед?

http://search.cpan.org/~rizen/Config-JSON-.../Config/JSON.pm

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

n4n0bit

Дата 11.11.2008, 15:40 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

Смысл - обайти избытачность кода!

ginnie

Дата 11.11.2008, 15:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

n4n0bit, лучше это время потратить на чтение документации по поводу переменных $a и $b.

Код


my($a,$b,$c,$d);

--------------------

n4n0bit

Дата 11.11.2008, 15:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

а что в них не так?

ginnie

Дата 11.11.2008, 16:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

фрагмент из perlvar

Цитата

$a
$b

Special package variables when using sort(), see sort. Because of this specialness $a and $b don't need to be declared (using use vars, or our()) even when using the strict 'vars' pragma. Don't lexicalize them with my $a or my $b if you want to be able to use them in the sort() comparison block or function.

--------------------

n4n0bit

Дата 11.11.2008, 16:07 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

Я не использую sort в файле с этими переменными

tolkien

Дата 11.11.2008, 16:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: 4
Всего: 4

Я как и ты не люблю избыточность. Тоже столкнулся с этой проблемой. Написал модуль как раз для этого.
Он сохраняет и читает хэш из файла. Сохраняет хеш любой сложности со всеми значениями, ссылками, вложенными массивами и хэшами. И потом восстанавливает его в том же виде. Пока багов не наблюдал. Если интересно могу выложить. Написан на чистом перл без избыточности).

Это сообщение отредактировал(а) tolkien - 11.11.2008, 16:36

tolkien

Дата 12.11.2008, 13:50 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: 4
Всего: 4

В архиве модуль и пример использования.

Conf.zip

arto

Дата 12.11.2008, 23:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: 38
Всего: 40

test.conf:

test
{
        aa = bb
        cc = dd
}

результат:

Use of uninitialized value $1 in hash element at Conf.pm line 56, <F1> line 2.
id | name | age | phone
Use of uninitialized value in print at sample.pl line 28.
Use of uninitialized value in print at sample.pl line 28.
Use of uninitialized value in print at sample.pl line 29.
|   |  |
Use of uninitialized value in print at sample.pl line 28.
Use of uninitialized value in print at sample.pl line 28.
Use of uninitialized value in print at sample.pl line 29.
test |   |  |

tolkien

Дата 13.11.2008, 02:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

Репутация: 4
Всего: 4

[b]arto[\b]
Спс за проявленный интерес. Видимо мне надо немного больше рассказать тогда про синтаксис формата с которым работает Сonf.pm.
Вот если бы вы выполнили файл идущий с модулем в архиве (sample.pl). А потом открыли бы файл personal.dat. Вы бы увидели следующую структуру

Код


1 {
name {
last name=Ivanov
first name=Ivan
}
phone [
883383
901022
]
age=21
}
2 {
name {
last name=Ivanov
first name=Petr
}
phone [
877383
501042
]
age=25
}

Теперь по вашему конфигу

Код


test
{
        aa = bb
        cc = dd
}

Т.е вы хотели бы чтобы после загрузки данного конфига у вас в программе имелся бы хэш. Такого вида
%config ( test => {aa => 'bb', cc => 'dd'} );
Тогда конфиг должен быть таким

Код


test {
        aa=bb
        cc=dd
}

Код


use Conf;

my %conf = ();
Conf::load(FILE => './test.conf', CONFIG => \%conf) or die $!;

foreach my $key (keys %conf)
{
    print $key, ' aa = ', $conf{$key}->{aa}, ' cc = ', $conf{$key}->{cc},"\n";
}
ВЫВОД
test aa = bb cc = dd

Структура файла строгая.
-строки начинающиеся на # игнорируются
-игнорируются пробелы, табуляция в начале строки
-игнорируются пустые строки
-key=value после ключа (key) не должно быть пробелов, ни табуляции только делитель(=) после него значение(value)
Про вложенные структуры
key {
key=value
...
} - ссылка на хэш
key [
key=value
...
] - ccылка на массив
key / $value - ссылка на скаляр

Делитель можно менять. Функции save и load имеют параметр DIVIDER который по умолчанию равен =. Даже убрать.
Conf::load(FILE => './test.conf', CONFIG => \%conf, DIVIDER =>'') or die $!;

Добавлено через 3 минуты и 26 секунд
Еще добавлю. Лучше создавать конфиг из желаемой структуры хеша. Ведь в программе всеравно будете работать с хешом. Т.е сначала пишите в программе %сonfig (...) потом сохраняете его в файл через
Conf::save. Дальше можно не боясь его редактировать ).

n4n0bit

Дата 13.11.2008, 14:38 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

tolkien спс за внимание.

Вот конфиг который будет использовать редиректор для SQUID-a . С поддержкой инклуда групп компанентов (форматы файлов и тд) а так же с отрицанием элементов в группах (!mp3) для того что бы не править группы компонентов при индивидуальных правилах

Код



######################################################
# --- индивидуально ---
u:root {
    file     : &music,&video,!mp3,mp4,bmp
    content  : @porno
    resource : music,$sexcar
}

######################################################
# --- группы --- #
g:admin {
    user     : root,farella
    file     : pwl,com,&music
    content  : секс,жестокий_секс,скачать_порнуху
    resource : porno,auto,music
}

######################################################
# Группы для инклуда 

# --- группы файлов --- #
f:music: mp3,wav,wma,ogg,acl
f:video: avi,mpg,mov,vob,mkv

# --- группы фраз --- #
c:porno: скачать_порнуху, порнуху_на_халяву, жестокий_трах

# --- группы тематических ресурсов --- #
r:sexcar: porno,auto

А вот эксперементальный код без проверок синтаксиса который забивает данные в ХЕШ но можно при желании сразу и в MySQL.

Код


#!/usr/bin/perl
use strict;
use warnings;

use Data::Dumper;

my (%conf,%temp, $p1,$p2);

# заполнить хеш данными
open(FH,"<config") or die $!;
while(<FH>)
{
    chomp; s/\s+//g; s/#.*//;
    
    if( m/^[fcr]:/ )
    {
    my @el = split /:/;
    $temp{$el[0]}{$el[1]} = [ split /,/, $el[2] ];
    }
    
    if( m/^([ug]):(\w+){/ )
    {
    ($p1,$p2) = ($1,$2);
    }
    elsif( ! m/^\w{1}:/ && /(\w+):(\S+)/ )
    {
    $temp{$p1}{$p2}{$1} = [ split /,/, $2 ];
    }
    elsif( m/}/ )
    {
    #print "block close\n";
    }
}
close FH;

### перечитать блочные части

# категории
foreach my $ug ( grep { /[ug]/ } keys %temp )
{
    foreach my $usr ( keys %{$temp{$ug}} )
    {
    foreach my $cat ( keys %{$temp{$ug}{$usr}} )
    {
        foreach my $res ( @{$temp{$ug}{$usr}{$cat}} )
        {
        if( $res =~ /^\&(\w+)/ )
        {
            push @{$conf{$ug}{$usr}{$cat}}, @{$temp{f}{$1}};
        }
        elsif( $res =~ /^\@(\w+)/ )
        {
            push @{$conf{$ug}{$usr}{$cat}}, @{$temp{c}{$1}};
        }
        elsif( $res =~ /^\$(\w+)/ )
        {
            push @{$conf{$ug}{$usr}{$cat}}, @{$temp{r}{$1}};
        }
        elsif( $res =~ /^\!(\w+)/ )
        {
            @{$conf{$ug}{$usr}{$cat}} = grep { ! /$1/ } @{$conf{$ug}{$usr}{$cat}};
        }
        else
        {
            push @{$conf{$ug}{$usr}{$cat}}, $res;
        }
        }
    }
    }
}

print Dumper %conf;

Результат дампа:

Код


$ ./cfg.pl
$VAR1 = 'u';
$VAR2 = {
          'root' => {
                      'resource' => [
                                      'music',
                                      'porno',
                                      'auto'
                                    ],
                      'file' => [
                                  'wav',
                                  'wma',
                                  'ogg',
                                  'acl',
                                  'avi',
                                  'mpg',
                                  'mov',
                                  'vob',
                                  'mkv',
                                  'mp4',
                                  'bmp'
                                ],
                      'content' => [
                                     'скачать_порнуху',
                                     'порнуху_на_халяву',
                                     'жестокий_трах'
                                   ]
                    }
        };
$VAR3 = 'g';
$VAR4 = {
          'admin' => {
                       'resource' => [
                                       'porno',
                                       'auto',
                                       'music'
                                     ],
                       'user' => [
                                   'root',
                                   'farella'
                                 ],
                       'file' => [
                                   'pwl',
                                   'com',
                                   'mp3',
                                   'wav',
                                   'wma',
                                   'ogg',
                                   'acl'
                                 ],
                       'content' => [
                                      'секс',
                                      'жестокий_секс',
                                      'скачать_порнуху'
                                    ]
                     }
        };

Это сообщение отредактировал(а) n4n0bit - 13.11.2008, 14:41

n4n0bit

Дата 18.11.2008, 11:47 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 82
Регистрация: 19.6.2008

Репутация: нет
Всего: 1

Есть ли смысл в строках 103 105 107 109 ???

Код


package ReadConfig;

our $VERSION = 0.1;

use strict;
use warnings;

# Конструктор
sub new
{
    my $class = shift || __PACKAGE__;
    my $self;
    
    $self->{cfg} ||= 'default.cfg';

    bless $self;
    
    $self->_parsing;

    return $self;
}

# вывести данные по логину
sub get_userdata
{
    my( $self,$arg ) = @_;
    
    die 'usage: $cfg->get("login:[file|resource|content]");' unless defined $arg;
    
    my( $k,$v ) = split /:/, $arg;
    return @{$self->{GENERAL}{u}{$k}{$v}};
}

# вывести имена пользователей
sub get_users
{
    my $self = shift;
    
    return keys %{$self->{GENERAL}{u}};
}

# Прочесть файл конфигурации и поместить данные во временный хеш
sub _parsing
{
    my $self = shift;
    
    open( FH, '<', $$self{cfg} ) or die $!;
    while( <FH> )
    {
        chomp; s/\s+//g; s/#.*//;
        
        if( /^[fcr]:/ )
        {
            my @el = split /:/;
            
            $self->{TEMP}{$el[0]}{$el[1]} = [ split /\,/, $el[2] ];
        }
        
        if( /^([ug]):(\w+){/ )
        {
            $self->{p1} = $1;
            $self->{p2} = $2;
        }
        elsif( ! /^\w{1}:/ && /(\w+):(\S+)/ )
        {
            $self->{TEMP}{$$self{p1}}{$$self{p2}}{$1} = [ split /\,/, $2 ];
        }
    }
    close FH;
    
    # перечитать данные временнога хеша,
    # по необходимости сделать подстановку значиние констант &,@,$ или исключить при !элемент
    # и заполнить новыми данными оснавной хеш
    foreach my $ug( grep { /^[ug:]/ } keys %{$self->{TEMP}} )
    {
        foreach my $usr( keys %{$self->{TEMP}{$ug}} )
        {
            foreach my $cat( keys %{$self->{TEMP}{$ug}{$usr}} )
            {
                foreach my $res( @{$self->{TEMP}{$ug}{$usr}{$cat}} )
                {
                    if( $res =~ /^\&(\w+)/ )
                    {
                        push @{$self->{GENERAL}{$ug}{$usr}{$cat}}, @{$self->{TEMP}{f}{$1}};
                    }
                    elsif( $res =~ /^\@(\w+)/ )
                    {
                        push @{$self->{GENERAL}{$ug}{$usr}{$cat}}, @{$self->{TEMP}{c}{$1}};
                    }
                    elsif( $res =~ /^\$(\w+)/ )
                    {
                        push @{$self->{GENERAL}{$ug}{$usr}{$cat}}, @{$self->{TEMP}{r}{$1}};
                    }
                    elsif( $res =~ /^\!(\w+)/ )
                    {
                        @{$self->{GENERAL}{$ug}{$usr}{$cat}} = grep { ! /$1/ } @{$self->{GENERAL}{$ug}{$usr}{$cat}};
                    }
                    else
                    {
                        push @{$self->{GENERAL}{$ug}{$usr}{$cat}}, $res;
                    }
                }
                delete $self->{TEMP}{$ug}{$usr}{$cat};
            }
            delete $self->{TEMP}{$ug}{$usr};
        }
        delete $self->{TEMP}{$ug};
    }
    delete $self->{TEMP};
    
    # пользователей из групп поместить отдеьно в {GENERAL}{u}
    if( exists $self->{GENERAL}{g} )
    {
        foreach my $grp( keys %{$self->{GENERAL}{g}} )
        {
            foreach my $usr( @{$self->{GENERAL}{g}{$grp}{user}} )
            {
                $self->{GENERAL}{u}{$usr}{file}     = \@{$self->{GENERAL}{g}{$grp}{file}};
                $self->{GENERAL}{u}{$usr}{content}  = \@{$self->{GENERAL}{g}{$grp}{content}};
                $self->{GENERAL}{u}{$usr}{resource} = \@{$self->{GENERAL}{g}{$grp}{resource}};
            }
        }
    }
}

1;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »