Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Общие вопросы > Генератор accessor'ов

Автор: KSURi 4.1.2008, 19:41

Хотелось бы узнать, есть ли готовые решения для сабжа? Я пробовал Class::Accessor, Class::Gomor, но не смог выжать из них то, что мне нужно. Ниже более подробное описание. Есть объект примерно такой структуры: Код ... $self = {     Hash => {         A => 1,         B => 2,         # etc.     },     Array => [qw(1 2 3)],     Scalar => 'bla' } ... Мне нужен модуль, который бы автоматически сгенерировал следующие методы get'a/set'a: Hash A B Array Scalar Т.е. мне нужен генератор для аттрибутов, у которых уровень вложенности больше 1. Надесь суть ясна.

Автор: sir_nuf_nuf 6.1.2008, 00:55

стандартные модули - маловероятно... странный случай просто =) не думаю, что кому то могло такое понадобится. если все таки надо, то можно делать так: тот самый модуль Class/Plainer.pm Код package Class::Plainer; use base qw(Exporter); use strict; our @EXPORT_OK = qw(AUTOLOAD); sub lookup {     my ($hr, $iden) = @_;     return \$hr->{$iden} if exists $hr->{$iden};     foreach (values %$hr) {         if (/HASH/) {             return lookup($_, $iden);         }     }     return; } sub AUTOLOAD {     no strict 'refs';     my $method = our $AUTOLOAD;     $method =~ s/.*:://;     if ($method =~ m/get_?(\w+)/) {         my $iden = $1;         *$method = sub {             my ($self) = @_;             return ${lookup($self, $iden)};         }     } elsif ($method =~ m/set_?(\w+)/) {         my $iden = $1;         *$method = sub {             my ($self, $val) = @_;             ${lookup($self, $iden)} = $val;         }     } else {         die "not a get/set $method";     }     goto &$method; } 1; примитивный тест test.pl Код package Test; use base qw(Class::Plainer); sub new {     my $self = {         Hash => {             A => 1,             B => 2,             # etc         },         Array => [qw(1 2 3)],         Scalar => 'bla'     };     bless $self, shift;     return $self; } package main; $instance = Test::->new(); print $instance->get_Array(), "\n"; print $instance->get_Scalar(), "\n"; print $instance->set_Scalar('alb'), "\n"; print $instance->get_Scalar(), "\n"; print $instance->get_Hash(), "\n"; print $instance->get_A(), "\n"; $instance->set_Hash({chunga => changa}); print $instance->get_chunga(), "\n"; P.S. замечу, что а) под вложенными стурктурами понимаются только хеши хешей, т.е. содержимое массивов не просматривается б) как только идентификатор найден - поиск останавливается.. отсюда вывод: по хорошему _все_ имена полей класса должны быть различными - иначе задаче криво сформулирована

Автор: nitr 6.1.2008, 01:07

sir_nuf_nuf, интересный подход, думаю это подталкнет на создание своего модуля, автора темы. Тоже считаю, что модуля нет ещё для таких структур, хотя может авторы существующих, могут и подсказать. Лично не использовал, пишу все методы "ручками", и мне так удобнее, да и вполне это просто. Но суть мне интересна. З.Ы.: пожалуйста отредактируйте сообщение, используя подсветку кода, примерно так Код #!/usr/bin/perl так приятнее читать его.

Автор: KSURi 6.1.2008, 01:30

Я прикидывал как это сделать самому (хотя ваш вариант кажется компактнее), просто думал может придется изобретать велосипед... В любом случае спасибо, на досуге разберу ваш код

Автор: ginnie 6.1.2008, 11:37

Уважаемый sir_nuf_nuf! А как тест сработает в случае Код     my $self = {         Hash => {             A => 1,             B => 2,             # etc         },         Array => [qw(1 2 3)],         Scalar => 'HASHING',     };

Автор: sir_nuf_nuf 6.1.2008, 12:24

плохо сработает =) меняем lookup Код sub lookup {     use attributes qw(reftype);     my ($hr, $iden) = @_;     return \$hr->{$iden} if exists $hr->{$iden};     foreach (values %$hr) {         if (ref($_) and reftype($_) =~ /HASH/) {             return lookup($_, $iden);         }     }     return; } Спасибо за замечания !!

Автор: ginnie 6.1.2008, 13:18

Уважаемый sir_nuf_nuf, регулярное выражение Код ref $_ =~ /HASH/  используется для ускорения работы?

Автор: KSURi 6.1.2008, 13:58

Зачем спорить по мелочам?) Выход тут очевиден я думаю, я вполне могу поправить те моменты, которые кажутся не совсем удачными.

Автор: nitr 7.1.2008, 00:48

Цитата(KSURi @  6.1.2008,  13:58 ) Зачем спорить по мелочам?) В этом может родиться истина ;) Я думаю дискуссию можно не прекращать  , интересная тема. А может быть, что-то очень даже перспективное, главное нужное другим людям ;) , может получится.

