Вернуться   BBS SyS-AdmiN > Технический > Программный > Perl
Регистрация Правила форумаДоска почета Пожертвования Справка Пользователи Календарь Поиск Сообщения за день Все разделы прочитаны

Perl Perl-кодинг, советы и т.п.

Рекламный блок!
Если Вы хотите поддержать развития данного ресурса, но не имеете возможности помочь финансово, то перейдите по ссылкам указаным ниже. Чем чаще будете переходить тем больше Вы поможете развитию проэкта. Что бы прочитать это объявление полностью, нажмите на кнопку ниже

Ответ
 
LinkBack Опции темы Опции просмотра
Старый 10.11.2008, 17:45   #61 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

Цитата:
Сообщение от cooler Посмотреть сообщение
Неее... Это не панель.. Это как укоз.. Тоже говносайт...

что такое укоз? CMS такая есть

я там не пользовался, а что там плохо? ты там пользовался??
надо будет попробовать там 10 дней бесплатно вроде
CISCO вне форума   Ответить с цитированием
Старый 10.11.2008, 18:08   #62 (permalink)
Злой Админ
 
Аватар для cooler
 
Регистрация: 16.11.1984
Сообщений: 119
Вы сказали Спасибо: 3
Поблагодарили 13 раз(а) в 13 сообщениях
cooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспорима
Отправить сообщение для cooler с помощью ICQ
По умолчанию

Цитата:
Сообщение от CISCO Посмотреть сообщение
укоз? CMS

Укоз? ЦМС??????
ЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫ ЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫ ЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫ ЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫЫ

извините, но от такого не могу сдержатся))))))))))))))))))))))))))))))))))))))))) ))))
__________________

Полная подпись
cooler вне форума   Ответить с цитированием
Старый 10.11.2008, 18:16   #63 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

UcoZ - уникальная система для создания сайтов - бесплатный конструктор сайтов нового поколения
CISCO вне форума   Ответить с цитированием
Старый 10.11.2008, 18:29   #64 (permalink)
Злой Админ
 
Аватар для cooler
 
Регистрация: 16.11.1984
Сообщений: 119
Вы сказали Спасибо: 3
Поблагодарили 13 раз(а) в 13 сообщениях
cooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспорима
Отправить сообщение для cooler с помощью ICQ
По умолчанию

мне можешь не говорить что такое укоз)))
а смотреть на него даже не советую.. хотя если для себя.. чисто поржать. =)
__________________

Полная подпись
cooler вне форума   Ответить с цитированием
Старый 10.11.2008, 19:18   #65 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

Цитата:
Сообщение от cooler Посмотреть сообщение
а смотреть на него даже не советую.. хотя если для себя.. чисто поржать. =)

я просто не знаю что ты имеешь ввиду...
(хотя мне сейчас эта информация про ту панель не нужна...)

на вид вробе бы панель как панель, возможностей сразу видно что мало в apache и etc

хотя они для себя писали...
CISCO вне форума   Ответить с цитированием
Старый 20.11.2008, 05:27   #66 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

вот пример которвый пишу...

[HIDE]
Код:
use Apache::Admin::Config;
my $conf = new Apache::Admin::Config '/$qhost',
  or die $Apache::Admin::Config::ERROR;
my $vhost;
my %templ_value;
my $templ_value;
my ( $serveradmin, $serveralis, $costomlog, $errorlog, @drtvs4 );
foreach my $vh ( $conf->section('VirtualHost') ) {

    if ( $vh->directive('ServerName')->value eq $nameserver ) {
        $serveradmin = $vh->directive('ServerAdmin');
        $serveralis  = $vh->directive('ServerAlias');
        $costomlog   = $vh->directive('CustomLog');
        $errorlog    = $vh->directive('ErrorLog');
        @drtvs4      = $vh->directive('ErrorDocument');
    }
}

my $template = HTML::Template->new(
    filename          => $dir . 'tempele-apache22-aid.html',
    die_on_bad_params => '0'
);
my $url = $query->url( -relative => 1 );
$template->param( URL => $url );
$template->param( AID => $aid );

