forum.lissyara.su

Если у меня опускаются руки, это значит, я потянулся к кувалде
https://forum.lissyara.su/

[PERL] регулярки

https://forum.lissyara.su/viewtopic.php?f=17&t=23410

Страница 1 из 1

[PERL] регулярки

Добавлено: 2010-01-17 18:42:13
Alex Keda
есть конифг ISPManager
в нём секции типа таких:

Код: Выделить всё

Account "dspam" {
        Owner root
        Domain spamd.host-food.ru
        Ip 92.243.74.50
        Preset custom
        SSL off
        CGI on
        SSI off
        DiskLimit 0
        UserLimit 0
        CPULimit 0
        MemLimit 0
        ProcLimit 0
        FtpLimit 10000
        MailLimit 10000
        DomainLimit 10000
        WebDomainLimit 10000
        MailDomainLimit 10000
        DatabaseLimit 10000
        DatabaseUserLimit 10000
        BandwidthLimit 100000000
        BandwidthUsage 0
}
надо составить таблицу владельцев, типа

Код: Выделить всё

root dspam
пробел или чё для разделения - неважно.

========
собсно проблема - с какой стороны подойти...

Re: [PERL] регулярки

Добавлено: 2010-01-17 19:13:10
hizel

Код: Выделить всё

my %accounts;
my $current_account=0;
while(<FILE>){
  if(/Account \"(\w+)\"/)
    $current_account=$1;
  if(/Owner (\w+))
    $account{$1} = $current_account;
}
как то так

Re: [PERL] регулярки

Добавлено: 2010-01-17 21:48:21
Alex Keda
так и я могу
мне надо чтобы однозначно был овнер внутри секции аккаунта
у тебя просто ищщется аккаунт а следом овнер.
вариант прокатит, но это неправильное решение.

Re: [PERL] регулярки

Добавлено: 2010-01-17 22:18:26
hizel
ну добавь проверок, как ребенок прям :)

Код: Выделить всё

my %accounts;
my $current_account=0;
while(<FILE>){
  if(/Account \"(\w+)\"/)
    $current_account=$1;
  if(/Owner (\w+)/ and $current_account)
    $account{$1} = $current_account;
  if(/}/)
    $current_account=0;
}

Re: [PERL] регулярки

Добавлено: 2010-01-18 9:14:03
thefree
$current_account будет наследоваться и от остального ... Если не найдет нового

Re: [PERL] регулярки

Добавлено: 2010-01-18 9:24:37
hizel

Код: Выделить всё

my %accounts;
my $current_account=0;
while(<FILE>){
  if(/}/) $current_account=0;
  if(/Account \"(\w+)\"/) $current_account=$1;
  if(/Owner (\w+)/ and $current_account) $account{$1} = $current_account;
}

Re: [PERL] регулярки

Добавлено: 2010-01-18 9:31:21
thefree
Тут вопрос в другом зачем Лисяра придумывает велосипед?
_http://search.cpan.org/~pgriffin/API-ISPManager-0.07/
От туда можно вырвать себе кусочки

Код: Выделить всё

# list all users
# all params derived from get_auth_id
sub query_abstract {
    my %params = @_;

    my $params_raw  = $params{params};
    my $func_name   = $params{func};
    my $fake_answer = $params{fake_answer} || '';

    warn 'query_abstract ' . Dumper( \%params ) if $DEBUG;

    return '' unless $params_raw && $func_name; 

    my $allowed_fields = $params{allowed_fields} || [ 'host', 'path', 'allow_http' ];
    # TODO сделать сцепку массивов тут!!!!

    my $xml_parser_params = $params{parser_params};

    my $auth_id = $fake_answer  ? '112323' : get_auth_id( %$params_raw );
    warn "Auth_id: $auth_id\n" if $DEBUG;

    if ($auth_id or $func_name eq 'ftp') { # ftp hacked by authinfo
        my $params = filter_hash( $params_raw, $allowed_fields);
    
        my $query_string = mk_full_query_string( {
            ( $func_name eq 'ftp' ? ( ) : ( auth => $auth_id ) ), # for ftp auth not used, only authinfo
            func => $func_name,
            out  => 'xml',
            %$params,
        } );

        warn Dumper $query_string if $DEBUG;

        return process_query(
            query_string  => $query_string,
            parser_params => $xml_parser_params,
            fake_answer   => $fake_answer,
        );

        # 
        # TODO add this check here 
        #  if ( $server_answer && $server_answer->{elem} && ref $server_answer->{elem} eq 'HASH' ) {
        #        return { data =>  $server_answer->{elem} };
        #    }
        #

    } else {
        warn "auth_id not found or func type not ftp" if $DEBUG;
        return '';
    }
}
а вызывается он

