VPF::проблема при использовании DBIx::Tree в Catalyst

gcc

Дата 6.3.2009, 22:23 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

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

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

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

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

вот пример...

может быть надо сделать модель для DBIx::Tree?

Код


use DBIx::Tree;

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

    $c->stash->{template} = 'view.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) {

    push @{$tree_a}, { 'level' => ' &nbsp ' x ($level). "</UL>\n" };    
    
    $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.
    #
    if ($level > $curr_level) {
    push @{$tree_a}, { 'level' => ' &nbsp ' x ($level). "</UL>\n" };    
    }

    # If the level decreases, end the lists between levels.
    #
    if ($level < $curr_level) {
        while ($curr_level > $level) {
            $curr_level--;
    push @{$tree_a}, { 'level' => ' &nbsp ' x ($level). "</UL>\n" };    
        }
    }
    $curr_level = $level;

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

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

}

Это сообщение отредактировал(а) gcc - 6.3.2009, 22:36

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 14.3.2009, 08:50 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Код


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

Код


    sub disp_tree {

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

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

ginnie

Дата 16.3.2009, 12:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

gcc, может так

Код


method => \&disp_tree,

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

gcc

Дата 9.4.2009, 05:29 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

если не сложно, подскажите как альтернативно записать рекурсию этой функции disp_tree и вызова method => sub { disp_tree(@_) },

в catalyst оно не работает

в обычной программе рабоатет

я посомтрел другое модули на cpan у них тоже эта рекурсия...

там странная какая-то рекурсия, вот варнинг ругается:
Variable "$tree_a" will not stay shared at /MyApp/script/../lib/MyApp/Controller/view_tree.pm line 115.

Код


    if ($level > $curr_level) {
    push @{$tree_a}, { 'level' => ' &nbsp ' x ($level). "</UL>\n" };    
    }

строка 115 push @{$tree_a}, { 'level' => ' &nbsp ' x ($level). "</UL>\n" };

если написать перед строкой 115 my $tree_a то ничего не выводит, запутано как-то

Это сообщение отредактировал(а) gcc - 9.4.2009, 05:30

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 5.10.2009, 15:40 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

опять хотел восспользоватся этим модулем

http://search.cpan.org/~bjeps/DBIx-Tree-1.9/Tree.pm
http://cpansearch.perl.org/src/BJEPS/DBIx-Tree-1.9/Tree.pm

есть очень сложная ситуация

например данный код работает

Код


  my $tree = new DBIx::Tree(connection => $dbh,
                            sql      => $sql,
                            method     => \&_disp_tree,
                            columns    => ['id_se', 'name_se', 'parent_se_id'],
                            start_id   => $args[0],
                            recursive  => 1
                           );                          
   $tree->traverse;

sub _disp_tree {

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

    my $id    = $parms{id};
    
     print "$id\n";   
 
   return $id;

}

НО $id мне нужно сохранить и обработать, но этих элементов планируется безконечное количество

хотел сделать вот так

Код


while (my $id _disp_tree()) {
 print $id;
}

если добавить этот цикл, то ничего не работает...

подскажите как можно сделать чтобы перебрать по элементно?

====

в этом модуле идет некая рекурсия
http://cpansearch.perl.org/src/BJEPS/DBIx-Tree-1.9/Tree.pm

Код


....
      $self->{method}->
          ( item        => $item,
        level       => $level,
        id          => $current,
        parent_id   => \@parent_id,
        parent_name => \@parent_name )
          if (exists $self->{method} && $level >= $self->{threshold});
...

можно ли сделать так как я написал по элементно перебрать?

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 6.10.2009, 15:23 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

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

но есть проблема что 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 - это функция в которой должна быть рекурсия

вызывается:

Код


package MyApp::Controller::delete;
.......
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 но не получается

Это сообщение отредактировал(а) gcc - 7.10.2009, 08:01

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »