VPF::поругайте на код - Форум программистов

gcc

Дата 13.11.2008, 22:52 (ссылка)

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

Загрузка ...

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

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

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

Уважаемые, поругайте пожалуйста на код...

там допиливать еще долго, некоторые вещи может быть покажутся странными...
если использовать use strict; то все остальное все равно? как протестировать можно?
(еще надо сделать 2 модуля)
еще там добавить в запрос после WHERE надо, делал так примерно:

Код


if ($s) {push @clausers "User = $s";}
$clause = join (" AND ", @clauses );
$sth = $dbh->prepare(SELECT * FROM table WHERE $clause );

код тут:
http://x0.org.ua/perl_old.txt

Это сообщение отредактировал(а) gcc - 21.12.2008, 09:23

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

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

gcc

Дата 13.11.2008, 23:09 (ссылка)

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

Загрузка ...

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

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

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

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

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

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

gcc

Дата 13.11.2008, 23:25 (ссылка)

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

Загрузка ...

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

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

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

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

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

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

dmitryk1

Дата 14.11.2008, 08:31 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 118
Регистрация: 10.6.2008
Где: Новосибирск

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

А почему вызовы $dbh = DBI->connect(
в каждой процедуре? Параметры вроде одинаковые... Может стоит глобальный объект сделать?

И ещё некоторые запросы красивые:

VALUES (?,?,?,?,?,?,NOW(),NOW(),?)

а некоторые генерятся, вроде как без особой надобности:

WHERE t1.session = \''
. $cookies{'session'} . '\' AND...

ну и делай их

WHERE t1.session = \'?
\' AND...

если сервак запросы кэширует и генерируемые часто встречаются, то сервак тормозить начнёт... немного.

оПЯТЬ же безопасность повысишь. А то хз, чего они там в куки напихают... чёнить типа "0 OR 1=1; drop table;/*--"
;)

Это сообщение отредактировал(а) dmitryk1 - 14.11.2008, 08:35

ginnie

Дата 14.11.2008, 12:26 (ссылка)

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

Загрузка ...

Эксперт

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

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

gcc, согласен с dmitryk1, по поводу соединений и placeholder'ов. Соединение надо передавать в функции параметром.

Лучше код $$dd{'domain'} писать как $dd->{'domain'}, так привычнее.

s /[\W]//g - зачем скобки и почему не \W+

&create_session; - вызовы функции лучше писать как create_session();

Почему use Data::Validate::Domain qw(is_domain); в середине скрипта?

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

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

tolkien

Дата 14.11.2008, 14:33 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 277
Регистрация: 5.4.2008

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

Вот $$dd{'domain'} от такого способа разыменование лучше отказаться. Потому что можно тогда спутать с символьными ссылками. Лучше делать как ginnie написал
[

gcc

Дата 14.11.2008, 19:41 (ссылка)

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

Загрузка ...

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

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

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

спасибо, исправлю...

Цитата(dmitryk1 @ 14.11.2008, 08:31)

Параметры вроде одинаковые...

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

Цитата(dmitryk1 @ 14.11.2008, 08:31)

А почему вызовы $dbh = DBI->connect(
в каждой процедуре? Параметры вроде одинаковые... Может стоит глобальный объект сделать?

глобальный объект, это один раз в начале скрипта подключится... или DBIx::Class?

Цитата(ginnie @ 14.11.2008, 12:26)

gcc, согласен с dmitryk1, по поводу соединений и placeholder'ов. Соединение надо передавать в функции параметром.

я хотел в начале скрипта подключиться, а в конце скрипта отключиться... и еще eval{} сейчас сделал так чтобы было видно когда подлючаюсь и когда отлючаюсь

как передвать в функцию подключение, это анонимная подпрограмма? (не могу понять смысла)

Это сообщение отредактировал(а) gcc - 14.11.2008, 20:38

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

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

ginnie

Дата 14.11.2008, 20:32 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(gcc @ 14.11.2008, 19:41

)

как передвать в функцию подключение, это анонимная подпрограмма? (не могу понять смысла)

func($dbh);

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

gcc

Дата 14.11.2008, 20:42 (ссылка)

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

Загрузка ...

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

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

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

а выключать соединение тогда наверное так:

Код


return $dbh->disconnect();

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

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

ginnie

Дата 14.11.2008, 20:48 (ссылка)

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

Загрузка ...

Эксперт

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

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

gcc, может все-таки так логичнее?

Код


my $dbh = DBI->connect(...);
func($dbh);
$dbh->disconnect();

Добавлено через 56 секунд

Цитата(gcc @ 14.11.2008, 19:41

)

и еще eval{} сейчас сделал так чтобы было видно когда подлючаюсь и когда отлючаюсь

можно фрагмент кода увидеть?

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

gcc

Дата 14.11.2008, 20:57 (ссылка)

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

Загрузка ...

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

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

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

Цитата(ginnie @ 14.11.2008, 20:48)

gcc, может все-таки так логичнее?

Код


my $dbh = DBI->connect(...);
func($dbh);
$dbh->disconnect();

ginnie, я понял, спасибо, буду делать...

Добавлено через 2 минуты и 6 секунд

Цитата(ginnie @ 14.11.2008, 20:48)

можно фрагмент кода увидеть?

кода нету, примерно вот так, если правильно это...

Код


eval {
my $dbh = DBI->connect(...);
func($dbh);
func($dbh);
$dbh->disconnect();
};

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

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

gcc

Дата 28.11.2008, 13:27 (ссылка)

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

Загрузка ...

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

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

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

Это сообщение отредактировал(а) gcc - 21.12.2008, 20:57

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

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

gcc

Дата 21.12.2008, 10:05 (ссылка)

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

Загрузка ...

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

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

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

я вот переписал, на всякий случай может кто-то посмотрит

интересно узнать где ошибки или не правильно, там работает всё

код:
http://x0.org.ua/perl/

там интересует вопрос

1) праивльно так написать во всех классах?

Код


our(%ok_field);
for my $attr ( qw (return_create temple_hash) ) {$ok_field{$attr}++;}
sub AUTOLOAD {
my $self =shift;
my $attr =  our $AUTOLOAD;
$attr =~ s/.*:://;
return if $attr eq "DESTROY";
if ($ok_field{$attr}) {
  $self->{uc $attr} = shift @_;
 return $self->{uc $attr};
} else {
 my $superior = "SUPER::$attr";
 $self->superior(@_);
}
}

в книге было не определено $AUTOLOAD:

Код


my $attr =  $AUTOLOAD;

как проверить работаетли AUTOLOAD? если он нужен вообще

2. я нашел много информации про DESTROY (он вызывается сам), в данном случае мне нужно свой метод делать DESTROY и что в нем удалять?

3. $dbh мне удобно было написать вызвать, потмо сделаю метод который будет $dbh в начале, в удалятся в DESTROY

Это сообщение отредактировал(а) gcc - 21.12.2008, 10:20

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

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

KSURi

Дата 22.12.2008, 13:28 (ссылка)

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

Загрузка ...

Опытный

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

Репутация: 20
Всего: 27

gcc, в вашем случае AUTOLOAD вовсе не нужен, у вас ведь всего два метода.
Обычно его используют для создания accessors/mutators для атрибутов объектов.

Как проверить AUTOLOAD? Странный вопрос... А как вы все остальное проверяете?

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

Died at Life.pl line 21

gcc

Дата 23.12.2008, 01:42 (ссылка)

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

Загрузка ...

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

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

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

KSURi, понятно, я хотел как раз в целом спросить, не то что мелкие ошибки, а чтобы знать куда дальше смотреть... smile

я так понял что если работает - значит правильно smile

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

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

gcc

Дата 23.12.2008, 08:51 (ссылка)

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

Загрузка ...

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

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

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

а что такое accessors/mutators ?

вот начал искать, мало что нашел:
http://www.manpagez.com/man/3/Class::Accessor/
http://search.cpan.org/dist/Class-Accessor...cessor/Class.pm

это такое же как и SUPER?

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

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

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

ginnie

Дата 23.12.2008, 12:28 (ссылка)

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

Загрузка ...

Эксперт

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

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

gcc, accessors/mutators (иногда их называют getters/setters) - методы класса для получения/изменения значений его свойств. Т.е. если есть у класса Thing свойство color, то для получения значения этого свойства в программе необходимо использовать метод (accessor), например, get_color(). Аналогичный метод set_color() (mutator) следует использовать для изменения значения свойства. Очень часто один метод используется и как accessor и как mutator (для нашего примера - color()). Необходимое действие определяется по аргументам метода.

Код


my $thing_color = $thing_obj->color(); # accessor
$thing_obj->color('red'); # mutator

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

gcc

Дата 24.12.2008, 06:59 (ссылка)

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

Загрузка ...

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

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

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

спасибо, я думал это что-то другое smile

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

Это сообщение отредактировал(а) gcc - 24.12.2008, 07:24

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

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

gcc

Дата 11.1.2009, 01:32 (ссылка)

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

Загрузка ...

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

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

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

остальное тут http://x0.org.ua/perl/2/

Это сообщение отредактировал(а) gcc - 13.1.2009, 19:57

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

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

gcc

Дата 16.6.2009, 05:40 (ссылка)

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

Загрузка ...

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

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

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

можете посмотреть другую?

некоторые вещи не доделал, в исходники в окончательный вариант еще не фофрмлил
страницы еще не все работают

посмотрите есть ли ошибки:
(perltidy)
http://x0.org.ua/perl/cat/
http://h2572.test-hf2.ru/cat/

ошибки кода сюда можно?

еще демо:
http://ldap.x0.org.ua
(*HTML не оформлял)

юзер
логин: test02
mypass

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

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

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

KSURi

Дата 16.6.2009, 10:08 (ссылка)

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

Загрузка ...

Опытный

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

Репутация: 20
Всего: 27

Прочитал буквально пару файлов и везде есть такое:

Код


$c->stash->{template} = '/home/x0/data/www/MyApp/root/index.tt';

Так делать не надо. Меняйте на относительные пути или ищи ф-ии каталиста для вычисления абсолютных путей.

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

Died at Life.pl line 21

gcc

Дата 16.6.2009, 17:23 (ссылка)

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

Загрузка ...

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

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

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

KSURi, я это не исправил просто, я заметил что там путь не надо

а как стиль и т.д., нормально? если я использовал SQL::Abstract, то может во всех остальных тоже SQL::Abstract поставить? или все равно?

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

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

gcc

Дата 29.7.2009, 09:05 (ссылка)

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

Загрузка ...

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

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

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

посмотрите плиз сейчас, например:

может алгоритм где-то поменять надо?

где есть ошибки?

проблема, что нужно, желательно, чтобы посмотрел на код оптыный программист и сказал где ошибки...

Код

package MyApp::Controller::view_content;

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

=head1 NAME

MyApp::Controller::view_content - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut

=head2 index 

=cut

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

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

    if ( !$args[0] || $args[0] !~ /^\d+$/ ) {
        $c->response->redirect( $c->uri_for('/') );
        $c->detach();
    }

    $args[1] = undef if ( $args[1] && $args[1] !~ /^\d+$/ );

    ## terms of query for current content
    my $sql;

    if ( !$c->check_user_roles('moder_se') && $c->user_exists() == 1 ) {

        $sql = 'AND (( t1.hiden_co = 0 
                     AND t1.active_co = 1)  
                     OR t1.id_un = ' . $c->user->{user}->{id} . ')';

    }
    elsif ( $c->check_user_roles('moder_se') ) {
        $sql = '';

    }

    elsif ( $c->user_exists() == 0 ) {
        $sql = 'AND t1.active_co = 1
                     AND t1.hiden_co = 0
                     AND t1.hiden_g_co = 0';
    }

    else {

    }

    my $sql_content = 'SELECT t1.id_co,  
                                 t1.id_un,            
                                    t1.id_se,             
                                        t1.name_co,          
                                            t1.heading_name_co,  
                                            t1.keys_co,          
                                            t1.text_co,         
                                            t1.active_co,        
                                            t1.hiden_co,         
                                            t1.hiden_g_co,       
                                            t1.close_co,         
                                            t1.voting_co,        
                                            t1.vo_all_co,       
                                            t1.vo_balls_co,     
                                            t1.vo_per,           
                                            t1.created,
                                            t1.modified,
                                            t1.forbi_comm_co,
                                            t2.name_se,
                                            t2.forbi_content_se,
                                    t2.hiden_g_co AS hiden_g_se,
                                    t2.active_se,
                                    t2.id_un AS id_un_par,                                            
                                            t3.username                                              
                            FROM content AS t1                                             
                       LEFT JOIN section AS t2
                              ON t1.id_se = t2.id_se
                       LEFT JOIN users AS t3
                              ON t1.id_un = t3.id        
                           WHERE t1.id_co = ' . $args[0] . ' 
                               ' . $sql . '
                           LIMIT 1';

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

    my $sth = $dbh->prepare($sql_content);
    $sth->execute();
    my $loop_data2 = $sth->fetchrow_hashref();
    $sth->finish();

    ## surplus of information and dispatch in a template

    $c->stash->{guest} = 1 if ( !$c->user_exists() );

    if ( !$loop_data2 ) {
        $c->stash->{messages_error} = 1;
        $c->detach();
    }

    if ( $loop_data2->{hiden_g_se} == 1 && !$c->user_exists() ) {
        $c->stash->{error_hiden_g} = 1;
        $c->detach();
    }

    if (   $loop_data2->{active_se} == 0
        && $loop_data2->{id_un_par} != $c->user->{user}->{id}
        && !$c->check_user_roles('moder_se') )
    {
        $c->stash->{error_active_se} = 1;
        $c->detach();
    }

    $c->stash->{add_co} = 1
      if ( $c->check_user_roles('add_co')
        && $loop_data2->{forbi_content_se} == 0 );

    $loop_data2->{username} =
      !$loop_data2->{username} ? 'Guest' : $loop_data2->{username};

    while ( my ( $key, $value ) = each( %{$loop_data2} ) ) {

        if (
            (
                   $c->user_exists()
                && $loop_data2->{id_un} == $c->user->{user}->{id}
            )
            || $c->check_user_roles('moder_se')
          )
        {
            $c->stash->{edit_co} = 1;
        }

        if ( $key eq 'active_co' ) {
            $value = $value == 0 ? '1' : undef;
        }

        if ( $key eq 'hiden_g_co' ) {
            $value = $value == 1 ? '1' : undef;
        }

        if ( $key eq 'voting_co' && $c->user_exists() ) {

            $value = $value == 1 ? '1' : undef;
        }

        if ( $key eq 'voting_co' && !$c->user_exists() ) {
            $value = undef;
        }

        if ( $key eq 'close_co' ) {
            $value = $value == 1 ? '1' : undef;
        }

        if ( $key eq 'hiden_co' ) {
            $value = $value == 1 ? '1' : undef;
        }

        if (
            (
                   $c->user_exists()
                && $loop_data2->{id_un} == $c->user->{user}->{id}
                && $loop_data2->{created} > time - 86400
                && $loop_data2->{close_co} != 1
            )
            || $c->check_user_roles('moder_co')
          )
        {
            $c->stash->{to_edit_co} = 1;
            $c->stash->{delete_co}  = 1;
        }

        $c->stash->{$key} = $value;

    }

    if (
        !$c->user_exists()
        || (   $loop_data2->{forbi_comm_co} == 1
            || $loop_data2->{close_co} == 1 )
        && !$c->check_user_roles('moder_co')
      )
    {

        $c->stash->{comm_co} = 1;
    }

    my $sql_max = 'SELECT count(*)+1 AS position
                              FROM content AS t1
                        LEFT JOIN content AS t2
                                 ON t1.id_co = ' . $loop_data2->{id_co} . ' 
                                AND t1.vo_all_co < t2.vo_all_co
                             WHERE t2.id_co IS NOT NULL';

    my $sth = $dbh->prepare($sql_max);
    $sth->execute();
    $c->stash->{position} = $sth->fetchrow_array();
    $sth->finish();

    ##  condition for the queries of paginal conclusion of comments
    my $sql2;

    if ( $c->user_exists() == 0 ) {
        $sql2 = 'id_co = ' . $args[0] . '
                     AND hiden_g_cm = 0';
    }
    else {
        $sql2 = 'id_co = ' . $args[0];
    }

    my $max_count = 'SELECT count(*)
                              FROM comment                                             
                              WHERE ' . $sql2;

    my $sth = $dbh->prepare($max_count);
    $sth->execute();
    my $count_content = $sth->fetchrow_arrayref();
    $sth->finish();

    my $url = '/view_content/' . $args[0] . '/';

    my $url_panel;

    $c->request->params->{moder_panel} = $c->request->params->{moder_panel}
      || '';

    if ( $c->request->params->{moder_panel} eq '1' ) {
        $url_panel = '/?moder_panel=1';
    }

    my ( $count_limit, $page, $max_page ) =
      $c->model('DBI')
      ->build_pages( $url, $count_content->[0], $args[1], $url_panel );

    $c->stash->{page} = $page if $page;

    my $sql_comment = 'SELECT    t1.id_cm,
                                            t1.id_co,  
                                            t1.id_se,         
                                            t1.id_un,           
                                            t1.name_guest,     
                                            t1.text_cm,       
                                            t1.hiden_g_cm,    
                                            t1.created,          
                                            t2.username
                            FROM comment AS t1                                             
                       LEFT JOIN users AS t2
                              ON t1.id_un = t2.id    
                           WHERE ' . $sql2 . '
                           LIMIT ?,?';

    my $sth = $dbh->prepare($sql_comment);
    $sth->execute( $count_limit, $max_page );
    my $loop_data;
    push @{$loop_data}, $_ while $_ = $sth->fetchrow_hashref();
    $sth->finish();

    if ($loop_data) {

        foreach $_ ( @{$loop_data} ) {

            ## determination of author as being a guest of ( it is cut out from architecture of the program)
            #if ($_->{id_un} == 0){
            #            if ($_->{text_cm}) {
            #        $_->{username} = $_->{text_cm};
            #
            #       } else {
            #       $_->{username} = 'Guest';
            #        }
            #}

            $_->{username} = 'Guest' if ( $_->{username} eq '' );

            if (
                (
                       $c->user_exists()
                    && $_->{id_un} == $c->user->{user}->{id}
                    && $_->{created} > time - 86400
                    && $loop_data2->{close_co} != 1
                )
                || $c->check_user_roles('moder_co')
              )
            {

                #  print '1';
                $_->{delete_cm} = 1;
                $_->{edit_cm}   = 1;
            }

        }

        $c->stash->{comment} = $loop_data;
    }
    else {
        $c->stash->{no_comment} = 1;
    }

    #### tree
    $c->forward( 'tree_sections', [$loop_data2] );

    ## verification and conclusion previous and followings content

    my $sql_max = 'SELECT MAX(t1.id_co) AS prev                
                              FROM content AS t1
                            WHERE t1.id_se = ' . $loop_data2->{id_se} . ' 
                               AND t1.id_co > ' . $args[0] . '
                               ' . $sql . ' 
                             LIMIT 1';

    my $sth = $dbh->prepare($sql_max);
    $sth->execute();
    my $loop_data3 = $sth->fetchrow_hashref();
    $sth->finish();

    my $sql_min = 'SELECT MIN(t1.id_co) AS next
                             FROM content AS t1
                           WHERE t1.id_se = ' . $loop_data2->{id_se} . ' 
                                AND t1.id_co < ' . $args[0] . '
                                ' . $sql . '  
                           LIMIT 1';

    my $sth = $dbh->prepare($sql_min);
    $sth->execute();
    my $loop_data4 = $sth->fetchrow_hashref();
    $sth->finish();

    $c->stash->{next} = $loop_data4->{next} if ( $loop_data4->{next} );
    $c->stash->{prev} = $loop_data3->{prev} if ( $loop_data3->{prev} );

}