Автор: KSURi 7.1.2008, 01:42

Как я и говорил, на досуге взялся за код sir_nuf_nuf. Почитал, разобрал. Вот проблема уже появилась: после вызова lookup для например ключа B в хэшерефе А (если смотреть абсолютно, то В выглядит как $obj->{A}->{B}, соответственно вызываю я его $obj->set_B('bla')), это ключ почему-то просто пропадает из этого самого хэшрефа (писать даже как-то стыдно такое, но что поделать...). Понимаю, что скорее всего ничего не понятно из данного текста, поэтому лучше посмотреть 3 скриншота (обратите внимание на красные рамки в верхнем-правом углу): 1. Структура hashref'a до вызова сеттера. http://i5.tinypic.com/6wxfakw.png 2. Структура hashref'a во время работы сеттера (если быть точным, то уже после работы оператора присваивания, но до возвращения из самого метода) http://i17.tinypic.com/6y504sj.png 3. Структура hasref'a после возвращения из сеттера http://i1.tinypic.com/870n1j9.png P.S.: sir_nuf_nuf, заметил что изменили немного код саба lookup, использовав прагму attributes и вместо ref использовали reftype. Можно узнать, чем вызвано такое решение?

Автор: ginnie 7.1.2008, 02:46

Уважаемый KSURi, а нельзя модулем Data::Dumper вывести содержимое объекта после set__LoginTemplate(), чтобы исключить ошибки отладчика?

Автор: KSURi 7.1.2008, 12:51

