Не уверен, что полностью понял ваш вопрос, но надеюсь, это вам пригодится:
1. Не работайте с атрибутами напрямую, пишите вокруг них обертки-методы. Если лень писать, используйте Mouse например. 2. Не похоже, что в вашем случае требуется использовать наследование. Вообще наследованием часто злоупотребляют, настоящая потребность в нем возникает довольно редко. Вам точно не подойдет делегирование? 3. Разобраться с ООП в Perl может помочь эта заметка: http://eax.me/perl5-oop/ На самом деле там все довольно просто - bless превращает переменную в объект, а оператор стрелка преобразует вызов $obj->method($a, $b) в MyPackage::method($obj, $a, $b); 2012/10/2 Artem Zhuravlev <[email protected]>: > Помогите, окончательно запутался. > > Есть сценарий > > #!/usr/bin/perl -w > BEGIN { > $ENV{FCGI_SOCKET_PATH} = ":8000"; > $ENV{FCGI_LISTEN_QUEUE} = 10; > use CGI::Carp qw/carpout/; > open LOG, ">>", "carp.log" or die("Cannot open file: $!\n"); > carpout(LOG); > use lib "/home/artem/FCGI"; > } > use strict; > use 5.010; > use HTML::Template; > use Data::Dumper; > use engine::class::Page; > use engine::class::Core; > use CGI::Fast; > use POSIX qw(strftime); > our $query_cnt = 0; > our $query; > > while($query= CGI::Fast->new()) { > print "Content-type: text/html\n\n"; > eval{ > $query_cnt++; > my $init = Core->new($query_cnt); > #say Dumper ($init); > foreach my $get ($init->{db}->query("select * from city")){ > say $get->{name}." || "; > } > }; > if ($@){ > my $now_string = strftime "%Y-%m-%d %H:%M:%S", localtime; > open FILE, ">>", "carp.log" or next("Cannot open file: $!\n"); > print FILE "[".$now_string."][Eval error]".$@."\n"; > close FILE; > } > } > > > пакеты и классы > > #!/usr/bin/perl > package Core; > use engine::class::DB; > @ISA = qw/DB/; > use warnings; > use strict; > use 5.010; > sub new { > my $class = shift; > my $self = { > version => '1.0', > }; > bless $self, $class; > $self->init(@_); > $self->db(); > return $self; > } > sub init{ > my $self = shift; > $self->{query_cnt} = shift; > return $self; > } > sub db { > my $self = shift; > my $db = DB->dbconnect("логин", "пароль", "база" , "хост", "utf8", "utf8" , > "180" ); > $self->{db} = $db; > return $self; > } > return 1; > > > #!/usr/bin/perl > package DB; > use DBI; > use strict; > use warnings; > > sub dbconnect > { > my $class = shift; > my $self = { > _login => shift, > _password => shift, > _dbname => shift, > _host => shift, > _charset => shift, > _names => shift, > _timeout => shift, > }; > bless $self, $class; > $self->connect(); > return $self; > } > > > sub connect > { > my $self = shift; > $self->{_base} = > DBI->connect("DBI:mysql:database=$self->{_dbname};host=$self->{_host}", > "$self->{_login}", "$self->{_password}") or die "Unable to connect: > $DBI::errstr\n"; > $self->{_base}->do("SET charset $self->{_charset}"); > $self->{_base}->do("SET names $self->{_names}"); > $self->{_base}->do("SET session wait_timeout=$self->{_timeout}"); > } > > sub query > { > my( $self, $query ) = @_; > $self->connect() unless $self->{_base}->ping(); > my $sth = $self->{_base}->prepare($query); > $sth->execute; > return (@{$sth->fetchall_arrayref({})}) and $sth->finish; > } > > sub query_rw > { > my( $self, $query ) = @_; > $self->connect() unless $self->{_base}->ping(); > $self->{_base}->do($query); > } > > sub disconnect > { > my $self->{_base}->disconnect; > } > > sub db_handle > { > my $self = shift; > return $self->{_base}; > } > > > return 1; > > > Как мне построить наследование, что б в неком пакете Test я мог добраться до > объекта коннекта в базу из Core->{db} и использовать методы класса DB. > > В основном сценарии все работает в вот в последующем не получается > добраться. > > Спасибо. > > > -- > Moscow.pm mailing list > [email protected] | http://moscow.pm.org > -- С уважением, Александр Личный блог: http://eax.me/ Мой форум: http://it-talk.org/ Мой Twitter: http://twitter.com/afiskon -- Moscow.pm mailing list [email protected] | http://moscow.pm.org
