[Moscow.pm] Наследование

[Alexandr Alexeev]

Не уверен, что полностью понял ваш вопрос, но надеюсь, это вам пригодится:

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 <zhuravlev.artem.vasilyevich на gmail.com>:
> Помогите, окончательно запутался.
>
> Есть сценарий
>
> #!/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
> moscow-pm на pm.org | http://moscow.pm.org
>



-- 
С уважением, Александр
Личный блог: http://eax.me/
Мой форум: http://it-talk.org/
Мой Twitter: http://twitter.com/afiskon