sub tree_sections : Privat {

    my ( $self, $c, $loop_data2 ) = @_;

    my @loop_data_tree;
    my $loop_data_tree;

    if ( $loop_data2->{id_se} != 1 ) {

        my $index = 0;
        my @head  = ();
        my $dbh   = $c->model('DBI')->dbh;
        while (1) {

            my $sth = $dbh->prepare( "
        SELECT parent_se_id,
                 id_se,
                 name_se             
        FROM section
        WHERE id_se = ? 
        LIMIT 1
      " );

            #my $sqle;
            #if ( $head[$#head] ) {
            #$sqle = $head[$#head];
            #} else {
            #$sqle = $loop_data2->{id_se};
            #}

            $sth->execute( $head[$#head] || $loop_data2->{id_se} );

            my $loop = $sth->fetchrow_hashref();
            $sth->finish();

            push( @{$loop_data_tree}, $loop );

            push @head, $loop->{parent_se_id};

            last if ( $head[$#head] eq '1' || !$head[$#head] );

        }

        @{$loop_data_tree} = reverse @{$loop_data_tree};

        $c->stash->{data_tree} = $loop_data_tree;

    }

}

=head1 AUTHOR

Charlie &

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

Это сообщение отредактировал(а) gcc - 29.7.2009, 09:20

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

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

gcc

Дата 29.7.2009, 09:22 (ссылка)

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

Загрузка ...

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

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

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

Код

package MyApp::Controller::view_section;

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

=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';

    if ( $args[0] == 1 || $args[0] !~ /^\d+$/ ) {
        $c->response->redirect( $c->uri_for('/view_global_section') );
        return;
    }

    $args[1] = undef if ( $args[1] && $args[1] !~ /^\d+$/ );

    my $sql2;    ## page section
    my $sql3;    ## count_section
    my $sql4;    ## count_content
                 #  my @sql;

    if ( $c->user_exists() == 0 ) {

        ## page section
        $sql2 = 't1.hiden_g_co = 0
                     AND t1.active_se = 1
                     AND t1.privat_se = 0
                     AND t1.parent_se_id = ? ';

        ## count_section
        $sql3 = 'AND t2.hiden_g_co = 0
                     AND t2.active_se = 1
                     AND t2.privat_se = 0';

        ## count_content
        $sql4 = ' AND t3.active_co = 1
                    AND t3.hiden_co = 0
                    AND t3.hiden_g_co = 0';

    }

    if ( $c->user_exists() == 1
        && !$c->check_user_roles('moder_se') )
    {

        ## page section
        $sql2 = '(t1.active_se = 1
                     OR t1.id_un = ' . $c->user->{user}->{id} . ')
                     AND t1.privat_se = 0
                     AND t1.parent_se_id = ?';

        ## count_section
        $sql3 = 'AND (t2.active_se = 1                     
                     OR t2.id_un = ' . $c->user->{user}->{id} . ')
                     AND t2.privat_se = 0';

        ## count_content
        $sql4 = 'AND (( t3.hiden_co = 1 
                     AND t3.active_co = 1)  
                     OR t3.id_un = ' . $c->user->{user}->{id} . ')';

    }

    if (   $c->user_exists() == 1
        && $c->check_user_roles('moder_se') )
    {

        ## page section
        $sql2 = 't1.parent_se_id = ?
                     AND t1.privat_se = 0';

        ## count_section
        $sql3 = 'AND t2.privat_se = 0';

        ## count_content
          $sql4 = '';
    }

    ## check section and parent
    my $sql_section = 'SELECT t1.id_se,
                                      t1.id_un, 
                                   t1.parent_se_id,
                                   t1.hiden_g_co,
                                   t1.close_se,
                                   t1.forbi_section_se,
                                   t1.forbi_content_se,
                                   t1.active_se,
                                   t2.hiden_g_co AS hiden_g_co_par,
                                   t2.active_se AS active_se_par,
                                   t2.id_un AS id_un_par
                                   
                                    
                              FROM section AS t1
                       LEFT JOIN section AS t2
                             ON t2.id_se = t1.parent_se_id 

                             WHERE t1.id_se = ? 
                             LIMIT 1';

    my $parent = $c->model('DBI')->extra_prepare( $sql_section, $args[0] );

    if ( $parent->{parent_se_id} ) {

        if ( $parent->{parent_se_id} != 1 ) {
            $c->stash->{parent_se_id} = $parent->{parent_se_id};
            $c->stash->{id_se}        = $parent->{id_se};
        }

    }
    else {
        $c->stash->{error_section} = 1;
        return;

    }

    if ( $parent->{hiden_g_co} == 1 && $c->user_exists() == 0 ) {
        $c->stash->{error_hiden_g} = 1;
        return;
    }

    if ( $parent->{hiden_g_co_par} == 1 && $c->user_exists() == 0 ) {
        $c->stash->{error_hiden_g_par} = 1;
        return;
    }

    if (   $parent->{active_se} == 0
        && $parent->{id_un} != $c->user->{user}->{id}
        && !$c->check_user_roles('moder_se') )
    {

        $c->stash->{error_active_se} = 1;
        return;

    }

    if (   $parent->{active_se_par} == 0
        && $parent->{id_un_par} != $c->user->{user}->{id}
        && !$c->check_user_roles('moder_se') )
    {

        $c->stash->{error_active_se_par} = 1;
        return;

    }

    if (
        $c->check_user_roles('moder_se')
        || (   $c->user_exists() == 1
            && $parent->{id_un_par} == $c->user->{user}->{id} )
      )
    {
        $c->stash->{close_se}  = $parent->{close_se} == 1  ? '1'   : undef;
        $c->stash->{active_se} = $parent->{active_se} == 1 ? undef : '1';
        $c->stash->{active_se_par} =
          $parent->{active_se_par} == 1 ? undef : '1';
        $c->stash->{hiden_g_co} = $parent->{hiden_g_co} == 1 ? '1' : undef;
        $c->stash->{hiden_g_co_par} =
          $parent->{hiden_g_co_par} == 1 ? '1' : undef;

    }

    $c->stash->{add_co} = 1
      if ( $c->check_user_roles('add_co') && $parent->{forbi_content_se} == 0 );
    $c->stash->{add_se} = 1
      if ( $c->check_user_roles('add_se') && $parent->{forbi_section_se} == 0 );

    ## select count section from subsections
    my $sql_count = 'SELECT count(*) AS count
                 FROM section AS t1 
                WHERE 
                     ' . $sql2;

    $c->stash->{id_se_sort} = $args[0];

    my $count_section = $c->model('DBI')->extra_prepare( $sql_count, $args[0] );

    ## preparation of sorting of information
    my $url = '/view_section/' . $args[0] . '/';

    my ( $sort_url, $sort, $asc, $sort_sql );

    if ( $c->request->params->{sort} ) {

        ( $sort, $asc ) = split( /-/, $c->request->params->{sort}, 2 );

        if ( $sort eq 'name' ) {
            $sort_sql              = 't1.name_se';
            $sort_url              = '/?sort=' . $sort;
            $c->stash->{name_sort} = 1;
        }
        elsif ( $sort eq 'username' ) {
            $sort_sql                  = 't3.username';
            $sort_url                  = '/?sort=' . $sort;
            $c->stash->{username_sort} = 1;
        }
        else {
            $sort_sql = 't1.created';
            $c->stash->{time_sort} = 1;
        }

        if ($asc) {

            $sort_url .= '-asc';
            $c->stash->{asc} = 1;
            $sort_sql .= ' asc';
        }
        else {
            $sort_sql .= ' desc';
        }

    }
    else {

        $sort_sql = 'created desc';
        $c->stash->{time_sort} = 1;
    }

    $c->request->params->{moder_panel} = $c->request->params->{moder_panel}
      || '';

    if ( $c->request->params->{moder_panel} eq '1' ) {
        $sort_url = $sort_url ? '&moder_panel=1' : '?moder_panel=1';
    }

    $c->stash->{id_se_sort} = $args[0];

    ##construction of pages

    my ( $count_limit, $page, $max_page ) =
      $c->model('DBI')
      ->build_pages( $url, $count_section->{count}, $args[1], $sort_url );

    $c->stash->{page} = $page if $page;

    ## query of viewing of subsections

    my $sqlsubsections = 'SELECT t1.id_se,
                      t1.id_un, 
                      t1.name_se, 
                      t1.parent_se_id,
                      t1.close_se,
                      t1.active_se,
                      t1.hiden_g_co,
                      t1.forbi_section_se,
                      t1.forbi_content_se,
                      t1.created,

                      (select count(*) 
                         from section as t2 
                        where t1.id_se = t2.parent_se_id
                          ' . $sql3 . '
                        ) AS count_section,

                      (select count(*) 
                         from content as t3 
                        where t3.id_se = t1.id_se
                            ' . $sql4 . '
                        ) AS count_content,
                        
                      t4.id,
                      t4.username                                      
             FROM section AS t1
                LEFT JOIN users AS t4
                ON id_un = t4.id 
           WHERE ' . $sql2 . '
           ORDER BY ' . $sort_sql . '
           LIMIT ?,?';

    my $loop_data =
      $c->model('DBI')
      ->push_prepare( $sqlsubsections, $args[0], $count_limit, $max_page );

    ## surplus of information, verification is a change, verification of roles, and dispatch in a template
    foreach $_ ( @{$loop_data} ) {
        $_->{count_section} ||= '-';
        $_->{count_content} ||= '-';
        $_->{username} = !$_->{username} ? 'Guest' : $_->{username};

        if ( $c->check_user_roles('moder_se') ) {
            $_->{close_se}  = $_->{close_se} == 1  ? '1' : undef;
            $_->{active_se} = $_->{active_se} == 1 ? '1' : undef;

            $_->{forbi_section_se} = $_->{forbi_section_se} == 1 ? '1' : undef;
            $_->{forbi_content_se} = $_->{forbi_content_se} == 1 ? '1' : undef;
            $_->{hiden_g_co}       = $_->{hiden_g_co} == 1       ? '1' : undef;
        }
        if (
            $c->check_user_roles('moder_se')
            || (   $c->user_exists()
                && $_->{id_un} == $c->user->{user}->{id}
                && $_->{created} > time - 86400 )
          )
        {

            $_->{edit_se}   = 1;
            $_->{delete_se} = 1;

        }

    }

    if ( $c->check_user_roles('moder_se') ) {

        $_->{edit_close} = 1;

        if ( $c->request->params->{moder_panel} eq '1' ) {

            foreach $_ ( @{$loop_data} ) {
                $_->{id_se}       = $_->{id_se} . '/?moder_panel=1';
                $_->{moder_panel} = 1;

            }
            $c->stash->{id_se} = $args[0];

            $c->stash->{moder_panel} = 1;

        }
        else {
            $c->stash->{id_se} = $args[0] . '/?moder_panel=1';

        }
        $c->stash->{moder_se} = 1;
    }

    if ($loop_data) {
        $c->stash->{section_head} = $loop_data;
    }
    else {
        $c->stash->{no_section_head} = 1;
    }

    ## verification and conclusion previous and followings section
    my $sql_max = 'SELECT MIN(t2.id_se) AS next                
                              FROM section AS t2
                             WHERE t2.id_se > ?
                               AND t2.parent_se_id = ?
                               '.$sql3.'
                             LIMIT 1';

    my $loop_max =
      $c->model('DBI')
      ->extra_prepare( $sql_max, $args[0], $parent->{parent_se_id} );

    my $sql_min = 'SELECT MAX(t2.id_se) AS prev
                               FROM section AS t2
                           WHERE t2.id_se < ?
                                AND t2.parent_se_id = ?
                                '.$sql3.' 
                          LIMIT 1';

    my $loop_min =
      $c->model('DBI')
      ->extra_prepare( $sql_min, $args[0], $parent->{parent_se_id} );

    $c->stash->{prev} = $loop_min->{prev} if ( $loop_min->{prev} );
    $c->stash->{next} = $loop_max->{next} if ( $loop_max->{next} );

    #### tree
    $c->forward( qw /MyApp::Controller::view_content tree_sections/,
        [$parent] );
    ### end tree

}