Код: Выделить всё

sub edit {
    my $params = shift;
    
    my $result = API::ISPManager::query_abstract(
        params => $params,
        func   => 'user.edit',
        allowed_fields => [  qw( host path allow_http     sok elid name domain email preset ip passwd ftplimit disklimit ssl ssi phpmod safemode  maillimit domainlimit webdomainlimit maildomainlimit baselimit baseuserlimit bandwidthlimit phpfcgi) ],
    );

    return $result;
}

Re: [PERL] регулярки

Добавлено: 2010-01-18 9:56:06
hizel
сюрприз :-D

Re: [PERL] регулярки

Добавлено: 2010-01-18 12:43:41
Alex Keda
хе.
не знал.
пойду окучивать

Re: [PERL] регулярки

Добавлено: 2010-01-18 12:46:08
Alex Keda
э нет
он будет долбить ISPManager
это очень медленно и ресурсоёмко.
мне надо быстро и легко.
а так - тока парсить конфиг самостоятельно

Re: [PERL] регулярки

Добавлено: 2010-01-18 13:27:08
hizel
мудаки я щитаю, нет чтобы взять ini формат, стандартный
или тот же yaml на крайняк xml, libconfig, libconfuse :(

Re: [PERL] регулярки

Добавлено: 2010-01-18 14:42:36
thefree
в cpan был модуль который парсил такие конфиги, вопрос мля как же он назывался.

Re: [PERL] регулярки

Добавлено: 2010-01-18 21:19:47
thefree
Лисяра пока что у вас получилось ... интересно стало
и интересует в каком виде хотите получать результат?

Re: [PERL] регулярки

Добавлено: 2010-01-18 21:34:59
Alex Keda
да мне любой нужен.
хочу вынести это всё в отдельную функцию, ибо щас онов том виде как hizel нарисовал врезано прямо в скрипт. [это и была исходная первая реализация с полгода назад] щас понадобилось ещё в одном месте - опять врезать и дублировать код? нехочу. хочу функцию, шоп работала очень быстро =))
для этого парсим конфиг в начале инклюда, данные в виде ккакого-то массива передаём функции, вызываем функцию с искомой строкой = получаем результат... как-то так =)
=======
инклюд у меня общий на всё - воэтому можно будет юзать отовсюду.

зачем нужно быстро - помните скриптик для определения овнера домена? чтобы и туда тоже имплантировать. т.е. - одно решение на все скрипты.

Re: [PERL] регулярки

Добавлено: 2010-01-18 21:44:44
thefree
результат возвращать в массиве или хеше?
и еще там отступ большой это табуляция или пробелы?

Re: [PERL] регулярки

Добавлено: 2010-01-18 21:59:26
hizel
на дык делай нормальное тех задание поднимай репозиторий, давай доступ и мы тебе накатем , будешь как в масле катаца
заодно на пистоне и жабке припишем :]

Re: [PERL] регулярки

Добавлено: 2010-01-18 22:28:18
thefree
Похоже на то что предложил hizel
Есть

Код: Выделить всё

