Создание сайта для ОАО усмань табак

Автор: Пользователь скрыл имя, 10 Января 2012 в 22:18, дипломная работа

Описание работы

Бурное развитие информационных технологий и совершенствование компьютерной техники привело к глобальной интеграции их во все сферы человеческой деятельности. Не является исключением и сфера торговли.

В настоящее время очень велико разнообразие товаров и услуг в Internet. Для того, что бы организовать рекламную компанию в Internet, фирме необходимо иметь Web-страницу, где потенциальные клиенты смогли бы ознакомиться с фирмой, и узнать чем она занимается, интересны ли им предложения данной фирмы, задать (через форму обратной связи) интересующие их вопросы и т.д.

Цель данной работы является создание Web-сайта для компании ОАО «Усмань-табак». Необходимостью создания сайта ОАО «Усмань-табак» является, прежде всего, реклама продукции и услуг, которые предлагает данное предприятие. Интерактивная реклама – новый способ предложить товары и услуги потребителю. Интернет же являет собой наиболее динамично развивающуюся среду вещания. За последние пять лет кол-во пользователей сети Internet в России выросло в десятки раз, и на сегодняшний момент достигло 571 миллионов человек.

Скачать полностью (442.04 Кб) Сколько стоит заказать работу?
Работа содержит 1 файл

Диплом усмань-табак.doc

— 1,008.00 Кб (Скачать)