=head1 AUTHOR

Charlie &

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

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

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

gcc

Дата 19.8.2009, 21:32 (ссылка)

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

Загрузка ...

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

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

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

извените, а как можно отследить попытку взлома, чтобы не было возможности взломать? (нужно чтобы пароли были в открытом виде)
http://x0.org.ua/perl/2/

это пусковой
http://x0.org.ua/perl/index.pll.txt

правда я передал сам скрипт вот он тут: ftp://ftp.lissyara.su/users/ProFTP/simplemailadmin-1.0.zip

если надо могу локально выложить?

Это сообщение отредактировал(а) gcc - 20.8.2009, 00:20

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

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

gcc

Дата 21.9.2009, 06:01 (ссылка)

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

Загрузка ...

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

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

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

таки кому-то понравилась программа в первом посте, в хостинговой компании ее используют, переделали...

прислали в письме:

патч для SQLIite:

Цитата

Собственно сабж.

http://code.google.com/p/simplemailadmin/
Немного попатчил, чтобы появилась поддержка SQLite, пофиксил пути в
темплейтах, переписал документацию по установке.

Отличная софтина, ООП и т.д.

В планах ещё написать полноценную доку об установке почтовой системы на базе

кстате, еще есть у меня админка, я писал для Postfix/exim + DBmail + White List для кадного ящика (с возможностями чтобы пользователь имел еще и Grey list и Black list персональный) + там еще есть "уникальная блокировка спама с помощью Captcha", но то другой вопрос...

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

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

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

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