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

И всё прочее, что касается HTML
Правила форума
Убедительная просьба юзать теги [code] при оформлении листингов.
Сообщения не оформленные должным образом имеют все шансы быть незамеченными.
Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-17 18:42:13

есть конифг 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 
пробел или чё для разделения - неважно.

========
собсно проблема - с какой стороны подойти...
Убей их всех! Бог потом рассортирует...

Хостинговая компания Host-Food.ru
Хостинг HostFood.ru
 

Услуги хостинговой компании Host-Food.ru

Хостинг HostFood.ru

Тарифы на хостинг в России, от 12 рублей: https://www.host-food.ru/tariffs/hosting/
Тарифы на виртуальные сервера (VPS/VDS/KVM) в РФ, от 189 руб.: https://www.host-food.ru/tariffs/virtualny-server-vps/
Выделенные сервера, Россия, Москва, от 2000 рублей (HP Proliant G5, Intel Xeon E5430 (2.66GHz, Quad-Core, 12Mb), 8Gb RAM, 2x300Gb SAS HDD, P400i, 512Mb, BBU):
https://www.host-food.ru/tariffs/vydelennyi-server-ds/
Недорогие домены в популярных зонах: https://www.host-food.ru/domains/

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-17 19:13:10

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

my %accounts;
my $current_account=0;
while(<FILE>){
  if(/Account \"(\w+)\"/)
    $current_account=$1;
  if(/Owner (\w+))
    $account{$1} = $current_account;
}
как то так
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-17 21:48:21

так и я могу
мне надо чтобы однозначно был овнер внутри секции аккаунта
у тебя просто ищщется аккаунт а следом овнер.
вариант прокатит, но это неправильное решение.
Убей их всех! Бог потом рассортирует...

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-17 22:18:26

ну добавь проверок, как ребенок прям :)

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

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;
}
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 9:14:03

$current_account будет наследоваться и от остального ... Если не найдет нового
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-18 9:24:37

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

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;
}
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 9:31:21

Тут вопрос в другом зачем Лисяра придумывает велосипед?
_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;
}
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-18 9:56:06

сюрприз :-D
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-18 12:43:41

хе.
не знал.
пойду окучивать
Убей их всех! Бог потом рассортирует...

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-18 12:46:08

э нет
он будет долбить ISPManager
это очень медленно и ресурсоёмко.
мне надо быстро и легко.
а так - тока парсить конфиг самостоятельно
Убей их всех! Бог потом рассортирует...

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-18 13:27:08

мудаки я щитаю, нет чтобы взять ini формат, стандартный
или тот же yaml на крайняк xml, libconfig, libconfuse :(
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 14:42:36

в cpan был модуль который парсил такие конфиги, вопрос мля как же он назывался.
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 21:19:47

Лисяра пока что у вас получилось ... интересно стало
и интересует в каком виде хотите получать результат?
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-18 21:34:59

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

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

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 21:44:44

результат возвращать в массиве или хеше?
и еще там отступ большой это табуляция или пробелы?
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
hizel
дядя поня
Сообщения: 9032
Зарегистрирован: 2007-06-29 10:05:02
Откуда: Выборг

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

Непрочитанное сообщение hizel » 2010-01-18 21:59:26

на дык делай нормальное тех задание поднимай репозиторий, давай доступ и мы тебе накатем , будешь как в масле катаца
заодно на пистоне и жабке припишем :]
В дурацкие игры он не играет. Он просто жуткий, чу-чу, паровозик, и зовут его Блейн. Блейн --- это Боль.

Аватара пользователя
thefree
лейтенант
Сообщения: 980
Зарегистрирован: 2008-12-29 9:23:19
Откуда: Весёлая Страна

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

Непрочитанное сообщение thefree » 2010-01-18 22:28:18

Похоже на то что предложил 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'
        };
Но можно это все парсить еще проще написать очень большое регулярное выражения ... и получать значение
Не судите меня строго, Я не волшебник, а только учусь!
http://planetbsd.ru - RSS-агрегатор *BSD по Рунету

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

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

Непрочитанное сообщение Alex Keda » 2010-01-19 14:57:13

чё-то сложное...
в итоге остался при своём варианте, с выносом парсинга в инклюд и занесением в хэш значений
время работы скрипта уменьшилось с 3-4 секунд до 0.7
Убей их всех! Бог потом рассортирует...