my $access=shift; 
   my(%parent,%pages); 
   my $res=$main::db->prepare("SELECT id, pid, name, title, hide, `left` FROM pages WHERE access<=$access ORDER BY sort DESC"); 
   $res->execute() or die "Error $main::DBI::err \"$main::DBI::errstr\"."; 
   while(my $s=$res->fetchrow_hashref){ 
     # Если для текущего ID уже имеется подуровень создаем для него ссылку 
     $s->{'sub'}=$pages{$s->{id}}->{'sub'} if defined($pages{$s->{id}}); 
     # Записываем ссылку на значения текущего ID 
     $pages{$s->{id}}=$s; 
     # Добавляем ссылку на текущий ID к подуровеню родителя 
     push(@{$pages{$s->{pid}}->{'sub'}},$s) if $s->{id} ne $s->{pid}; 
     # Записываем ID несуществующих родителей 
     $parent{$s->{pid}}=0 unless defined $parent{$s->{pid}}; 
     # Текущий ID может является родителем 
     $parent{$s->{id}}=1; 
   } 
   $res->finish(); 
   my @not_id;# Массив содержащий ID'ы несуществующих родителей 
   foreach my $id (keys %parent){ 
       push(@not_id,$id) unless $parent{$id} 
   } 
   return wantarray?(\%pages,\@not_id):\%pages; 
} 
################################################################################ 
sub main_menu($;$$){ 
    my ($m,$u,$l)=@_; 
    $u=defined($u)?($u+1):0; 
    my $menu=$l?'<ul class="left">':'<ul>'; 
    foreach my $li (@{$m}){ 
        next if ($li->{hide} && $GROUP!=9); 
        $menu.='<li>'; 
        $li->{name}.='<sup>*</sup>' if $li->{hide}==1; 
        if(defined $li->{'sub'} && $u <= $cfg->{menu}->{levels}){ 
            if(LTE_IE6){ 
                $menu.=$u? 
                      "<a href=\"". 
                      $li->{href}."\" title=\"". 
                      $li->{title}."\">". 
                      $li->{name}."<table><tr><td>": 
                      "<a class=\"sub\" href=\"". 
                      $li->{href}."\" title=\"". 
                      $li->{title}."\">". 
                      $li->{name}."<table><tr><td>"; 
            }else{ 
                $menu.="<a class=\"hide\" href=\"". 
                  $li->{href}."\" title=\"". 
                  $li->{title}."\">". 
                  $li->{name}."</a>"; 
            } 
            $menu.=&main_menu($li->{'sub'},$u,$li->{left}); 
            $menu.='</td></tr></table></a>' if LTE_IE6; 
        }else{ 
            $menu.="<a href=\"". 
                  $li->{href}."\" title=\"". 
                  $li->{title}."\">". 
                  $li->{name}."</a>"; 
        } 
        $menu.='</li>'; 
    } 
    $menu.='</ul>'; 
    $menu; 
} 
################################################################################ 
sub menu($$){ 
    my($ps,$uri) = @_; 
    my @link; 
    do{ 
        my $p=$ps->{$furl{$uri}}; 
        my $link='<a href="'.$p->{href}.'" title="'.$p->{title}.'" >'. 
                 $p->{name}.'</a>'; 
        unshift(@link,$link); 
    }while($uri=~s/\/[^\/]+$//); 
    join($cfg->{menu}->{separator},@link); 
} 
################################################################################ 
sub readfile($){ 
    my $file=shift; 
    open(FILE,"$file") or die "Can't read file \"$file\" ($!)."; 
    flock(FILE,1); 
    read(FILE,$file,-s $file); 
    close(FILE); 
    $file; 
} 
################################################################################ 
# Считываем страницы с уровнем доступа $USER_GROUP 
$pages=pages($GROUP); 
# Добавляем ссылки для страниц 
add_href($pages); 
$pages->{0}->{href}='/'; 
$furl{''} =0; 
$furl{'/'}=0; 
# Обрабатываем запрос пользователя 
my $uri=small_liter encode_uri(($ENV{REQUEST_URI}=~/^(.*?)(\?.*)?$/)[0]); 
if(exists($in->{mod})){# Передаем управление модулю 
   my $module=$in->{mod}; 
   $module=~s/[\\\/]//g; 
   do "./module/$module.mod"; 
}else{ 
do "apanel.pl"; 
unless($uri eq '/apanel'){ 
if(exists($furl{$uri})){ 
   my $res=$main::db->prepare("SELECT title,keywords,description,content,sidebar FROM pages WHERE id='$furl{$uri}'"); 
   $res->execute() or die "Error $main::DBI::err \"$main::DBI::errstr\"."; 
   my $s=$res->fetchrow_hashref; 
   $res->finish(); 
   $skinСоздание сайта для ОАО усмань табак       = $s->{title}; 
   $skinдоклады, рефераты, курсовые и дипломные работы, stud24    = $s->{keywords}; 
   $skinБурное развитие информационных технологий и совершенствование компьютерной техники привело к глобальной интеграции их во все сферы человеческой деятельности. Не является исключением и сфера торговли. В настоящее время очень велико разнообразие товаров и услуг в Internet. Для того, что бы организовать рекламную компанию в Internet, фирме необходимо иметь Web-страницу, где потенциальные клиенты смогли бы ознакомиться с фирмой, и узнать чем она занимается, интересны ли им предложения данной фирмы, задать (через форму обратной связи) интересующие их вопросы и т.д. Цель данной работы является создание Web-сайта для компании ОАО «Усмань-табак». Необходимостью создания сайта ОАО «Усмань-табак» является, прежде всего, реклама продукции и услуг, которые предлагает данное предприятие. Интерактивная реклама – новый способ предложить товары и услуги потребителю. Интернет же являет собой наиболее динамично развивающуюся среду вещания. За последние пять лет кол-во пользователей сети Internet в России выросло в десятки раз, и на сегодняшний момент достигло 571 миллионов человек. = $s->{description}; 
   $skin{CONTENT}     = $s->{content}; 
   $skin{SIDEBAR}     = $s->{sidebar}; 
   $skin{MENU}        = menu($pages,$uri); 
}else{print "Нет страницы $uri\n"} 
}} 
# Формируем главное меню 
$skin{MAIN_MENU}=main_menu($pages->{0}->{sub}); 
$skin=readfile('/home/ausman/usmtabak/www/templates/default/index.html'); 
$skin{ELAPSED_TIME}=sprintf("%.4f",(gettimeofday - $START_TIME)); 
$skin=~s/\$([A-Z\-_]+)\$/$skin{$1}/eg; 
print $skin;

 

Листинг   2. Модуль авторизации.

package Logined; 
#################################################################################### 
#  Настройки 
#################################################################################### 
our $Logined_Bot      = exists($::cfg->{login}->{Logined_Bot})?$::cfg->{login}->{Logined_Bot}:'Porter'; 
our $Clean_Login      = exists($::cfg->{login}->{Clean_Login})?$::cfg->{login}->{Clean_Login}:1; 
our $Clean_Login_time = exists($::cfg->{login}->{Clean_Login_time})?$::cfg->{login}->{Clean_Login_time}:60; 
our $Form_User       = exists($::cfg->{login}->{Form_User})?$::cfg->{login}->{Form_User}:'user'; 
our $Form_Pass        = exists($::cfg->{login}->{Form_Pass})?$::cfg->{login}->{Form_Pass}:'pass'; 
our $Form_Action      = exists($::cfg->{login}->{Form_Action})?$::cfg->{login}->{Form_Action}:'action'; 
our $Domain_login     = exists($::cfg->{login}->{Domain_login})?$::cfg->{login}->{Domain_login}:'.'.($ENV{HTTP_HOST}=~/([a-z\d][a-z\d\-]*[a-z\d](\.(com|net|org|pp))?\.\w{2,4})$/)[0]; 
our $Session_id       = exists($::cfg->{login}->{Session_id})?$::cfg->{login}->{Session_id}:'SID'; 
our $IPBlock_count    = exists($::cfg->{login}->{IPBlock_count})?$::cfg->{login}->{IPBlock_count}:5; 
our $IPBlock_timeout  = exists($::cfg->{login}->{IPBlock_timeout})?$::cfg->{login}->{IPBlock_timeout}:10; 
our $UserBlock_count  = exists($::cfg->{login}->{UserBlock_count})?$::cfg->{login}->{UserBlock_count}:12; 
our $UserBlock_timeout= exists($::cfg->{login}->{UserBlock_timeout})?$::cfg->{login}->{UserBlock_timeout}:5; 
our $Session_timeout  = exists($::cfg->{login}->{Session_timeout})?$::cfg->{login}->{Session_timeout}:45; 
our $UserReg_timeout  = exists($::cfg->{login}->{UserReg_timeout})?$::cfg->{login}->{UserReg_timeout}:48; 
our $UserDel_time     = exists($::cfg->{login}->{UserDel_time})?$::cfg->{login}->{UserDel_time}:365; 
our $Block_log        = exists($::cfg->{login}->{Block_log})?$::cfg->{login}->{Block_log}:0; 
our $Log_dir          = exists($::cfg->{login}->{Log_dir})?$::cfg->{login}->{Log_dir}:'./'; 
our $Block_log_file   = exists($::cfg->{login}->{Block_log_file})?$::cfg->{login}->{Block_log_file}:'Block.log'; 
our $SID  = ''; 
our $USER = ''; 
our $in=$::in; 
#################################################################################### 
# Для усложнения подбора паролей (вслучае перехвата хеша MD5) используем соль 
# Чем сложнее и длиннее соль, тем меньше вероятность подбора пароля! 
# Для усложнения соли можно использовать лювые символы \x00-\xff, к примеру 
# управляющие символы. 
# ВНИМАНИЕ!!! Изменение соли приведет к негодности всех паролей!!! 
our $salt = "" x 5; 
#################################################################################### 
 
if($Clean_Login){# Чистка системы при входе (отключать, только если есть такое задание в CRON'е) 
    my $res=$::db->prepare("SELECT etime FROM UserBlock WHERE user='$Logined_Bot [Bot]'"); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($etime)=$res->fetchrow_array(); 
    $res->finish(); 
    if(time()>$etime){ 
      $::db->do("REPLACE UserBlock VALUES ('$Logined_Bot [Bot]',1,UNIX_TIMESTAMP()+($Clean_Login_time*60),'$Logined_Bot [Bot]','Сервисная блокировка.')") 
      or die "Error $::DBI::err \"$::DBI::errstr\"."; 
      # Удаляем просроченные блокировки 
      $::db->do("DELETE FROM IPBlock WHERE UNIX_TIMESTAMP()>etime AND count!=0"); 
      $::db->do("DELETE FROM UserBlock WHERE UNIX_TIMESTAMP()>etime AND count!=0"); 
      # Удаляем пользователей невошедших в систему в течении более $UserReg_timeout часов после регистрации 
      $::db->do("DELETE FROM User WHERE UNIX_TIMESTAMP()>(ctime+($UserReg_timeout*3600)) AND stotal=0 AND user!='admin'") if $UserReg_timeout>0; 
      # Удаляем пользователей невходивших в систему более более $UserDel_time дней 
      $::db->do("DELETE FROM User WHERE UNIX_TIMESTAMP()>(ltime+($UserDel_time*3600*24)) AND stotal!=0 AND user!='admin'") if $UserDel_time>0; 
      # Удаляем просроченные сессии 
      my $res=$::db->prepare("SELECT id,user,addr,ctime,atime FROM Sessions WHERE UNIX_TIMESTAMP()>etime"); 
      $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
      while(my ($id,$user,$addr,$ctime,$atime)=$res->fetchrow_array()){ 
            $::db->do("DELETE FROM Sessions WHERE id='$id'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
            $::db->do("UPDATE User SET laddr='$addr',ltime=$atime,stime=(stime+$atime-$ctime+10) WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
            } 
      $res->finish(); 
      } 
    } 
 
 
######################################## 
# Функция форматированного вывода времени 
# Если есть &main::lb::ftime используем ее 
sub ftime($;$){ 
    my($f,$t)=@_; 
    $t=$t?$t:time(); 
    if(exists(&main::lib::ftime)){&main::lib::ftime($f,$t)} 
    else{scalar localtime($t)} 
    } 
######################################## 
# Генерация идентификатора 
# Использование: $идентификатор=genUID; или $идентификатор=genUID($длина); 
# ,где $длина - это количество символов в идентификаторе 
# (по умолчанию $длина равна 32) 
# Количество вариантов идентификатора = 62^$длина 
sub genUID(;$){ 
    my $len=shift; 
    $len=32 unless $len; 
    my(@l)=('a'..'z','A'..'Z',0..9); 
    $len=abs($len);$len--;$len=$#l if $len>$#l; 
    my $uid=''; 
    for(0..$len){$uid.=$l[int(rand($#l+1))]} 
    $uid; 
    } 
######################################## 
# Экранируем апостров и обратный слешь 
sub esc_txt($){ 
    my $v=shift; 
    $v=~s/[\\\']/\\$1/g; 
    $v; 
    } 
######################################## 
# Протоколируем блокировку 
sub block_log($$$$){ 
    my($user,$blocked,$text,$time)=@_; 
    if($Block_log){ 
       open(LOG,">>".$Log_dir.$Block_log_file) 
      or die "Can't write LOG file \"".$Log_dir.$Block_log_file."\" ($!)."; 
       flock(LOG,2); 
       if($time==0){ 
            print LOG ftime("!d!.!MM!.'!yy! !c!:!mm!")."\t\"$user\", разблокирован \"$blocked\" ($text).\n" 
            }elsif($time<0){ 
           print LOG ftime("!d!.!MM!.'!yy! !c!:!mm!")."\t\"$user\", заблокирован \"$blocked\" навсегда ($text).\n" 
            }else{ 
            print LOG ftime("!d!.!MM!.'!yy! !c!:!mm!")."\t\"$user\", заблокирован \"$blocked\" на $time мин. ($text).\n" 
           } 
       close(LOG); 
       } 
    } 
######################################## 
# Блокировка пользователя 
# user_block($пользователь,$кто_блокирует,$причина_блокировки[,$время_блокировки]), где 
# $время_блокировки - время в секундах на которе блокируется пользователь, при этом, если 
# $время_блокировки == 0 или не указано, то с пользователя снимается блокировка, а если 
# $время_блокировки < 0, то пользователь блокируется навсегда 
sub user_block($$$;$){ 
    my($user,$blocked,$text,$time)=map {esc_txt($_)} @_; 
    $time=$time?$time:0; 
    my $user_count=$time<0?0:$UserBlock_count; 
    $time=0 if $time<0; 
    my $query="REPLACE UserBlock VALUES ('$user',$user_count,UNIX_TIMESTAMP()+($time*60),'$blocked','$text')"; 
    $::db->do($query) or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    ($user,$blocked,$text,$time)=map {$_=~s/\\([\\\'])/$1/ge;$_} ($user,$blocked,$text,$time); 
    block_log($user,$blocked,$text,$time); 
    exit_user($user); 
    } 
######################################## 
# Блокировка IP 
# ip_block($ip,$кто_блокирует,$причина_блокировки[,$время_блокировки]), где 
# $время_блокировки - время в секундах на которе блокируется IP, при этом, если 
# $время_блокировки == 0 или не указано, то с IP снимается блокировка, а если 
# $время_блокировки < 0, то IP блокируется навсегда 
sub ip_block($$$;$){ 
    my($ip,$blocked,$text,$time)=map {esc_txt($_)} @_; 
    $time=$time?$time:0; 
    my $addr_count=$time<0?0:$IPBlock_count; 
    $time=0 if $time<0; 
    my $query="REPLACE IPBlock VALUES ('$ip',$addr_count,UNIX_TIMESTAMP()+($time*60),'$blocked','$text')"; 
    $::db->do($query) or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    ($ip,$blocked,$text,$time)=map {$_=~s/\\([\\\'])/$1/ge;$_} ($ip,$blocked,$text,$time); 
    block_log($ip,$blocked,$text,$time); 
    exit_ip($ip); 
    } 
######################################## 
# Возвращаем имя пользователя по идентификатору сессии 
# $user=this_session($sid); 
sub this_session($){ 
    my $id=esc_txt shift; 
    my $res=$::db->prepare("SELECT user FROM Sessions WHERE id='$id' AND addr='$ENV{REMOTE_ADDR}' AND UNIX_TIMESTAMP()<=etime"); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my $user=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined $user){ 
       $::db->do("UPDATE Sessions SET atime=UNIX_TIMESTAMP(),etime=UNIX_TIMESTAMP()+($Session_timeout*60)") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       return $user 
       }else{return ''} 
    } 
######################################## 
# Проверка пользователя на существование 
sub exists_user($){ 
    my $user= esc_txt shift; 
    my $res=$::db->prepare("SELECT user FROM User Where user='$user'"); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    $user=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined $user){return 1} 
    else{return ''} 
    } 
######################################## 
# Регистрация пользователя 
sub reg_user($$;%){ 
    my $user = shift; 
    my $pass = esc_txt shift; 
    my(%param)=map {$_=~s/\t/    /g;esc_txt($_)} @_; 
    my $param=join("\t",(%param)); 
    if(exists_user($user)){ 
           if(wantarray){return ('',"Пользователь \"$user\" уже существует")} 
           else{return ''} 
       }else{ 
           $user = esc_txt $user; 
           if($::db->do("INSERT INTO User VALUES ('$user',MD5('$pass'),UNIX_TIMESTAMP(),0,0,0,'','$param')")){ 
               $user=~s/\\([\\\'])/$1/ge; 
               user_block($user,'$Logined_Bot [Bot]','Регистрация нового пользователя.'); 
               if(wantarray){return (1,"Пользователь \"$user\" зарегистрирован успешно!")} 
               else{return 1} 
           }else{ 
               if(wantarray){return ('',"Error $::DBI::err \"$::DBI::errstr\".")} 
               else{return ''} 
           } 
       } 
    } 
######################################## 
# Меняем пароль пользователя 
# new_pass($user,$пароль[,$старый_пароль]); 
# Если $старый_пароль указан не верно, возращает ложь. 
sub new_pass($$;$){ 
    my $user  = esc_txt shift; 
    my $npass = esc_txt shift; 
    my $pass  = esc_txt shift; 
    if($pass){ 
        my $res=$::db->prepare("SELECT pass FROM User WHERE user='$user' AND pass=MD5('$pass')"); 
        $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
        my($user_pass)=$res->fetchrow_array(); 
        $res->finish(); 
        if(defined($user_pass)){ 
          $::db->do("UPDATE User SET pass=MD5('$pass') WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
           1}else{''} 
    }else{ 
        $::db->do("UPDATE User SET pass=MD5('$pass') WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
        1} 
} 
 
######################################## 
# Читаем или записываем информацию о пользователе 
# Чтобы читать информацию о пользователе, используем %param=user_param($user); 
# Чтобы записать параметры пользователя (Зарезервированные имена хеша обновлению не подлежат) 
#     user_param($user,$new_param); 
# Зарезервированные имена хеша: 
#  MD5_PASSWORD - зашифрованный пароль пользователя 
#  REGISTRATION_TIME - Время регистрации пользователя 
#  AMOUNT_LOGINED - Количество заходов в систему 
#  CONDUCTED_TIME - Проведено времени 
#  LAST_LOGINED_TIME - Время последнего входа в систему 
#  LAST_LOGINED_ADDR - IP адрес с которого последний раз входили в систему 
sub user_param($;%){ 
    if($#_==0){ 
        my $user = esc_txt shift; 
        my $res=$::db->prepare("SELECT pass,ctime,stotal,stime,ltime,laddr,param FROM User Where user='$user'"); 
        $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
        my($pass,$ctime,$stotal,$stime,$ltime,$laddr,$param)=map {$_=~s/\\([\\\'])/$1/ge;$_;} $res->fetchrow_array(); 
        $res->finish(); 
        my %param=split(/\t/,$param); 
        $param{MD5_PASSWORD}=$pass; 
        $param{REGISTRATION_TIME}=$ctime; 
        $param{AMOUNT_LOGINED}=$stotal; 
        $param{CONDUCTED_TIME}=$stime; 
        $param{LAST_LOGINED_TIME}=$ltime; 
        $param{LAST_LOGINED_ADDR}=$laddr; 
        %param; 
    }else{ 
        my $user = esc_txt shift; 
        my(%param)=map {$_=~s/\t/    /g;esc_txt($_)} @_; 
        delete $param{MD5_PASSWORD}; 
        delete $param{REGISTRATION_TIME}; 
        delete $param{AMOUNT_LOGINED}; 
        delete $param{CONDUCTED_TIME}; 
        delete $param{LAST_LOGINED_TIME}; 
        delete $param{LAST_LOGINED_ADDR}; 
        my $param=join("\t",(%param)); 
        $::db->do("UPDATE User SET param='$param' WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
        } 
    } 
######################################## 
# Читаем группы 
sub get_group(){ 
    my $group; 
    my $res=$::db->prepare("SELECT * FROM `Group`"); 
   $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    while(my $h=$res->fetchrow_hashref()){ 
       foreach my $u (split(/\s+/,$h->{users})){ 
           if($h->{gid}>$group->{$u}->{id}){ 
               $group->{$u}->{id}=$h->{gid}; 
               $group->{$u}->{name}=$h->{name}; 
           } 
       } 
    } 
    $res->finish(); 
    $group; 
} 
######################################## 
# Создаем сессию пользователя 
# ($sid,$login_or_error_text)=new_session($user,$pass); 
# При неудачном входе $sid пуста, а $login_or_error_text содержит информацию о ошибке 
# $sid=new_session($user,$pass); 
# При неудачном входе $sid пуста 
sub new_session($$){ 
    my($user,$pass)=@_; 
    # Защищаемся от внешних воздействий 
    $user=esc_txt($user); 
    my $qBaddr="SELECT etime,count,blocked,reason FROM IPBlock WHERE addr='$ENV{REMOTE_ADDR}' AND UNIX_TIMESTAMP()<etime"; 
    my $qBuser="SELECT etime,count,blocked,reason FROM UserBlock WHERE user='$user' AND UNIX_TIMESTAMP()<etime"; 
    my $res=$::db->prepare($qBaddr); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($addr_etime,$addr_count,$addr_blocked,$addr_reason)=$res->fetchrow_array(); 
    $res->finish(); 
    $res=$::db->prepare($qBuser); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($user_etime,$user_count,$user_blocked,$user_reason)=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined($addr_etime) && ($addr_count==0||$addr_count>=$IPBlock_count)){ 
        # Не можем создать новую сессию, т.к. IP заблокирован 
        $addr_blocked=~s/\s+\[Bot\]$/<sup>\[Bot\]<\/sup>/; 
        if(wantarray){('',!$addr_count?"Ваш IP навсегда заблокировал <b>$addr_blocked</b> ($addr_reason).":"Ваш IP заблокировал <b>$addr_blocked</b>, до ". ftime("!d!.!MM!.'!yy! !c!:!mm!",$addr_etime)." ($addr_reason).")} 
        else{''} 
    }elsif(defined($user_etime) && ($user_count==0||$user_count>=$UserBlock_count)){ 
        # Не можем создать новую сессию, т.к. Пользователь заблокирован 
        $user_blocked=~s/\s+\[Bot\]$/<sup>\[Bot\]<\/sup>/; 
        if(wantarray){('',!$user_count?"Пользователь, <b>$user</b>, навсегда заблокирован <b>$user_blocked</b> ($user_reason).":"Пользователя, <b>$user</b>, заблокировал <b>$user_blocked</b>, до ".ftime("!d!.!MM!.'!yy! !c!:!mm!",$addr_etime)." ($user_reason).")} 
        else{''} 
    }else{ 
        # Блокировок нет 
        my $query="SELECT pass FROM User WHERE user='$user' AND pass=MD5('$pass')"; 
        $res=$::db->prepare($query); 
        $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
        my($user_pass)=$res->fetchrow_array(); 
        $res->finish(); 
        if(defined($user_pass)){ 
              # Создаем новую сессию, Вход успешен!!! 
              $query="SELECT id,addr FROM Sessions WHERE user='$user' AND UNIX_TIMESTAMP()<=etime"; 
              $res=$::db->prepare($query); 
              $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
              my($sid,$addr)=$res->fetchrow_array(); 
              $res->finish(); 
              if($addr eq $ENV{REMOTE_ADDR}){ 
                  # Пользователь уже в системе, обновляем сессию 
                  $::db->do("UPDATE Sessions SET id='$sid',etime=UNIX_TIMESTAMP()+($Session_timeout*60),atime=UNIX_TIMESTAMP()"); 
                  die "UserUpdate session is stoped.\nError $::DBI::err \"$::DBI::errstr\"." if defined($::DBI::err); 
              }else{ # создаем новую сессию для пользователя 
                  # Если имеется сессия на другом компьютере выходим из нее 
                  exit_session($sid) if defined($sid); 
                  my $i=0; 
                  do{# Генерируем идентификатор сессии 
                     $sid=genUID; 
                     $i++; 
                     }until($::db->do("INSERT INTO Sessions VALUES('$sid','$user','$ENV{REMOTE_ADDR}',UNIX_TIMESTAMP()+($Session_timeout*60),UNIX_TIMESTAMP(),UNIX_TIMESTAMP());") || $i>=10); 
                  die "UserIdentifier selection is stopped on $i attempt.\nError $::DBI::err \"$::DBI::errstr\"." if defined($::DBI::err); 
                  # Обновляем информацию о количистве заходов 
                  $::db->do("UPDATE User SET stotal=(stotal+1) WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
                  } 
              if(wantarray){($sid,'')} 
              else{$sid} 
        }else{ # Пароль неподошел, или пользователь несуществует 
              my $query="SELECT pass FROM User WHERE user='$user'"; 
              $res=$::db->prepare($query); 
              $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
              my($user_pass)=$res->fetchrow_array(); 
              $res->finish(); 
              if(!defined($user_pass)){# Пользователь несуществует 
                  if(wantarray){('',"Пользователь [<b>$user</b>] не существует")} 
                  else{''} 
              }else{ # Пароль неподошел, протоколируем попытку входа. 
                  my $val="Неправильный пароль."; 
                  $val.="<br />Попытка взлома запротоколирована" if (defined($user_etime) || defined($addr_etime)); 
                  $user_count++; 
                  $addr_count++; 
                  $query="REPLACE UserBlock VALUES ('$user',$user_count,UNIX_TIMESTAMP()+($UserBlock_timeout*60),'$Logined_Bot [Bot]','Попытка подбора пароля к логину.')"; 
                  $::db->do($query) or die "Error $::DBI::err \"$::DBI::errstr\"."; 
                  block_log($user,'$Logined_Bot [Bot]','Попытка подбора пароля',$UserBlock_timeout) if $user_count>=$UserBlock_count; 
                  $query="REPLACE IPBlock VALUES ('$ENV{REMOTE_ADDR}',$addr_count,UNIX_TIMESTAMP()+($IPBlock_timeout*60),'$Logined_Bot [Bot]','Попытка подбора пароля.')"; 
                  $::db->do($query) or die "Error $::DBI::err \"$::DBI::errstr\"."; 
                  block_log($ENV{REMOTE_ADDR},'$Logined_Bot [Bot]','Попытка подбора пароля',$IPBlock_timeout) if $addr_count>=$IPBlock_count; 
                  if(wantarray){('',$val)} 
                  else{''} 
              } 
        } 
    } 
  } 
######################################## 
# Завершаем сессию по пользователю 
# exit_user($user); 
sub exit_user($){ 
    my $user=esc_txt shift; 
    my $query="SELECT id,addr,ctime,atime FROM Sessions WHERE user='$user'"; 
    my $res=$::db->prepare($query); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($id,$addr,$ctime,$atime)=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined($id)){ 
       $::db->do("DELETE FROM Sessions WHERE id='$id'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       $::db->do("UPDATE User SET laddr='$addr',ltime=$atime,stime=(stime+$atime-$ctime+10) WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       } 
    } 
######################################## 
# Завершаем сессию по IP 
# exit_user($user); 
sub exit_ip($){ 
    my $addr=esc_txt shift; 
    my $query="SELECT user,id,ctime,atime FROM Sessions WHERE addr='$addr'"; 
    my $res=$::db->prepare($query); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($user,$id,$ctime,$atime)=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined($user)){ 
       $::db->do("DELETE FROM Sessions WHERE id='$id'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       $::db->do("UPDATE User SET laddr='$addr',ltime=$atime,stime=(stime+$atime-$ctime+10) WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       } 
    } 
######################################## 
# Завершаем сессию 
# exit_session($sid); 
sub exit_session($){ 
    my $id=esc_txt shift; 
    my $query="SELECT user,addr,ctime,atime FROM Sessions WHERE id='$id'"; 
    my $res=$::db->prepare($query); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    my($user,$addr,$ctime,$atime)=$res->fetchrow_array(); 
    $res->finish(); 
    if(defined($user)){ 
       $::db->do("DELETE FROM Sessions WHERE id='$id'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       $::db->do("UPDATE User SET laddr='$addr',ltime=$atime,stime=(stime+$atime-$ctime+10) WHERE user='$user'") or die "Error $::DBI::err \"$::DBI::errstr\"."; 
       } 
    } 
######################################## 
# Время через N минут, в GMT формате 
sub expires_time(;$){ 
    my $t=shift; 
    $t=$t?$t:0; 
    $t*=60; 
    $t+=time(); 
    my @t=gmtime($t); 
    my @wday=qw 'Sun Mon Tue Wed Thu Fri Sat'; 
    my @month=qw 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec'; 
    $t[5]+=1900; 
    ($t[0],$t[1],$t[2],$t[3])=map {$_<10?"0$_":$_} ($t[0],$t[1],$t[2],$t[3]); 
    "$wday[$t[6]], $t[3]-$month[$t[4]]-$t[5] $t[2]:$t[1]:$t[0] GMT" 
    } 
######################################## 
# Обновляем Cookie 
sub cookie_up($){ 
    my $sid=shift; 
    print "Set-Cookie: $Session_id=$sid; domain=$Domain_login; path=/; expires=".expires_time($Session_timeout)."\n" 
    } 
######################################## 
# Удаляем Cookie 
sub cookie_del(){ 
    print "Set-Cookie: $Session_id=; domain=$Domain_login; path=/; expires=".expires_time(-1440)."\n" 
    } 
######################################## 
# Читаем SID из Cookies 
sub sid_cookie(){ 
    my $sid=''; 
    foreach my $cookies (split(/;\s+/,$ENV{HTTP_COOKIE})){ 
        my($name,$value)=map {$_=~s/\%([\dA-F]{2})/pack('C',hex($1))/eg;$_} split(/=/,$cookies); 
        $sid=$value if $Session_id eq $name; 
        } 
    $sid; 
    } 
######################################## 
# Страничка перезагрузки 
sub page_refresh($;$){ 
    my($user,$a)=@_; 
    $a=$a?$a:'Login'; 
    my $referer=$ENV{HTTP_REFERER}; 
    print "Content-Type: text/html\n\n"; 
    print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">\n". 
          "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n". 
          "<head>\n". 
          "<title>Web $a [$user]</title>\n". 
          "<meta http-equiv=\"refresh\" content=\"0; url=$referer\" />\n". 
          "</head>\n". 
          "<body>\n". 
          "<div style=\"text-align: center;\">\n". 
          "<h3>Web $a [$user]</h3>\n". 
         "<br />\n". 
          "Please click <a href=\"$referer\">here</a> to proceed...\n". 
          "</div>\n". 
          "</body>\n". 
          "</html>"; 
    exit; 
    } 
######################################## 
# Значение формы exit 
sub exit_value(;$){ 
    my $id=shift; 
    $id=$id?$id:$SID; 
    my $p=ord($id)-48; 
    while($p>30){$p-=31} 
    $id=crypt($id,substr($id,$p,2)); 
    $id=~s/[^\w\d]//g; 
    $id; 
    } 
######################################## 
# Web Login 
sub web_login(){ 
    my $val=''; 
    my $sid=sid_cookie(); 
    my $user=$sid?this_session($sid):''; 
    my %in=(); 
        $in{user}   = $in->{$Form_User}; 
        $in{pass}   = $in->{$Form_Pass}; 
        $in{action} = $in->{$Form_Action}; 
        $in{exit}   = $in->{exit}; 
    if($user && exists $in{exit} && exit_value($sid) eq $in{exit}){exit_session($sid);cookie_del;page_refresh($user,'Exit');} 
    elsif($user){cookie_up($sid);$SID=$sid;$USER=$user;($user,'')} 
    elsif($in{action} eq 'login' && $in{user} && $in{pass}){ 
        ($sid,$val)=new_session($in{user},$in{pass}); 
        if($sid){cookie_up($sid);page_refresh($in{user});} 
        ('',$val)} 
    else{('','')} 
    } 
1;

 

Листинг 3. Библиотека процедур ‘mylib.pl’.

#!/usr/bin/perl 
use strict; 
use locale; use POSIX qw(locale_h); setlocale(LC_CTYPE,"ru_RU.CP1251"); 
use CGI qw(escapeHTML); 
 
use Data::Dumper; 
#### 
use DBI; # Модуль для работы с БД 
 
# Глобальные переменные 
our %skin=(); 
our($cfg,$db,$skin,$pages,%furl); 
$cfg={ 
################################################## 
# Настройка SQL 
######################################## 
sql=>{ 
      type => 'mysql',                   # Тип БД 
      name => 'ausman_tabak',           # Имя БД 
      host => 'localhost',               # Хост БД 
      user => 'ausman_tabak',            # Имя пользователя для доступа к БД 
      pass => 'Yyh3x0e0',                # Пароль для доступа к БД 
}, 
################################################## 
# Настройка меню 
######################################## 
menu=>{ 
      levels    => 4,                   # Число вложений в главном меню 
      separator => ' &#x2192; ',        # Разделитель в дополнительном меню 
                                       # к примеру &#x2192; &#x25ba; 
}, 
################################################## 
}; 
# Подключаемся к БД 
$db=DBI->connect('DBI:'.$cfg->{sql}->{type}.':'.$cfg->{sql}->{name}.':'.$cfg->{sql}->{host},$cfg->{sql}->{user},$cfg->{sql}->{pass}); 
die "Can't connect DBI:".$cfg->{sql}->{type}.':'.$cfg->{sql}->{name}.':'.$cfg->{sql}->{host}.".\nError $DBI::err \"$DBI::errstr\"." unless $db; 
$db->do("SET NAMES cp1251"); 
################################################################################ 
# Обявляем глобальные переменные 
our $in={};     # Анонимный хешь данных форм 
our $CONTENT=0; # Печатали или нет 'Content-Type' 
################################################################################ 
# Считываем данные форм 
{# Обрабатываем формы. 
sub urlencode($){ 
    my $val=shift; 
    $val=~s/([=\+\&\%\/\\\|\0-\x1f\x80-\xff])/sprintf("%%%02X",unpack('C',$1))/eg; 
    $val=~tr/ /\+/; 
    $val; 
} 
 
sub urldecode($){ 
    my $val=shift; 
    $val=~tr/\+/ /; 
    $val=~s/%([\dA-F]{2})/pack('C',hex($1))/eg; 
    $val; 
} 
 
sub query2in($){ 
    my $query=shift; 
    foreach my $pair (split(/&/,$query)){ 
        my($n,$v)=map {urldecode($_)} split(/=/,$pair); 
        if(defined $in->{$n}){ 
           if(ref $in->{$n} eq 'ARRAY'){push(@{$in->{$n}},$v)} 
           else{$in->{$n}=[$in->{$n},$v]} 
        }else{$in->{$n}=$v} 
    } 
} 
query2in($ENV{'QUERY_STRING'}); 
    if ($ENV{REQUEST_METHOD} eq 'POST' && $ENV{CONTENT_TYPE} eq 'application/x-www-form-urlencoded'){ 
        seek(STDIN,0,0); 
        read(STDIN,my $buffer,$ENV{'CONTENT_LENGTH'}); 
        seek(STDIN,0,0); 
        query2in($buffer); 
    } 
} 
################################################################################ 
# Печатаем 'Content-Type' 
sub content(;$){ 
    my $content=shift; 
    $content=$content?$content:'text/html'; 
    unless($CONTENT){ 
        $CONTENT++; 
        print "Cache-Control: no-cache, max-age=0\n"; 
        print "Content-Type: $content\n\n"; 
    } 
} 
################################################################################ 
# Считываем файл полностью 
sub readfile($){ 
    my $file=shift; 
    open(FILE,"$file") or die "Can't read file \"$file\" ($!)."; 
    flock(FILE,1); 
    read(FILE,$file,-s $file); 
    close(FILE); 
    $file; 
} 
################################################################################ 
# Считываем файл конфигурации 
sub readcfg($){ 
    my $file=shift; 
    do $file.'.conf'; 
} 
################################################################################ 
# Записываем файл конфигурации 
sub writecfg($$){ 
    my $file=shift; 
    my $cfg=shift; 
    if(open(FILE,">$file.conf")){ 
        flock(FILE,2); 
        print FILE "my "; 
        print FILE Dumper($cfg); 
        close(FILE); 
        return 1; 
    }else{return 0;} 
} 
######################################## 
# Экранируем апостров и обратный слешь 
sub esc_sql($){ 
    my $v=shift; 
    $v=~s/[\\\']/\\$1/g; 
    $v; 
    } 
################################################################################ 
# Удаляем страницу со всеми подстраницами 
sub del_page($){ 
    my $id=esc_sql shift; 
    my $res=$::db->prepare("SELECT id FROM pages WHERE pid='$id'"); 
    $res->execute() or die "Error $::DBI::err \"$::DBI::errstr\"."; 
    while(my $chid=$res->fetchrow_array){&del_page($chid)} 
    $main::db->do("DELETE FROM pages WHERE id='$id'"); 
    } 
################################################################################ 
# Считываем подуровни раздела 
sub sub_page($){ 
    my $id=esc_sql shift; 
    my $res=$::db->prepare("SELECT id,name,title FROM pages WHERE pid='$id' ORDER BY sort DESC"); 
    $res->execute() or die "Error $main::DBI::err \"$main::DBI::errstr\"."; 
    my @child; 
    while(my $child=$res->fetchrow_hashref){ 
        push(@child,$child) unless $child->{id}==0; 
    } 
    @child; 
} 
################################################################################ 
# Перемещаем страницу 
sub move_page($$;$){ 
    my($pid,$newpid,$p)=map {esc_sql($_)} @_; 
    $p=$p?'p':''; 
    $main::db->do("UPDATE pages SET pid='$newpid' WHERE ${p}id='$pid'"); 
    } 
################################################################################ 
sub get_pages($){# Считываем структуру страниц 
   my $access=esc_sql shift; 
   my(%parent,%pages); 
   my $res=$main::db->prepare("SELECT id,pid,name,title,hide,`left` FROM pages WHERE access<=$access ORDER BY sort DESC"); 
   $res->execute() or die "Error $main::DBI::err \"$main::DBI::errstr\"."; 
   while(my $s=$res->fetchrow_hashref){ 
     # Если для текущего ID уже имеется подуровень создаем для него ссылку 
     $s->{'sub'}=$pages{$s->{id}}->{'sub'} if defined($pages{$s->{id}}); 
     # Записываем ссылку на значения текущего ID 
     $pages{$s->{id}}=$s; 
     # Добавляем ссылку на текущий ID к подуровеню родителя 
     push(@{$pages{$s->{pid}}->{'sub'}},$s) if $s->{id} ne $s->{pid}; 
     # Записываем ID несуществующих родителей 
     $parent{$s->{pid}}=0 unless defined $parent{$s->{pid}}; 
     # Текущий ID может являться родителем 
     $parent{$s->{id}}=1; 
   } 
   $res->finish(); 
   my @not_id;# Массив содержащий ID'ы несуществующих родителей 
   foreach my $id (keys %parent){ 
       push(@not_id,$id) unless $parent{$id} 
   } 
   return wantarray?(\%pages,\@not_id):\%pages; 
} 
################################################################################ 
# Создаем дерево страниц для select'а 
sub s_razdel($;$){ 
    my ($m,$c)=@_; 
    $c=defined($c)?$c:''; 
    my $menu=''; 
    for my $i (0..$#{$m}){ 
        my $li=$m->[$i]; 
        $menu.='<option value="'.$li->{'id'}.'" >'; 
        $menu.=$c; 
        $menu.=$i==$#{$m}?'&#x2514;':'&#x251c;'; 
        my $hide=$li->{hide}?' &#x25a0;':''; 
        if(defined $li->{'sub'}){ 
            $menu.='&#x252c; '.$li->{name}.$hide.'</option>'; 
            $menu.=&s_razdel($li->{'sub'},($i==$#{$m}?$c.'&nbsp;&nbsp;&nbsp;':$c.'&#x2502;')); 
        }else{ 
            $menu.='&#x2500; '.$li->{name}.$hide.'</option>'; 
        } 
    } 
    $menu; 
} 
################################################################################ 
# Создаем дерево страниц для select'а с оринтацией 
sub so_razdel($;$){ 
    my ($m,$c)=@_; 
    $c=defined($c)?$c:''; 
    my $menu=''; 
    for my $i (0..$#{$m}){ 
        my $li=$m->[$i]; 
        $menu.='<option value="'.$li->{'id'}.'" >'; 
        $menu.=$c; 
        $menu.=$i==$#{$m}?'&#x2514;':'&#x251c;'; 
        my $left=$li->{left}?' &#x2190;':' &#x2192;'; 
        if(defined $li->{'sub'}){ 
            $menu.='&#x252c; '.$li->{name}.$left.'</option>'; 
            $menu.=&so_razdel($li->{'sub'},($i==$#{$m}?$c.'&nbsp;&nbsp;&nbsp;':$c.'&#x2502;')); 
        }else{ 
            $menu.='&#x2500; '.$li->{name}.$left.'</option>'; 
        } 
   } 
    $menu; 
} 
################################################################################ 
1; # Сообщение об успешной загрузке (не удалять) 

Листинг   4. Администраторская панель.

#!/usr/bin/perl 
#use strict; 
my $print=''; 
my $title=''; 
my $head=''; 
my $sidebar=''; 
my $amenu=[]; 
if($::GROUP==9){ 
if($in->{a} eq 'add_apage'){ 
  $title= "Добавление страницы"; 
  if(exists($in->{r}) && exists($in->{name})){ 
           my($pid,$name,$title,$key,$desc,$cont)=map {&::esc_sql($_)} ( 
              $in->{r},$in->{name},$in->{title},$in->{keywords},$in->{description}, 
              $in->{content}); 
           if($main::db->do("INSERT INTO apages SET pid='$pid',name='$name',title='$title',keywords='$key',description='$desc',content='$cont'")){ 
               $print.= "<h3>Страница успешно добавлена</h3><br />". 
                     "<h4>Не забудте ее опубликовать (разел <a href='?a=public_apage'>Страницы-Отображение</a>)</h4>"; 
           }else{ 
               $print.= "<h3>Ошибка добавления</h3><br />"; 
               $print.= "<p>Error $main::DBI::err \"$main::DBI::errstr\".</p>"; 
           } 
  }else{ 
    $head.= '<script type="text/javascript" src="/js/ckeditor/ckeditor.js"></script>'; 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Родительский раздел:</td>"; 
    $print.= "<td><select name='r' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
    $print.= s_razdel($apages->{0}->{sub}); 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Краткое имя (для меню):</td><td><input name='name' /></td></tr>"; 
    $print.= "<tr><td>Заголовок страницы:</td><td><input name='title' /></td></tr>"; 
    $print.= "<tr><td>Ключевые слова:</td><td><textarea name='keywords'></textarea></td></tr>"; 
    $print.= "<tr><td>Описание:</td><td><textarea name='description'></textarea></td></tr>"; 
    $print.= "<tr><td>Наполнение:</td><td><textarea name='content' id='editor' ></textarea></td></tr>"; 
    $print.= "<script type=\"text/javascript\">\n". 
          "CKEDITOR.replace( 'editor',{filebrowserBrowseUrl : '/js/imglib/index.html?path=/'});\n". 
          "</script>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Сохранить' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'edit_apage'){ 
  $title="Редактирование страницы"; 
  if(exists($in->{id}) && exists($in->{name})){ 
           my($id,$name,$title,$key,$desc,$cont)=map {esc_sql($_)} ( 
              $in->{id},$in->{name},$in->{title},$in->{keywords},$in->{description}, 
              $in->{content}); 
           if($main::db->do("UPDATE apages SET name='$name',title='$title',keywords='$key',description='$desc',content='$cont' WHERE id='$id'")){ 
               $print.= "<h3>Страница успешно обновлена</h3>"; 
           }else{ 
               $print.= "<h3>Ошибка обновлеия</h3>"; 
               $print.= "<p>Error $main::DBI::err \"$main::DBI::errstr\".</p>"; 
           } 
  }elsif(exists($in->{id})){ 
    my $id=esc_sql($in->{id}); 
    my $res=$main::db->prepare("SELECT name,title,keywords,description,content FROM apages WHERE id='$id'"); 
    $res->execute() or die "Error $main::DBI::err \"$main::DBI::errstr\"."; 
    my($name,$title,$keywords,$description,$content)=map {escapeHTML($_)} $res->fetchrow_array; 
    $head.= '<script type="text/javascript" src="/js/ckeditor/ckeditor.js"></script>'; 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<input type='hidden' name='id' value='$in->{id}' /><table>"; 
    $print.= "<tr><td>Краткое имя (для меню):</td><td><input name='name' value='$name' /></td></tr>"; 
    $print.= "<tr><td>Заголовок страницы:</td><td><input name='title' value='$title' /></td></tr>"; 
    $print.= "<tr><td>Ключевые слова:</td><td><textarea name='keywords'>$keywords</textarea></td></tr>"; 
    $print.= "<tr><td>Описание:</td><td><textarea name='description'>$description</textarea></td></tr>"; 
    $print.= "<tr><td>Наполнение:</td><td><textarea name='content' id='editor' >$content</textarea></td></tr>"; 
    $print.= "<script type=\"text/javascript\">\n". 
          "CKEDITOR.replace( 'editor',{filebrowserBrowseUrl : '/js/imglib/index.html?path=/'});\n". 
          "</script>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Сохранить' /></td></tr>"; 
    $print.= "</table></form>"; 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Выберите страницу для редактирования:</td>"; 
    $print.= "<td><select name='id' ><option value='0'>Главная</option>"; 
    my $apages=get_apages(0); 
    my $option=s_razdel($apages->{0}->{'sub'}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Редактировать' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'move_apage'){ 
  $title="Перемещение страниц"; 
  if(exists($in->{id}) && exists($in->{move})){ 
           my($id,$pid)=map {esc_sql($_)} ($in->{id},$in->{move}); 
           if($id==0){ 
               $print.= "<h3>Вы не можите переместить <b>Основной раздел</b></h3>"; 
           }elsif($id==$pid){ 
               $print.= "<h3>Вы не можите переместить раздел сам в себя</h3>"; 
           }else{ 
               move_apage($id,$pid,$in->{how}); 
               $print.= "<h3>Перенесено успешно</h3>"; 
           } 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Переносимый раздел:</td>"; 
   $print.= "<td><select name='id' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
    my $option=s_razdel($apages->{0}->{'sub'}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Куда переносим:</td>"; 
    $print.= "<td><select name='move' >"; 
    $print.= "<option value='0'>Основной раздел</option>"; 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Как переносим:</td>"; 
    $print.= "<td><select name='how' >"; 
    $print.= "<option value='0' selected='selected' >Раздел с подразделами</option>"; 
    $print.= "<option value='1'>Только подразделы</option>";; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Перенести' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'public_apage'){ 
  $title="Отображение страниц"; 
  if(exists($in->{id}) && exists($in->{o})){ 
           my($id,$o)=map {esc_sql($_)} ($in->{id},$in->{o}); 
           if($id==0){ 
               $print.= "<h3>Вы не можите скрыть <b>Основной раздел</b></h3>"; 
           }elsif($o==-1){ 
               $main::db->do("UPDATE apages SET hide=NOT hide WHERE id='$id'"); 
               $print.= "<h3>Успешно инвертировано</h3>"; 
           }else{ 
               $o=$o?1:0; 
               $main::db->do("UPDATE apages SET hide='$o' WHERE id='$id'"); 
               my @o=('Опубликовано','Скрыто'); 
               $print.= "<h3>$o[$o] успешно</h3>"; 
           } 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<h1>Отображение страниц</h1><table>"; 
    $print.= "<tr><td>Страница:</td>"; 
    $print.= "<td><select name='id' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
    my $option=s_razdel($apages->{0}->{'sub'}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Отображение:</td>"; 
    $print.= "<td><select name='o' >"; 
    $print.= "<option value='-1' selected='selected'>Инверсия</option>"; 
    $print.= "<option value='0'>Опубликовать</option>"; 
    $print.= "<option value='1'>Скрыть</option>"; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Изменить' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'del_apage'){ 
  $title="Удаление страниц"; 
  if(exists($in->{id}) && exists($in->{move})){ 
           my($id,$pid)=map {esc_sql($_)} ($in->{id},$in->{move}); 
           if($id==0){ 
               $print.= "<h3>Вы не можите удалить <b>Основной раздел</b></h3>"; 
           }elsif($pid==-1){ 
               del_apage($id); 
               $print.= "<h3>Страница удалена со всеми подуровнями</h3>"; 
           }elsif($pid==$id){ 
               $print.= "<h3>Вы не можите перенести подразделы в удаляемый раздел</h3>"; 
           }else{ 
               move_apage($id,$pid,'pid'); 
               del_apage($id); 
               $print.= "<h3>Страница удалена.</h3>\n"; 
               $print.= "<h4>Подуровни страницы пренесены в ID:$pid</h4>"; 
           } 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Страница для удаления:</td>"; 
    $print.= "<td><select name='id' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
   my $option=s_razdel($apages->{0}->{'sub'}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Переместить дочерние страницы в:</td>"; 
    $print.= "<td><select name='move' ><option value='-1'>Не перемещать (удалить)</option>"; 
    $print.= "<option value='0' selected='selected' >Основной раздел</option>"; 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Удалить' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'sort_menu'){ 
  $title="Сортировка меню"; 
  if(exists($in->{sort}->[0])){ 
           my(@sort)=reverse map {esc_sql($_)} (@{$in->{sort}}); 
           for my $i (0..$#sort){ 
               $main::db->do("UPDATE apages SET sort='$i' WHERE id='$sort[$i]'"); 
           } 
      $print.= "<h3>Сортировка сохранена</h3>"; 
  }elsif(exists($in->{id})){ 
    my @child=sub_apage($in->{id}); 
    $head.='<script src="/js/jquery-1.5.1.min.js" type="text/javascript"></script>'; 
    $head.='<script src="/js/jquery-ui-1.8.13.custom.min.js" type="text/javascript"></script>'; 
    $head.="<style type=\"text/css\">\n"; 
    $head.="#sortable { list-style-type: none; margin: 0; padding: 10; width: 390px; }\n"; 
    $head.="#sortable li { cursor: move; border:1px solid #000; margin: 0 3px 3px 3px; padding: 0.4em; padding-left: 1.5em; font-size: 1.4em; height: 18px; }\n"; 
    $head.="</style><script type=\"text/javascript\">\n"; 
    $head.="\$(function(){\$(\"#sortable\").sortable();});\n"; 
    $head.='</script>'; 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    my $apages=get_apages(0); 
    $print.= "<input type='hidden' name='id' value='$in->{id}' />"; 
    $print.= "<h3>Сортировка раздела: $apages->{$in->{id}}->{name}</h3>"; 
    $print.= "<ul id='sortable' >"; 
    foreach my $child (@child){ 
        $print.= "<li><a title='$child->{title}'><input type='hidden' name='sort' value='$child->{id}' />$child->{name}</a></li>"; 
    } 
    $print.= "</ul><br />"; 
    $print.= "<input type='submit' value='Сохранить' />"; 
    $print.= "</form>"; 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Выбирите раздел для сортировки:</td>"; 
    $print.= "<td><select name='id' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
    my $option=s_razdel($apages->{0}->{sub}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Сортировать' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символом \"&#x25a0;\" обозначены не опубликованные страницы.</p>"; 
  } 
}elsif($in->{a} eq 'set_menu'){ 
  $title="Настройка меню"; 
  if(exists($in->{height}) && exists($in->{width})){ 
      my $menu = { 
                  width  => $in->{width}, 
                  height => $in->{height}, 
                  mc => $in->{mc}, 
                  mbgc => $in->{mbgc}, 
                  hmc => $in->{hmc}, 
                  hmbgc => $in->{hmbgc}, 
                  cc => $in->{cc}, 
                  cbgc => $in->{cbgc}, 
                  hcc => $in->{hcc}, 
                  hcbgc => $in->{hcbgc}, 
                  scc => $in->{scc}, 
                  scbgc => $in->{scbgc}, 
                  shcc => $in->{shcc}, 
                  shcbgc => $in->{shcbgc}, 
                  }; 
      if(writecfg('menu',$menu)){ 
          $print.= "<h3>Сохранено успешно</h3>"; 
      }else{ 
          $print.= "<h3>Не удалось сохранить</h3>"; 
      } 
  }else{ 
    my $m=readcfg('menu'); 
    $head.= '<script src="/js/jquery-1.5.1.min.js" type="text/javascript"></script>'; 
    $head.= '<script src="/js/iColorPickerLink.js" type="text/javascript"></script>'; 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table width='100\%' style='text-align: center;border:1px solid #000;'>"; 
    $print.= "<caption style='border: 1px solid black;'><b>Размер кнопки</b></caption>"; 
    $print.= "<tbody>"; 
    $print.= "<tr><td>Ширина:</td><td width='200px'><input name='width' value='$m->{width}' /></td></tr>"; 
    $print.= "<tr><td>Высота:</td><td><input name='height' value='$m->{height}' /></td></tr>"; 
    $print.= '<tr><td>&nbsp;</td><td><input type=\'submit\' value=\'Сохранить\' /></td></tr>'; 
    $print.= "</tbody></table><br />"; 
    $print.= "<table width='100\%' style='text-align: center;border:1px solid #000;'>". 
          "<caption style='border: 1px solid black;'><b>Настройка цвета</b></caption><tbody>"; 
    $print.= "<tr><th>".join('</th><th>','Что настраеваем','Цвет текста','Цвет фона')."</th></tr>"; 
    $print.= "<tr><td>Основной раздел</td>"; 
    $print.= "<td width='100px'><input value='$m->{mc}' id='mc' name='mc' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td width='100px'><input value='$m->{mbgc}' id='mbgc' name='mbgc' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= "<tr><td>Основной раздел (при наведении)</td>"; 
    $print.= "<td><input id='hmc' name='hmc' value='$m->{hmc}' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td><input id='hmbgc' name='hmbgc' value='$m->{hmbgc}' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= "<tr><td>Дочерний раздел</td>"; 
    $print.= "<td><input id='cc' name='cc' value='$m->{cc}' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td><input id='cbgc' name='cbgc' value='$m->{cbgc}' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= "<tr><td>Дочерний раздел (при наведении)</td>"; 
    $print.= "<td><input id='hcc' name='hcc' value='$m->{hcc}' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td><input id='hcbgc' name='hcbgc' value='$m->{hcbgc}' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= "<tr><td>Дочерний раздел с подразелом</td>"; 
    $print.= "<td><input id='scc' name='scc' value='$m->{scc}' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td><input id='scbgc' name='scbgc' value='$m->{scbgc}' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= "<tr><td>Дочерний раздел с подразелом (при наведении)</td>"; 
    $print.= "<td><input id='shcc' name='shcc' value='$m->{shcc}' size='7' class='iColorPicker' /></td>"; 
    $print.= "<td><input id='shcbgc' name='shcbgc' value='$m->{shcbgc}' size='7' class='iColorPicker' /></td></tr>"; 
    $print.= '<tr><td>&nbsp;</td><td colspan=\'2\'><input type=\'submit\' value=\'Сохранить\' /></td></tr>'; 
    $print.= "</tbody></table></form>"; 
  } 
}elsif($in->{a} eq 'left_menu'){ 
  $title="Ориентация выпадения меню"; 
  if(exists($in->{id}) && exists($in->{o})){ 
           my($id,$o)=map {esc_sql($_)} ($in->{id},$in->{o}); 
           if($id==0){ 
               $print.= "<h3>Вы не можите сорентировать выпадение подразделов <b>Основного раздела</b>, они статичены.</h3>"; 
           }elsif($o==-1){ 
               $main::db->do("UPDATE apages SET `left`=NOT `left` WHERE id='$id'"); 
               $print.= "<h3>Выпадение успешно инвертировано</h3>"; 
           }else{ 
               $o=$o?1:0; 
               $main::db->do("UPDATE apages SET `left`='$o' WHERE id='$id'"); 
               $print.= "<h3>Выполнено успешно</h3>"; 
           } 
      $print.= "</body></html>"; 
  }else{ 
    $print.= "<form action=\'/apanel\' method='post'><input type='hidden' name='a' value='$in->{a}' />"; 
    $print.= "<table>"; 
    $print.= "<tr><td>Раздел:</td>"; 
    $print.= "<td><select name='id' ><option value='0'>Основной раздел</option>"; 
    my $apages=get_apages(0); 
    my $option=so_razdel($apages->{0}->{'sub'}); 
    $print.= $option; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>Ориентация:</td>"; 
    $print.= "<td><select name='o' >"; 
    $print.= "<option value='-1' selected='selected'>Инверсия \&#x2194;</option>"; 
    $print.= "<option value='0'>Вправо \&#x2192;</option>"; 
    $print.= "<option value='1'>Влево \&#x2190;</option>"; 
    $print.= "</select></td></tr>"; 
    $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Изменить' /></td></tr>"; 
    $print.= "</table></form>"; 
    $print.= "<p>* Символами \"\&#x2190;\" и \"\&#x2192;\" обозначено в какую сторону будут выпадать дочерние разделы.</p>"; 
  } 
}else{ 
    $title.="Панель управления"; 
    $print.="<p><b>$::USER</b>, добро пожаловать в панель управления сайтом.</p>"; 
    $print.="<p>Выберите нужную функцию управления.</p>"; 
} 
 
$amenu=[{ 
           name=>'Cтраницы', 
           'sub' => [ 
               { 
                   name=>'Добавить', 
                   href=>'/apanel?a=add_apage', 
               }, 
               { 
                   name=>'Переместить', 
                   href=>'/apanel?a=move_apage', 
               }, 
               { 
                   name=>'Редактировать', 
                   href=>'/apanel?a=edit_apage', 
               }, 
               { 
                   name=>'Отображение', 
                   href=>'/apanel?a=public_apage', 
               }, 
               { 
                   name=>'Удалить', 
                   href=>'/apanel?a=del_apage', 
               },],}, 
           {name=>'Меню', 
           'sub' => [ 
               { 
                   name=>'Сортировка', 
                   href=>'/apanel?a=sort_menu', 
               }, 
               { 
                   name=>'Ориентация', 
                   href=>'/apanel?a=left_menu', 
               }, 
               { 
                   name=>'Настройка', 
                   href=>'/apanel?a=set_menu', 
               },],}, 
           {name=>'Выход', 
            href=>"?$Logined::Form_Action=exit\&exit=".&Logined::exit_value ,} 
           ]; 
    unshift(@{$apages->{0}->{sub}},{name=>'Админка',href=>'/apanel',title=>'Администраторская панель','sub'=>$amenu}); 
 
}else{ 
      $title="Вход"; 
      $print="<h3 align='center'>$::LOGIN_ERR</h3>"; 
      $print.="<table width='90%'>"; 
       $print.= '<form action=\'/apanel\' method="post">'; 
       $print.= "<tr><td align='right'  width='50%'>Логин::</td><td><input name='user' /></td></tr>"; 
       $print.= "<tr><td align='right'>Пароль::</td><td><input type='password' name='pass' /></td></tr>"; 
       $print.= "<tr><td>\&nbsp;</td><td><input type='submit' value='Войти' /></td></tr>"; 
       $print.= "<input type='hidden' name='action' value='login' /></form>"; 
      $print.= "</table>"; 
} 
$skinСоздание сайта для ОАО усмань табак=$title.' - Админка'; 
$skin{CONTENT}=$print; 
$skin{SIDEBAR}=$sidebar; 
$skin{HEAD}.=$head; 
 
1;

Листинг 5. Модуль расширения «Поиск по сайту»

# Модуль поиска  по содержимому  страниц 
use locale; use POSIX qw(locale_h); setlocale(LC_CTYPE,"ru_RU.CP1251"); 
package mod::search; 
sub morf($){ 
    # Формируем окончание слова "страниц" в зависимости от $found 
    # для фразы "Найдено $found страниц 
    $_[0]=~/(\d)?(\d)$/; 
    my @m=($1,$2); 
    my $m='страниц'; 
    if($m[0]==1){$m.=''} 
    elsif($m[1]==1){$m.='а'} 
    elsif($m[1] && $m[1]<5){$m.='ы'} 
    else{$m.=''} 
    $m; 
} 
# Формируем заголовок по умолчанию 
$::skinСоздание сайта для ОАО усмань табак='Поиск'; 
$::skin{MENU}=&::menu($::pages,'/').$::cfg->{menu}->{separator}.'Поиск'; 
# Считываем строку поиска ограничевая ее 64-мя символами 
# 64 символа пользователю будет достаточно для поиска 
my $s=substr($::in->{s},0,64); 
# Удаляем все лишнее, оставляем только текст и пробелы 
$s=~s/[^\w\x7F-\xFF\s]/ /g; 
# Формируем массив слов для поиска добавляя слова более трех симовлов 
my @s=grep {!/^.{1,3}$/} split(/\s+/,$s); 
if($#s>=0){# Есть что искать 
      # Формируем логику поиска 
      my $logic=$::in->{logic} ne 'AND'?'OR':'AND'; 
      # Формируем запрос 
      my $query="SELECT * FROM pages WHERE content LIKE '\%". 
                 join("\%' $logic content LIKE '%",@s)."\%'"; 
      # Выполняем запрос 
      my $res=$::db->prepare($query); 
      # Количество найденного 
      my $found=$res->execute(); 
      $found=0 if !$found || $found eq '0E0'; 
      # Формируем окончание слова "страниц" в зависимости от $found 
      # для фразы "Найдено $found страниц 
      my $morf=morf($found); 
      $::skin{CONTENT}="<h3>Результат поиска: $found $morf</h3>\n<ol>\n"; 
      $::skinСоздание сайта для ОАО усмань табак.=': "'.join(" ",@s).'"'; 
      while(my $h=$res->fetchrow_hashref){ 
            # Формируем список найденных страниц 
            $::skin{CONTENT}.="<li><h4><a href=\"$::pages->{$h->{id}}->{href}\">". 
                              $h->{title}."</a></h4>\n"; 
            # Формируем описание 
            my $desc=$h->{content}; 
            # удаляем теги из описания 
            $desc=~s/<(noindex|script|iframe).*?>.*?<\/\1.*?>//gs; 
            $desc=~s/<.*?>//gs; 
            # Подсвечиваем найденные слова 
            foreach (@s){$desc=~s/($_)/<b>$1<\/b>/gi} 
            $desc=~s/^(|.*\.)\s*([^\.]*<b>.*<\/b>[^\.]*).*$/$2\.\.\./s; 
            # Добовляем описание 
            $::skin{CONTENT}.="<p align=\"justify\">$desc</p></li>\n"; 
      } 
      $res->finish(); 
      $::skin{CONTENT}.="</ol>"; 
}else{ 
     $::skin{CONTENT}="<h3>Плохой запрос</h3>". 
     "<p>Слова при поиске должны быть длиннее 3-х символов</p>" 
     } 
1;

Информация о работе Создание сайта для ОАО усмань табак