Сказать, что я удивлен, значит не сказать ничего... Код $VAR1 = bless( {                  'ProtoData' => {                                   '_LoginData' => {                                                     '__LoginFailure' => undef,                                                     '__LoginSuccess' => '220', # заполнилось                                                     '__LoginTemplate' => 'USER {USER} PASS {PASS} ', # заполнилось                                                     '__LoginUser' => 'test', # заполнилось                                                     '__LoginPass' => 'test' # заполнилось                                                   },                                   '_ActionData' => {                                                      '__ActionExit' => undef, # не заполнилось                                                      '__ActionTemplate' => undef, # не заполнилось                                                      '__ActionCmd' => [] # не заполнилось                                                    }                                 }, ... Причем: Код print join("\n", $t->get___LoginTemplate,                            $t->get___LoginUser,                            $t->get___LoginPass,                            $t->get___LoginSuccess,                            $t->get___ActionCmd,                            $t->get___ActionTemplate,                            $t->get___ActionExit); exit; выдает Код QUIT QUIT QUIT QUIT QUIT QUIT QUIT

Автор: ginnie 7.1.2008, 15:37

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

Автор: KSURi 7.1.2008, 16:38

Цитата(ginnie @  7.1.2008,  15:37 ) Уважаемый KSURi, руками бы уже раз 100 все методы доступа написал? smile Дык написал уже давно, хотел вот объем кода сократить, а то получилось, что половина кода - однообразные сабы...

Автор: ginnie 7.1.2008, 17:30

Уважаемый sir_nuf_nuf, решил еще раз внимательно посмотреть предложенный Вами вариант   Возникло несколько моментов, требующих Ваших пояснений: первый раз сталкиваюсь с конструкцией Код my $method = our $AUTOLOAD; что она делает? нетривиальная конструкция  Код *$method = sub {             my ($self) = @_;             return ${lookup($self, $iden)};         } ... goto &$method; для чего? Разве без "выкрутасов" не будет работать? Код return ${lookup($self, $iden)};

Автор: KSURi 7.1.2008, 19:02

Ну вообще конструкция довольно распространенная... Для обработки ситуаций, когда в скрипте вызывается не объявленный саб, можно написать "перехватчик" в виде саба AUTOLOAD. В переменной $AUTOLOAD будет храниться имя саба спровоцировавшего ошибку. Думаю вот эта конструкция все объяснит: Код C:\>perl -e "nosuchsub();sub AUTOLOAD {};print $AUTOLOAD" main::nosuchsub C:\> our использован для избежания ошибки "Global symbol $AUTOLOAD requires explicit package name"

Автор: ginnie 7.1.2008, 19:37

Уважаемый KSURi, спасибо, что заставил прочитать документацию по функции AUTOLOAD (perldoc perltoot)!  Раньше даже не подозревал, что Код my $method = our $AUTOLOAD; будет работать. Никогда не возникало желание так написать. Судя по документации, $AUTOLOAD - глобальная для модуля переменная и должна описываться в начале модуля, а никак не внутри функции AUTOLOAD(). Разве при выполнении программы интерпретатор не выдает ошибок о повторном использовании our? P.S. Кроме документации на AUTOLOAD пришлось еще прочитать документацию по our. P.P.S. KSURi, если это распространенная конструкция, попробуй сказать, как она работает (именно эта строчка, а не функция AUTOLOAD) и чем ее работа будет отличаться от Код my $method = my $AUTOLOAD;

Автор: KSURi 7.1.2008, 20:02

Желания так написать у меня тоже не было... Но факт работоспособности - на лицо) Кстати, когда разбирал код sir_nuf_nuf, я изменил несколько строк в пользу своих привычек, в том числе момент с $AUTOLOAD.

Автор: sir_nuf_nuf 7.1.2008, 20:43

Цитата(ginnie @  7.1.2008,  17:30 ) для чего? Разве без "выкрутасов" не будет работать? 1) my $method = our $AUTOLOAD объявление лексической переменной =) этот прием называется - "замыкание"  (подробнее http://perldoc.perl.org/perlref.html#Function-Templates  или гугл по словам perl + closure или замыкание) P.S. our - не делает почти ничего, просто для того что бы use strict не давало ошибок. 2) *$method = sub {bla bla bla} запоминаем ссылку на созданную подпрограмму в таблице имен пакета по именем $method при следующем вызове этого же метода уже не будет AUTOLOAD, будет обычный вызов функции. своего рода кеширование. (подробнее http://perldoc.perl.org/perlmod.html#Symbol-Tables)

Автор: sir_nuf_nuf 7.1.2008, 21:12

Цитата(KSURi @  7.1.2008,  01:42 ) B в хэшерефе  да.. lookup переживает изменения, лучше постоянно смотерть последнюю версию причина переход ref -> reftype ref показывает имя класса  для bless - нутых сылок например Код package Boom; use attributes qw(reftype); $r = bless {}; print ref $r;  # will print "Boom" print reftype $r; #will print "HASH" и ( как показывают эксперименты =))  reftype не переваривает не-ссылки.

Автор: KSURi 7.1.2008, 22:14

Цитата(ginnie @  7.1.2008,  19:37 ) P.P.S. KSURi, если это распространенная конструкция, попробуй сказать, как она работает (именно эта строчка, а не функция AUTOLOAD) и чем ее работа будет отличаться от Код my $method = my $AUTOLOAD; Такая конструкция не будет работать. Переменная my $AUTOLOAD не будет иметь никакого отношения к AUTOLOAD, а будет простой переменной. На всякий случай, повторю, что Цитата(KSURi @  7.1.2008,  19:02 ) our использован для избежания ошибки "Global symbol $AUTOLOAD requires explicit package name" Добавлено через 4 минуты и 19 секунд Цитата(sir_nuf_nuf @  7.1.2008,  20:43 ) 2) *$method = sub {bla bla bla} запоминаем ссылку на созданную подпрограмму в таблице имен пакета по именем $method при следующем вызове этого же метода уже не будет AUTOLOAD, будет обычный вызов функции. своего рода кеширование. (подробнее http://perldoc.perl.org/perlmod.html#Symbol-Tables) А вот этого не знал, спасибо

Автор: ginnie 7.1.2008, 22:30

Уважаемый sir_nuf_nuf, спасибо за ссылки на документацию! Я ее люблю почитать, жалко в голове не все остается   Продолжим разбирательства: 1. Про объявление лексической переменной $method все верно. Вопрос в том, какое значение мы ей присваиваем? Если our не написать, интерпретатор сообщает, что $AUTOLOAD нигде не описана. Чтобы убрать ошибку, надо $AUTOLOAD описать. Здесь вариантов три: my, local и our. Пишем our, ошибка пропала, все работает. А теперь, внимание, вопрос: имя вызываемой функции в переменную $AUTOLOAD записывается до вызова функции AUTOLOAD, как это происходит, если описана переменная $AUTOLOAD внутри функции AUTOLOAD? Я не издеваюсь, сам тоже точно не знаю, хочу разобраться (есть мысль, что это дело рук оптимизатора). Все, что Вы написали про closure к первому пункту отношения не имеет, оно для второго пункта. 2. Здесь Вы все прояснили, спасибо, все уже подзабыл про таблицу символов модуля. Осталось только два замечания: в конце Код        *$method = sub {             my ($self) = @_;             return ${lookup($self, $iden)};         } лучше ставить ; и зачем Вы использовали goto(). Кстати про closure понятнее написано в http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q3.14.html. 3. С reftype() Вы зря переделали. Если в структуре хранится объект, то писать функции доступа к его параметрам это плохой стиль, т.к. объект сам должен их предоставлять.

Автор: sir_nuf_nuf 7.1.2008, 22:49

продолжим... 1) кхм.. мое видение дела: our не создает ни новую переменную ( как делает my) ни новое значение глобальной переменной ( как делает Local) our просто говорит компилятору, что $AUTOLOAD - есть глобальная переменная, если такая переменная уже есть - она и используется. our необходима только при использовании use strict - дабы заткнуть компилятор, ну или убедить его что мы знаем что делаем =) без use strict можно было бы писать my $meth = $AUTOLOAD; 2) goto &$method - это вызов только что созданного нами метода не забываем, что вызывает getter пользователь хотел получить значение переменной, а не просто создать getter    почему через goto ? да вот сложно сказать... говорят оптимизация =) (говорят тут: http://perldoc.perl.org/functions/goto.html) return $method->(@_);  тоже срабатывает 3) reftype vs ref... ну я ничего не навязываю   Добавлено через 1 минуту и 5 секунд Уважаемый KSURi,  я не заметил пропадения ключей из хешей.. все работает. может действительно проблемы дебагера ?

Автор: ginnie 7.1.2008, 23:25

Уважаемый sir_nuf_nuf, продолжаем   1.  Цитата our просто говорит компилятору, что $AUTOLOAD - есть глобальная переменная, если такая переменная уже есть - она и используется. а что Вы на это скажите? Код use strict; use warnings; $test = 12; our $test; print $test; Код Global symbol "$test" requires explicit package name at test.pl line 4. Execution of test.pl aborted due to compilation errors. 2.  Цитата говорят оптимизация Спасибо, узнал много нового про goto()  , только про оптимизацию, как я ее понимаю, там ни слова нет. Возник еще вопрос, косьвенно связанный с Вашим решением: Предположим мы описали класс Parent как в Вашем варианте. Создаем класс-наследник Child. В нем описываем параметр param_x, которого нет в родительском классе. Создаем объект $child_object класса Child и вызываем метод $child_object->get_param_x(). Вопрос: в таблице символов какого класса сохранится ссылка на функцию get_param_x()?

Автор: sir_nuf_nuf 8.1.2008, 00:44

1) я на это уже говорил несколько раз.  our как раз и сделана для того что бы избегать вот этого вот: Код Global symbol "$test" requires explicit package name at test.pl line 4. Execution of test.pl aborted due to compilation errors. читай сюда внимательно: http://perldoc.perl.org/functions/our.html our говорит компилятору, что глобальная переменная которую мы юзаем принадлежит текущему пакету. вообще поумолчанию так всегда и есть. но когда включаем strict - надо еще раз в это убедиться =) 2) интересно... вообще пока не могу ответить на этот вопрос  - исследую ... Добавлено через 13 минут и 36 секунд по поводу 2) ссылки на все геттеры сохраняются  в таблице имен  класса Class::Plainer. однако, в таблице имен всех его дочерних классов также появятся ссылки на соответсвующую подпрограмму, но это делаем уже не мы, а perl т.е. как только вы вызываете (в первый раз) метод который объект наследует от кого-то то в таблице имен класса вашего объекта появится новая запись =) при последующих вызовах perl уже не будет просматривать ISA иерархию.. P.S. запросто могу ошибаться. хм... а стоит ли здесь это обсуждать ?

