не работает DBIx::Tree в 'Catalyst

[ProFTP]

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

package MyApp::Controller::view_section;

use warnings;
use parent 'Catalyst::Controller';

use DBIx::Tree;

=head1 NAME

MyApp::Controller::view_section - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut


=head2 index 

=cut

sub view_section : Global {
    my ( $self, $c, @args ) = @_;

    $c->stash->{template} = 'view_section.tt';
    


my $sql;
if (defined($args[0])) {

$sql = "SELECT id_se, name_se, parent_se_id
        FROM section
        WHERE active_se = 1 AND privat_se = 1
";

} else { 

 $sql = "SELECT id_se, name_se, parent_se_id
         FROM section
         WHERE active_se = 1 AND privat_se = 1
";

}

my $dbh = $c->model('DBI')->dbh;


  my $tree = new DBIx::Tree(connection => $dbh,
                            sql      => $sql,
                            method     => sub { disp_tree(@_) },
                            columns    => ['id_se', 'name_se', 'parent_se_id'],
                            start_id   => $args[0],
                            recursive => '1'                         
                           );                          
  $tree->traverse;

 my $tree_a;



while ($curr_level > 0) {


    
    $curr_level--;
}

# End the HTML.
#


# This is the callback function for creating the tree. It's called for 
# each node in the tree.
#
sub disp_tree {

    # Get the parameters.
    #
    my %parms = @_;

    # We are interested in the item and its level.
    #
    my $item  = $parms{item};
    my $level = $parms{level};
    my $id    = $parms{id};
    my $created = $parms{created};

    # Strip leading and trailing space from the item.
    #
    $item =~ s/^\s+//;
    $item =~ s/\s+$//;

    # If the level increases, start a new list at the new level.
    #

push @{$tree_a}, { 'level' => ' &nbsp ' x ($level), 'item' => $item, 'created' => $args[0], 'id' => $id };

    # If the level decreases, end the lists between levels.
    #
    if ($level < $curr_level) {
        while ($curr_level > $level) {
            $curr_level--;

        }
    }
    $curr_level = $level;

    # Display each item.
    #


}
       $c->stash->{tree} = $tree_a;

}

при использовании DBIx::Tree с Catalyst::Model::DBI вывод данных происходит почти через раз...

если нажать на обновить страницу более чем 2 раза, то дерево не выводиться вообще, потом если обновить еще несколько раз, то все работает, потом опять пропадает связь и не выводит...

из-за чего это может быть? может внешний переменные какие-то??

в Catalyst::Model::DBI есть метод который поддерживает соединения... (но это не pool connection по-моиму)
(может быть надо сделать модель для DBIx::Tree?)

фигня по-моиму тут:

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

    method     => sub { disp_tree(@_) },

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

sub disp_tree {

как это под другому можно написать?

[Хостинг 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/

[Alex Keda]

циски - ф топку

[ProFTP]

http://search.cpan.org/~bjeps/DBIx-Tree-1.9/Tree.pm


сделал, до оптимизировал

но есть проблема что use warnings; ругается

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

package MyApp::Model::Tree;

use strict;
use warnings;
use base 'Catalyst::Model';
use Class::C3::Adopt::NEXT;
use DBIx::Tree;

sub new {
    my ( $class, $c ) = @_;
    my $self = $class->next::method(@_);
    $self->{dbh} = $c->model('DBI')->dbh; 
    return $self;
}  

sub extr_new {
    my ( $self, $sql, $id, $disp_tree_out  ) = @_;
  
  my $tree = new DBIx::Tree(connection => $self->{dbh},
                            sql      => $sql,
                            method     => \&$disp_tree_out,
                            columns    => ['id_se', 'name_se', 'parent_se_id'],
                            start_id   => $id,
                            recursive  => 1
                           );                          
   $tree->traverse;    

    return $self;

}
 
1;

где method - это функция в которой должна быть рекурсия

вызывается:

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

sub delete_s {
....
$c->model('Tree')->extr_new($sql_tree, $args[0], 'MyApp::Controller::delete::disp_tree');

.....


 sub disp_tree {
    my %parms = @_;

            $c->model('DBI')->dbh->do(
                'DELETE from section                         
                     WHERE id_se = ' . $parms{id}
            );
       

}


}

все работает! но проблема в том что $c не определено в disp_tree и use warnings; как это можно решить красиво, даже интересно??

я пробова сюда method => \&$disp_tree_out, поставить $dbh но не получается

[hizel]

не используешь perltidy - не уважаешь остальных

[ProFTP]

мне 2-4 строки написать - надо эту perltidy запускать?

[hizel]

форматировать нормально тада сразу, привыкать :-)

[ProFTP]

все нормально написано

я решил переписать этот модуль DBIx::Tree, проще будет, но вот лучше пропачтить, нашел monkey patching perl

вот можно переопределить какой-то метод класса, любой даже, если мы с ним без объекта работаем, в MyApp.pm перед загрузкой всех модулей:

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

package SomeCMS;

use strict;
use warnings;

use Catalyst::Runtime '5.70';

# Set flags and add plugins for the application
#
#         -Debug: activates the debug mode for very useful log messages
#   ConfigLoader: will load the configuration from a Config::General file in the
#                 application's home directory
# Static::Simple: will serve static files from the application's root 
#                 directory

use parent qw/Catalyst/;

our $VERSION = '0.01';


# ======== HACKS ================================

*Catalyst::Utils::class2appclass = sub {
    my $class = shift || '';
    my $appname = '';
    if ( $class =~ /^(.+?)::([MVC]|ModelX|ViewX|ControllerX|Model|View|Controller)::.+$/ ) {
        $appname = $1;
    }
    return $appname;    
};

*Catalyst::Utils::class2classprefix = sub {
    my $class = shift || '';
    my $prefix;
    if ( $class =~ /^(.+?::([MVC]|ModelX|ViewX|ControllerX|Model|View|Controller))::.+$/ ) {
        $prefix = $1;
    }
    return $prefix;
};

*Catalyst::Utils::class2prefix = sub {
    my $class = shift || '';
    my $case  = shift || 0;
    my $prefix;
    if ( $class =~ /^.+?::([MVC]|ModelX|ViewX|ControllerX|Model|View|Controller)::(.+)$/ ) {
        $prefix = $case ? $2 : lc $2;
        $prefix =~ s{::}{/}g;
    }
    return $prefix;
};