if ( defined($saa) ) {
    if ($serveradmin) {
        use Data::Validate::Email qw(is_email);
        if (
            (
                   ( length($saa) )
                && ( 70 > length($saa) )
                && ( 5 < length($saa) )
            )
            && ( is_email($saa) )
          )
        {
            foreach my $vh ( $conf->section('VirtualHost') ) {
                if ( $vh->directive('ServerName')->value eq $nameserver ) {
                    $vh->directive('ServerAdmin')->set_value($saa);
                }
            }
            $conf->save;

            #my  $okssa="ok add ServerAdmin";
        }
        else { %templ_value = ( 'errorsa' => 1 ); }
    }   #else {  $vh->add_directive(ServerAdmin => $saa) }                     }

    if ($serveradmin) {

        #my ($serveradmin);
        # my $serveradmin=$vh->directive('ServerAdmin');
        %templ_value = ( serveradmin => $serveradmin );
    }
    else { %templ_value = ( 'noserverserveradmin' => '1' ); }
    $template->param( NOSERVERADMIN => $templ_value{'noserverserveradmin'} );
    $template->param( SERVERADMIN   => $templ_value{'serveradmin'} );
    $template->param( ERRORSA       => $templ_value{'errorsa'} );
    my $addsa = $query->param("addsa");
    if ( defined($addsa) ) {
        use Data::Validate::Domain qw(is_domain);
        if (   ( ( 70 > length($addsa) ) && ( 4 < length($addsa) ) )
            && ( is_domain($addsa) ) )
        {
            if ($serveralis) {

                #my $serveralis=$vh->directive('ServerAlias');
                my @serv_array = split( / /, $serveralis );
                my $n = scalar(@serv_array);
                my ( $match, $found, $item );
                foreach $item (@serv_array) {
                    if ( $item eq $addsa ) { $match = $item; $found = 1; last; }
                }
                if ( !$found ) {
                    $serv_array[$n] = $addsa;
                    my $addsa2 = join( ' ', @serv_array );
                    foreach my $vh ( $conf->section('VirtualHost') ) {
                        if (
                            $vh->directive('ServerName')->value eq $nameserver )
                        {
                            $vh->directive('ServerAlias')->set_value($addsa2);
                        }
                    }
                    $conf->save;
                }
                else { %templ_value = ( 'addsa_found' => '1' ); }
            }
        }
        else { %templ_value = ( 'addsa_noval' => '1' ); }
    }
    my $sadelete = $query->param("sadelete");
    if ( defined($sadelete) ) {
        if ($serveralis) {
            my @serv_array;
            @serv_array = split( / /, $serveralis );
            my $n = scalar(@serv_array);
            delete( @serv_array[$sadelete] );
            my $addsa2 = join( ' ', @serv_array );
            foreach my $vh ( $conf->section('VirtualHost') ) {
                if ( $vh->directive('ServerName')->value eq $nameserver ) {
                    $vh->directive('ServerAlias')->set_value($addsa2);
                }
            }
            $conf->save;
        }
    }
    my $allsa = $query->param("allsa");
    if ( defined($allsa) ) {
        my $satooall = $query->param("satooall");
        if ($serveralis) {
            $satooall = $query->param("satooall");
            my @serv_array;
            @serv_array = split( / /, $serveralis );
            my $n  = scalar(@serv_array);
            my $ss = "*.$nameserver";
            if ( ( defined($satooall) ) && ( $satooall eq "1" ) ) {
                if ( ( $n eq '2' ) && ( $serv_array[1] eq $ss ) ) {
                    %templ_value = ( 'satooall_in_use' => '1' );
                }
                else {
                    my $allsa2 = "$nameserver2 $ss";
                    foreach my $vh ( $conf->section('VirtualHost') ) {
                        if (
                            $vh->directive('ServerName')->value eq $nameserver )
                        {
                            $vh->directive('ServerAlias')->set_value($allsa2);
                        }
                    }
                    $conf->save;
                }
            }
            elsif ( ( defined($satooall) ) && ( $satooall eq "2" ) ) {
                if ( ( $n > 0 ) && ( $serv_array[1] ne $ss ) ) {
                    %templ_value = ( 'nosatooall_in_use' => '1' );
                }
                else {
                    my $allsa2 = $nameserver2;
                    foreach my $vh ( $conf->section('VirtualHost') ) {
                        if (
                            $vh->directive('ServerName')->value eq $nameserver )
                        {
                            $vh->directive('ServerAlias')->set_value($allsa2);
                        }
                    }
                    $conf->save;
                }
            }
            else { %templ_value = ( 'no_satooall_param' => '1' ); }
        }
    }
    my ( @serv_array, @array_for_template );
    if ($serveralis) {
        @serv_array = split( / /, $serveralis );
        my $n  = scalar(@serv_array);
        my $ss = "*.$nameserver";
        shift(@serv_array);
        my $ns = 1;
        @array_for_template;
        @array_for_template =
          map +{ savalue => $_, savalue2 => $aid, savalue3 => $ns++ },
          @serv_array;
        if ( ( $n eq 2 ) && ( $serv_array[1] eq $ss ) ) {
            %templ_value = ( 'temlp_serveralis_all' => '1' );
        }
        else { %templ_value = ( 'notemlp_serveralis_all' => '1' ); }
    }
    else { %templ_value = ( 'noserveralis' => '1' ); }
    $template->param(
        TEMP_SERVERALIAS_ALL => $templ_value{'temlp_serveralis_all'} );
    $template->param(
        NOTEMP_SERVERALIAS_ALL => $templ_value{'notemlp_serveralis_all'} );
    if ( $templ_value{'addsa_found'} ) {
        $template->param( ADDSA_FOUND => 'ServerAlias found, not added' );
    }
    $template->param( ADDSA_NOVAL        => $templ_value{'addsa_noval'} );
    $template->param( SATOOALL_IN_USE    => $templ_value{'satooall_in_use'} );
    $template->param( NOSATOOALL_IN_USE  => $templ_value{'nosatooall_in_use'} );
    $template->param( NO_SATOOALL_IN_USE => $templ_value{'no_satooall_param'} );
    if ( $templ_value{'notemlp_serveralis_all'} ) {
        $template->param( SA8 => \@array_for_template );
    }
    my $oneoffcl = $query->param("oneoffcl");
    if ( defined($oneoffcl) ) {
        my $clvalue = $query->param("clvalue");
        if ( $clvalue eq '1' ) {
            if ($costomlog) { %templ_value = ( 'customlog_in_use' => '1' ); }
            else {
                my $dircl = "/home/$qhost/log/httpd-access.log combined";
                foreach my $vh ( $conf->section('VirtualHost') ) {
                    if ( $vh->directive('ServerName')->value eq $nameserver ) {
                        $vh->add_directive( CustomLog => $dircl );
                    }
                }
                $conf->save;
            }
        }
        elsif ( $clvalue eq '2' ) {
            if ($costomlog) {
                foreach my $vh ( $conf->section('VirtualHost') ) {
                    if ( $vh->directive('ServerName')->value eq $nameserver ) {
                        $vh->directive('CustomLog')->delete;
                    }
                }
                $conf->save;
            }
            else { %templ_value = ( 'no_customlog_in_use' => '1' ); }
        }
        else { %templ_value = ( 'no_clvalue' => '1' ); }
    }
    my $type_cl = $query->param("type_cl");
    if ( defined($type_cl) ) {
        my $typecls = $query->param("typecls");
        if ($costomlog) {
            my $customl_type = $costomlog;
            my ( $file, $typelog ) = split( / /, $customl_type );
            if ( ( $typecls eq '0' ) && ( $typelog eq 'combined' ) ) {
                %templ_value = ( 'typecls_in_use_combined' => '1' );
            }
            elsif ( ( $typecls eq '0' ) && ( $typelog ne 'combined' ) ) {
                my $typecls_value = "$file combined";
                foreach my $vh ( $conf->section('VirtualHost') ) {
                    if ( $vh->directive('ServerName')->value eq $nameserver ) {
                        $vh->directive('CustomLog')->set_value($typecls_value);
                    }
                }
                $conf->save;
            }
            elsif ( ( $typecls eq '1' ) && ( $typelog eq 'common' ) ) {
                %templ_value = ( 'typecls_in_use_common' => '1' );
            }
            elsif ( ( $typecls eq '1' ) && ( $typelog ne 'common' ) ) {
                my $typecls_value = "$file common";
                foreach my $vh ( $conf->section('VirtualHost') ) {
                    if ( $vh->directive('ServerName')->value eq $nameserver ) {
                        $vh->directive('CustomLog')->set_value($typecls_value);
                    }
                }
                $conf->save;
            }
            else { %templ_value = ( 'no_typecls' => '1' ); }
        }
        else { %templ_value = ( 'no_cl' => '1' ); }
    }
    if ($costomlog) {
        $template->param( CLTRUE => '1' );
        my ( $file, $typelog ) = split( / /, $costomlog );
        if ( $typelog eq 'combined' ) {
            $template->param( CLT_CD => '1' );
        }
        elsif ( $typelog eq 'common' ) {
            %templ_value = ( 'customlogtype_cn' => '1' );
        }
        else { %templ_value = ( 'nocustomlogtype' => '1' ); }
    }
    else { %templ_value = ( 'nocustomlog' => '1' ); }
    $template->param( CLT_CN       => $templ_value{'customlogtype_cn'} );
    $template->param( NOCLT        => $templ_value{'nocustomlogtype'} );
    $template->param( NOCLTRUE     => $templ_value{'nocustomlog'} );
    $template->param( CL_IN_USE    => $templ_value{'customlog_in_use'} );
    $template->param( NO_CL_IN_USE => $templ_value{'no_customlog_in_use'} );
    $template->param( NO_CLVALUE   => $templ_value{'no_clvalue'} );
    $template->param(
        TYPE_CL_IN_USE_D => $templ_value{'typecls_in_use_combined'} );
    $template->param(
        TYPE_CL_IN_USE_C => $templ_value{'typecls_in_use_common'} );
    $template->param( NOTYPE_CL    => $templ_value{'no_typecls'} );
    $template->param( NO_CL_IN_USE => $templ_value{'no_cl'} );

    if ($errorlog) {
        %templ_value = ( 'errorlogtrue' => '1' );
    }
    else { %templ_value = ( 'noerrorlog' => '1' ); }
    $template->param( ERRORLOG   => $templ_value{'notemlp_serveralis_all'} );
    $template->param( NOERRORLOG => $templ_value{'notemlp_serveralis_all'} );
    my ( $type_errord, $tttt, $match_index2, @drtvs3 );
    my $error_typeer_edadd;

    sub eett1 {
        my ( $type_errord, $edvalue, $edtvalue ) = @_;
        if ( $type_errord ne '1' ) {
            use Data::Validate::URI qw(is_uri);
            if (   ( !length($edvalue) )
                || ( 65 < length($edvalue) )
                || ( 5 > length($edvalue) )
                || ( !is_uri($edvalue) ) )
            {
                my $error_typedoc2 = "1";
                $error_typedoc = \$error_typedoc2;
                return $error_typedoc;
            }
        }
        if ( ( $type_errord > 0 ) && ( ( 3 == length($edtvalue) ) ) ) {
            my ( $found, $item );
            my @er_array = (
                100, 101, 200, 201, 202, 203, 204, 205, 206, 300,
                301, 302, 303, 304, 305, 400, 401, 402, 403, 404,
                405, 406, 407, 408, 409, 410, 411, 412, 413, 414,
                415, 500, 501, 502, 503, 504, 505
            );
            foreach $item (@er_array) {
                if ( $item eq $edtvalue ) { $found = 1; last; }
            }
            if ( !$found ) {
                my $error_type2 = "1";
                $error_type = \$error_type2;
                return $error_type;
            }
            my $tttt2 = "1";
            $tttt = \$tttt2;
            return $tttt;
        }
    }

    sub eett2 {
        my ( $edtvalue, @drtvs4 ) = @_;
        for my $loopindex ( 0 .. $#drtvs4 ) {
            my ( $key, $value ) = split( / /, $drtvs4[$loopindex] );
            push( @drtvs3, { $key => $value } );
        }
        my ( $match_key, $match_index, $found );
        for my $loopindex ( 0 .. $#drtvs3 ) {
            for my $key2 ( keys %{ $drtvs3[$loopindex] } ) {
                if ( $key2 eq $edtvalue ) {
                    $drtvs3[$loopindex]{$key2};
                    $match_key   = $key2;
                    $match_index = $loopindex;
                    $found       = 1;
                    last;
                }
            }
        }
        print $match_index;
        if ( !$found && $type_errord ne '2' ) {
            my $error_typeer2 = "1";
            $error_typeer = \$error_typeer2;
            return $error_typeer;
        }
        if ( $found && $type_errord eq '2' ) {
            my $error_typeer_edadd2 = "1";
            $error_typeer_edadd = \$error_typeer_edadd2;
            return $error_typeer_edadd;
        }
        $match_index2 = \$match_index;
        return ( @drtvs3, $match_index2 );
    }
    my $eddelete = $query->param("eddelete");
    my $edadd    = $query->param("edadd");
    my $edchange = $query->param("edchange");
    if ( $eddelete || $edchange || $edadd ) {
        my $edtvalue = $query->param("edtvalue");
        my $edvalue  = $query->param("edvalue");

        if ( ( defined($eddelete) ) && (@drtvs4) ) {
            $type_errord = "1";
        }
        elsif ( defined($edadd) ) {
            $type_errord = "2";
        }
        elsif ( ( defined($edchange) ) && (@drtvs4) ) {
            $type_errord = "3";
        }
        else { my $type_errord = "0"; }

        eett1( $type_errord, $edvalue, $edtvalue );
        if (
               defined($$tttt)
            && eett2( $edtvalue, @drtvs4 )
            && (   ( defined($$match_index2) && $type_errord ne '2' )
                || ( !defined($$error_typeer_edadd) && $type_errord eq '2' ) )
          )
        {
            if ( ( $type_errord eq '3' ) && defined($$match_index2) && @drtvs3 )
            {
                $drtvs3[$$match_index2] = { $edtvalue => $edvalue };
            }
            elsif ( ( $type_errord eq '2' ) && !defined($$error_typeer_edadd) )
            {
                my $match_index3;
                if   ( $#drtvs3 >= 0 ) { $match_index3 = $#drtvs3 + 1; }
                else                   { $match_index3 = 0; }
                print "99999 $match_index3 $#drtvs3 ";
                $drtvs3[$match_index3] = { $edtvalue => $edvalue };
            }
            elsif (( $type_errord eq '1' )
                && defined($$match_index2)
                && @drtvs3 )
            {
                delete( @drtvs3[$$match_index2] );
            }
            else { exit; }
            foreach my $vh ( $conf->section('VirtualHost') ) {
                if ( $vh->directive('ServerName')->value eq $nameserver ) {
                    while ( $vh->directive('ErrorDocument') ) {
                        $vh->directive('ErrorDocument')->delete;
                    }
                    for my $loopindex2 ( 0 .. $#drtvs3 ) {
                        for my $key4 ( keys %{ $drtvs3[$loopindex2] } ) {
                            my $value_er       = $drtvs3[$loopindex2]{$key4};
                            my $setvalue_error = "$key4 $value_er";
                            $vh->add_directive(
                                ErrorDocument => $setvalue_error );
                        }

                    }
                }
            }
            $conf->save;
        }
        else {
            $templ_value{'ed_error'} =
                $$error_type         ne '1' ? (0)
              : $$error_type         ne '1' ? (0)
              : $$error_typeer       ne '1' ? (0)
              : $$error_typeer_edadd ne '1' ? (0)
              :                               (1);
        }
    }

    $template->param( ED_ERROR_VALUEDOC => $$error_typedoc );
    $template->param( ED_ERROR_TYPEDOC  => $$error_type );
    $template->param( ED_ERROR_NO_USE   => $$error_typeer );
    $template->param( ED_ERROR_IN_USE   => $$error_typeer_edadd );
    $template->param( ED_ERROR          => $templ_value{'ed_error'} );
    my @arrayedout;
    my @arrayedout2;
    my @er_array = (
        100, 101, 200, 201, 202, 203, 204, 205, 206, 300, 301, 302, 303, 304,
        305, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412,
        413, 414, 415, 500, 501, 502, 503, 504, 505
    );

    if (@drtvs4) {
        for my $loopindex9 ( 0 .. $#drtvs4 ) {
            my ( $key9, $value9 ) = split( / /, $drtvs4[$loopindex9] );
            push( @arrayedout,
                { errort => $key9, erroru => $value9, aid => $aid } );
        }
        for my $loopindex ( 0 .. $#drtvs4 ) {
            my ( $key, $value ) = split( / /, $drtvs4[$loopindex] );
            push @arrayedseen, $key;
        }
        my %seen;
        @seen{@er_array} = ();
        delete @seen{@arrayedseen};
        my @aonly = sort keys %seen;
        if ( @aonly > 0 ) {
            @arrayedout2 = map +{ errortype => $_ }, @aonly;
        }
        else {
            %templ_value = ( 'errortype_limit' => '1' );
        }
    }
    else {
        @arrayedout2 = map +{ errortype => $_ }, @er_array;
    }
    if ( $templ_value{'errortype_limit'} ) {
        $template->param( ERRORTYPELIMIT => $templ_value{'errortype_limit'} );
    }
    else { $template->param( ADDDOCUM => \@arrayedout2 ); }
    $template->param( SA10 => \@arrayedout );

    $template->param( AUTHORIZE => $authorize );
    $template->param( WELCOME   => $welcome );
    $template->param( USERSE    => $$session{'name'} );

вот как это примерно должно быть выглядеть, может catalyst сразу использовать?
Catalyst - The Elegant MVC Web Application Framework - search.cpan.org

но он для сайтов, вроде бы только для сайтов... не понятно



Код:
package Child;
use base qw(Class);
=end
Ïðèìåð äî÷åðíåãî êëàññà.
Òåïåðü ìîæíî ïîâåñåëèòüñÿ è îïèñàòü êàêîé íàäî "êëàññ" â òâî¸ì ïîíèìàíèè.
=cut
sub new {
    +shift->SUPER::new( # âûçûâàþ ìåòîä ïåðäêà - ìåòîä Class::new, íî äëÿ ïîòîìêà Child.
        -properties=>{
            p1=>{
                -default=>1,
                -getter=>'Child::p1_getter' # èëè \&p1_getter
				#ïóñòü âñ¸ áóäåò, êàê òû õî÷åøü
				#sub {
                #    print "Your getter\n";
                #    +${+shift}
                #}
            },
            p2=>{
                -default=>3,
                -destroyer=>'Child::p2_destroyer' # èëè \&p2_destroyer
				#ïóñòü âñ¸ áóäåò, êàê òû õî÷åøü
				#sub {
                #   print "Your destroyer\n";
                #}
            }
        }
    );
}
sub p1_getter {
	#...
}
sub p2_destroyer {
	#...
}
sub run {
    print "Running...\n";
    +shift
}

+1
Код:
#Class.pm
package Property;
BEGIN {*UNTIE=*DESTROY}
# ýòî ÷òîáû ó òåáÿ áûëà âîçìîæíîñòü îòñëåæèâàòü ñîáûòèÿ äëÿ ñâîéñòâ
sub TIESCALAR {
    print "creating layer..\n";
    my$self=\{};
    bless $self, $_[0];
    if(defined $_[1]) {
        $self->STORE($_[1]{-default})             if exists $_[1]{-default};
        $$$self{-getter}=$_[1]{-getter}           if exists $_[1]{-getter};
        $$$self{-setter}=$_[1]{-setter}           if exists $_[1]{-setter};
        $$$self{-destroyer}=$_[1]{-destroyer}     if exists $_[1]{-destroyer};
        $$$self{-aftertie}=$_[1]{-aftertie}       if exists $_[1]{-aftertie};
    }
    $$$self{-aftertie}($self, @_) if exists $$$self{-aftertie};
    +$self
}
sub FETCH     {
    if(exists $${$_[0]}{-getter}) {
        +$${$_[0]}{-getter}(@_)
    } else {
        print "getter called..\n";
        +${+shift}
    }
}
sub STORE     {
    if(exists $${$_[0]}{-setter}) {
        +$${$_[0]}{-setter}(@_)
    } else {
        print "setter called..\n";
        +${+$_[0]}=$_[1]
    }
}
sub DESTROY   {
    if(exists $${$_[0]}{-destroyer}) {
        +$${$_[0]}{-destroyer}(@_)
    } else {
        print "destroyer of worlds..\n";
        +shift
    }
}

package Class;
#îïèñàíèå êëàññà äëÿ ðàçìíîæåíèÿ
sub new {
    my($class, $self)=(shift, {@_});
    foreach(keys %{$self->{-properties}||={}}) { # îïðåäåëÿþ ñâîéñòâà êëàññà-ïîòîìêà, èëè ïåðåäàííûå â ïàðàìåòðàõ
        tie $self->{$_}, Property, $self->{-properties}{$_}; # êàæäîå ñâîñòâî áóäåò èìåòü ñâîè îáðàáîò÷èêè ñîáûòèé
        print $_, "\n";
    }
    delete $self->{-properties};
    +bless $self, $class; # áëàãîñëàâëÿþ ññûëêó íà òâîé ëþáèìûé õýø, äåëÿþ åãî ÷àñòüþ ñåìüè
}

+1
[/HIDE]

Последний раз редактировалось CISCO, 20.11.2008 в 05:38.
CISCO вне форума   Ответить с цитированием
Старый 30.12.2008, 16:29   #67 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

написал сиськи!

отправлю cooller
там почтовик и веб сервер

кто хочет могу дать (но на пенель там еще не похоже)

еще есть ftp, mysql, etc логи с подсчетом (не допилино все это, но работает)

писать одному логику и html и тестиовать шаблон со все м остальным надоидает, потомучто пишешь код и исправляешь по сто раз, в потмо еще html надо искать где-то товарищей


кстате, пришел к выводу что эту программу надо делать в любом случае платную, и не 9$ и не 99$ а больше потому что уважать никто не будет если сделать бесплтаную...
(всмысле условно платну или наоборот, но платную)

Последний раз редактировалось CISCO, 30.12.2008 в 16:49.
CISCO вне форума   Ответить с цитированием
Старый 30.12.2008, 23:59   #68 (permalink)
Злой Админ
 
Аватар для cooler
 
Регистрация: 16.11.1984
Сообщений: 119
Вы сказали Спасибо: 3
Поблагодарили 13 раз(а) в 13 сообщениях
cooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспоримаcooler репутация неоспорима
Отправить сообщение для cooler с помощью ICQ
По умолчанию

Лучше бесплатную, но с возможностью донейта. И раскрутить под гпл2 лицензией. Того гляди и народ в хелп-тимы наберется. Донаты будут кидать.
Кстати в некоторых проджектах (нискажу в каких )народ вообще не работает, только над проджектом и бабло получают с донатов. Причем неплохое..
__________________

Полная подпись
cooler вне форума   Ответить с цитированием
Старый 31.12.2008, 07:17   #69 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

да, понятно, но сейчас еще не готово, то есть надо делать

Цитата:
Сообщение от cooler Посмотреть сообщение
Кстати в некоторых проджектах (нискажу в каких )

а что имено за программа на чем специализируется? и на каком языке?
CISCO вне форума   Ответить с цитированием
Старый 03.01.2009, 21:27   #70 (permalink)
Пользователь
 
Регистрация: 13.05.2008
Сообщений: 72
Вы сказали Спасибо: 3
Поблагодарили 0 раз(а) в 0 сообщениях
CISCO на пути к лучшему
По умолчанию

да. но это если будет написано на все 100%, то использовать скорее всего будут в основном не часные лица, а просто чтобы купить и поставить...

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

есть другие конечно, ISPmeneger, но в СНГ я нигде не видел чтобы на платном хостинге панель для хостинга/серверами/сервисами була бесплатная

а ты заходил на ту вторую ссылку которую я написал? там управление почтой, не все возможности есть которые задуманы, но более менее...
(иногда не работает, я там бывает патчю)
CISCO вне форума   Ответить с цитированием
Ответ