Автор: nitr 8.1.2008, 04:04

KSURi, я так думаю можно в раздел "Исходники" бросить код, который мы будем "модифицировать" ;) все вместе. А для кого-то они будут очень даже ;)  P.S.: хоть какая-то база будет составляться...

Автор: KSURi 8.1.2008, 18:45

К сожалению не могу выложить пока исходники целиком. Чувствую, что сам обязан разобраться в ситуации. После исправления багов обещаю выложить)

Автор: tishaishii 11.1.2008, 18:45

Код package Hash; sub FIT {+$_[1]=ref $_[1] eq 'HASH' ? tie %{$_[1]}, __PACKAGE__, %{$_[1]} : $_[1]} sub WALK {     my($class, $hash)=(shift, shift);     $class->FIT($_) foreach values %$hash;     +$hash } sub TIEHASH {     my($class, $hash)=(shift, {@_});     +bless($hash, $class)->WALK($hash) } sub FIRSTKEY {reset %{$_[0]};+(each %{$_[0]})[0]} sub STORE {$_[0]->FIT($_[0]{$_[1]}=$_[2])} sub FETCH {+$_[0]{$_[1]} if $_[0]->EXISTS($_[1])} sub CLEAR {%{$_[0]}=()} sub EXISTS {+exists $_[0]{$_[1]}} sub DELETE {+delete $_[0]{$_[1]}} sub AUTOLOAD {+shift->FETCH(+(split '::', $AUTOLOAD)[-1])} sub DESTROY {} package main; my%hash=(     A=>{         B=>C     } ); print Hash->FIT(\%hash)->A->B;