Account "dspam" {
        Owner root
        Domain spamd.host-food.ru
        Ip 92.243.74.50
        Preset custom
        SSL off
        CGI on
        SSI off
        DiskLimit 56
        UserLimit 78
        CPULimit 0
        MemLimit 0
        ProcLimit 0
        FtpLimit 10000
        MailLimit 10000
        DomainLimit 10000
        WebDomainLimit 10000
        MailDomainLimit 10000
        DatabaseLimit 10000
        DatabaseUserLimit 10000
        BandwidthLimit 100000000
        BandwidthUsage 0
}
Account "dspamsss" {
        Owner myxaxa
        Domain myxaxa.host-food.ru
        Ip 92.243.74.150
        Preset customs
        SSL off
        CGI on
        SSI off
        DiskLimit 3
        UserLimit 3
        CPULimit 0
        MemLimit 0
        ProcLimit 0
        FtpLimit 100005
        MailLimit 100006
        DomainLimit 100003
        WebDomainLimit 100008
        MailDomainLimit 100009
        DatabaseLimit 1000010
        DatabaseUserLimit 100001
        BandwidthLimit 1000000001
        BandwidthUsage 1
}
Применяем скрипт

Код: Выделить всё

#!/usr/bin/perl -w

use strict;
use Data::Dumper;

my %boo = &lissyara_conf_read('lissyara.txt');

print Dumper(%boo);


sub lissyara_conf_read() {
my ($f) = @_;
my (%c, $k);

open(F, "<".$f) or die "Can't read file ".$f;
while (my $line = <F>) {
	chomp($line);
	next if $line =~ m/^(#|\{)/;
	$k = $1 if $line =~ m/^Account\s\"(\w+)\"\s\{/;
	$line =~ s/^((\s+)|(\t+))//gs if ($line =~ m/^((\s+)|(\t+))/);
	if ($k) {
		my ($v, $l) = split(/\s/, $line);
		if (defined($l)) {
			$l =~ s/\"//g if ($v eq 'Account');
			$l =~ s/\n|\r//gs;
			$c{$k}{$v} = $l;
		}
	}
}
close(F);

return %c;

}
Получаме

Код: Выделить всё

$VAR1 = 'dspamsss';
$VAR2 = {
          'DiskLimit' => '3',
          'UserLimit' => '3',
          'MailDomainLimit' => '100009',
          'Account' => 'dspamsss',
          'CGI' => 'on',
          'BandwidthUsage' => '1',
          'BandwidthLimit' => '1000000001',
          'Preset' => 'customs',
          'MemLimit' => '0',
          'DatabaseUserLimit' => '100001',
          'SSL' => 'off',
          'SSI' => 'off',
          'ProcLimit' => '0',
          'FtpLimit' => '100005',
          'DatabaseLimit' => '1000010',
          'Domain' => 'myxaxa.host-food.ru',
          'Ip' => '92.243.74.150',
          'Owner' => 'myxaxa',
          'WebDomainLimit' => '100008',
          'CPULimit' => '0',
          'MailLimit' => '100006',
          'DomainLimit' => '100003'
        };
$VAR3 = 'dspam';
$VAR4 = {
          'DiskLimit' => '56',
          'UserLimit' => '78',
          'MailDomainLimit' => '10000',
          'Account' => 'dspam',
          'CGI' => 'on',
          'BandwidthUsage' => '0',
          'BandwidthLimit' => '100000000',
          'Preset' => 'custom',
          'MemLimit' => '0',
          'DatabaseUserLimit' => '10000',
          'SSL' => 'off',
          'SSI' => 'off',
          'ProcLimit' => '0',
          'FtpLimit' => '10000',
          'DatabaseLimit' => '10000',
          'Domain' => 'spamd.host-food.ru',
          'Ip' => '92.243.74.50',
          'Owner' => 'root',
          'WebDomainLimit' => '10000',
          'CPULimit' => '0',
          'MailLimit' => '10000',
          'DomainLimit' => '10000'
        };
Но можно это все парсить еще проще написать очень большое регулярное выражения ... и получать значение

Re: [PERL] регулярки

Добавлено: 2010-01-19 14:57:13
Alex Keda
чё-то сложное...
в итоге остался при своём варианте, с выносом парсинга в инклюд и занесением в хэш значений
время работы скрипта уменьшилось с 3-4 секунд до 0.7
Часовой пояс: UTC+03:00
Страница 1 из 1
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/