Автор: sir_nuf_nuf 11.1.2008, 22:21

tishaishii, можно поинтересоваться, зачем вам  унарные плюсы нужны ? конкретнее зачем они нужны именно в этой ситуации ? coding style ?

Автор: shamber 12.1.2008, 16:11

sir_nuf_nuf, если вы посмотрите другие посты  tishaishii, то вы поймете. Ваша догадка про style верна

Автор: tishaishii 16.1.2008, 12:11

Кому что не нравится как работает, пишите. Если не нравятся плюсы - уберите их и пользуйтесь себе спокойно.

Автор: KSURi 23.1.2008, 22:06

Цитата(nitr @  6.1.2008,  01:07 ) sir_nuf_nuf, интересный подход, думаю это подталкнет на создание своего модуля, автора темы. Жаль писать, но пока не подтолкнул(( Рабочий скрипт нужен был, а времени мало было, чтобы придумывать и писать модуль. Однако как разберусь с сессией - возьмусь снова наверное) Собственно проблема была решена через редизайн объекта (убрал сложные структуры). P.S.: обсуждал тему на другом http://perlmonks.org/?node_id=661941, там люди тоже предложили несколько вариантов, и там же мне посоветовали изменить структуру объекта. Читайте, кому интересно.

Автор: gcc 17.7.2009, 20:13

KSURi, ради интереса: скажите что вы выбрали?  и в чем была пролема? почему нельзя написать классы set get и их использовать (и между ними наследовать и т.д.) или в структуры ссылки написать, потом передрать??

Автор: KSURi 18.7.2009, 01:00

Тогда поменял структуру объекта, убрав вложенные хэшрефы. Примерно пару месяцов назад я снова наткнулся на эту тему, так получился Class::Accessor::Deep (доступен на CPAN). Проблема описана в первом посте темы. Честно говоря, не очень понял, что вы имели ввиду.

Автор: gcc 18.7.2009, 01:03

KSURi, интерфейс программы не совсем понял... зачем все это?

Автор: KSURi 18.7.2009, 01:16

Чтобы не плодить методы типа get_a, get_b, ..., не делать $self->{hashref1}->{hashref2}->{a}, $self->{hashref1}->{hashref2}->{b}.

Автор: gcc 18.7.2009, 01:28

понятно, кажется понял...

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)