Проанализировав опыт применения Интернет-технологий для ведения бизнеса можно сделать вывод, что Интернет-торговля - это очень хорошо развивающаяся часть электронной коммерции.

Изучив типы решений и подходы среди Интернет-магазинов, можно увидеть, что их организационные структуры схожи. Что бы Интернет-магазин стал действительно успешным, необходимо, что бы главная страница заинтересовала потенциального покупателя, навигация была простой и удобной, товары были подробно представлены.

Интернет-магазин обычно состоит из следующих типовых частей:

каталог товаров;

поисковая система;

контактная информация \ информация о фирме;

регистрационная форма;

корзина;

форма отправки заказа.

Самым популярным языком при разработке Интернет-магазинов стал PHP за свою простоту и эффективность. Но у PHP есть недостаток - он включает в себя большое количество самых необходимых модулей, но если программисту понадобятся дополнительные возможности языка, он не всегда сможет ими воспользоваться, потому как у PHP не достаточно много подключаемых программных модулей для расширения своей функциональности, как, например, у Perl.

Perl является интерпретируемым и переносимым языком. Он является образчиком для обработки и работы с текстом и построен на бесплатной платформе OpenSource. Для Perl ежедневно пишется большое количество новых программных модулей, поэтому практически не существует проблемы, которую нельзя было бы решить при использовании этого языка с подключением одного из модулей.

При проектировании базы данных и Интернет-магазина, была выбрала реляционная база данных, как одна из наиболее популярных моделей представления данных - объектной и реляционной. Реляционная база данных представляет собой набор таблиц, связанных между собой, доступ к которым осуществляется с помощью языка запросов SQL. Примером служит СУБД MySQL, являющаяся лидером среди баз данных, применяемых для разработки WEB-приложений на сегодняшний день. Это свободно распространяемая система. Кроме того, она достаточно быстрая, надежная и, главное, простая в использовании, подходящая для не слишком глобальных проектов.

Интернет-магазин реализован как на хостинге, так и на сервере компании. На хостинге храниться администраторская, клиентская части и база данных, на сервере происходит запуск скрипта загружающего новые прайс-листы с серверов поставщиков, их распаковка, обработка, парсинг и загрузка в базу данных.

Реализована база данных из пяти таблиц, хранящих в себе информацию о товарах, пользователях и настройках.

При внедрении Интернет-магазина основными задачами, стоящими перед фирмой являлись:

1. Увеличение сбыта продукции.

2. Снижение накладных расходов на рекламу.

3. Расширение региона сбыта товаров от г. Калуги до Калужской области.

Анализ эффективности показал, что наиболее эффективный и дешёвый способ их решения - создание Интернет-магазина по продаже цифровой и компьютерной техники, представляющего собой виртуальную точку продаж в дополнение к реальному магазину, которая повышает объем сбываемой продукции, расширяет регион потенциальных покупателей и при этом намного дешевле в обслуживании без дополнительных затрат на помещение и зарплаты сотрудникам.

Список использованных источников и литературы

1. Уилсон Р., Планирование стратегии интернет-маркетинга,, Изд.: Издательский дом Гребенникова, 2003г.

2. Успенский И., Интернет как инструмент маркетинга,, Изд.: BHV - Санкт - Петербург, 1999г.

3. Алексунин В., Родигина В., Электронная коммерция и маркетинг в Интернете,, Изд.: Дашков и Ко, 2007г.

4. Вонг Т., 101 способ поднять вашу сетевую торговлю. Как облегчить Интернет-маркетинг, Изд.: Диля, 2004г.

5. Кеглер Т., Доулин П., Тейлор Б., Тестерман Д., Реклама и маркетинг в Интернете,, Изд.: Альпина Паблишер, 2003г.

6. Холмогоров В., Интернет-маркетинг. Краткий курс,, Изд.: Питер, 2001г.

7. Холмогоров В., Интернет-маркетинг. Краткий курс. Второе издание,, Изд.: Питер, 2002г.

8. Костяев Р., Бизнес в Интернете: финансы, маркетинг, планирование, Изд.: BHV - Санкт - Петербург, 2002г.

9. Фэй М.Д., Реклама, маркетинг, дизайн в Интернете, Изд.: Channel Trading Ltd, 1999г.

10. Пирс К., Освой самостоятельно Perl за 24 часа, Изд.: Вильямс, 2001г.

11. Матросов А., Самоучитель Perl, Чаунин М.П., Изд.: BHV, 2003г.

12. Шварц Р.Л., Изучаем Perl, Изд.; BHV - Санкт - Петербург, 2002г

13. Кристиансен Т., Торкингтон Н., Perl. Сборник рецепотов. Для профессионалов, Изд.: Питер, Санкт-Петербург, 2004г.

14. Дунаев В., JavaScript - самоучитель, Изд.: Питер, 2005г.

15. Флэнаган Д., JavaScript - подробное руководство, Изд.: Символ, 2008г.

16. Соколов В., Соколов С., JavaScript в примерах, типовых решениях и задачах, Изд.: Вильямс, 2006 г.

17. Дмитриева М., JavaScript, Изд.: БХВ-Петербург, 2004г.

18. Ломов А., Apache, Perl, MySQL. Практика создания динамических сайтов, Изд.: БХВ-Петербург, 2007 г.

19. Прохоренок Н., HTML, JavaScript, PHP и MySQL. Джентельменский набор Web-мастера,., Изд.: БХВ-Петербург, 2008 г.

20. Мейер Э.А. CSS - каскадные таблицы стилей. Подробное руководство.3-е издание., Изд.: Символ, Символ-Плюс, 2008г.

21. Шмит К., CSS. Рецепты программирования, Изд.: БХВ-Петербург, 2007 г.

22. http://ru. wikipedia.org

23. http://docs.com.ru/

24. http://www.internet-technologies.ru

25. http://webdesign.net-soft.ru

26. http://books.net-soft.ru

27. http://www.amperl.ru/

Приложения

daemon. pl;

common. pm;

template. pm;

localset. pm;

settings. pm.

stoik_goods. htm

stoik. pl

#! /usr/bin/perl

use POSIX qw (strftime);

use localset;

use settings;

use template;

use Time:: HiRes qw (usleep ualarm gettimeofday tv_interval);

use common;

use vars qw ($c $mainpage);

use strict;

use Archive:: Zip qw (: ERROR_CODES: CONSTANTS);

my $t0 = [gettimeofday];

my @out;

$c = new common ();

$c->do ("set names cp1251");

my %func;

my $cmd = $c->{cgi}->param ('cmd') || 'home';

$func{'home'} = \&home;

$func{'admin'} = \&admin;

$func{'showtree'} = \&showtree;

$func{'showgoods'} = \&showgoods;

$func{'addmygoods'} = \&addmygoods;

$func{'showmygoods'} = \&showmygoods;

$func{'myaccountinfo'} = \&myaccountinfo;

$func{'myaccountgoods'} = \&myaccountgoods;

$func{'deletemygoods'} = \&deletemygoods;

$func{'editmygoods'} = \&editmygoods;

$func{'reloadgoodsframe'} = \&reloadgoodsframe;

$func{'search'} = \&search;

$func{'checkprint'} = \&checkprint;

$func{'sendmail'} = \&sendmail;

$func{'login'} = \&login;

$func{'login2'} = \&login2;

$func{'logout'} = \&logout;

$func{'register'} = \&register;

$func{'register2'} = \&register2;

$func{'changepass'} = \&changepass;

$func{'changepass2'} = \&changepass2;

$func{'loadprices'} = \&loadprices;

$func{'menuhow'} = \&menuhow;

$func{'welcome'} = \&welcome;

$func{'aboutus'} = \&aboutus;

$func{'order'} = \ℴ

$func{'buy'} = \&buy;

$func{'deliver'} = \&deliver;

$func{'uslugi'} = \&uslugi;

$func{'basket'} = \&basket;

$mainpage = new template ("$paths:: root/stoik_main. htm",'ALL');

$mainpage->replaceContent ("rooturl", $paths:: url);

$func{$cmd}-> ();

if ($cmd eq 'home' or $cmd eq 'admin') {

my $elapsed = tv_interval ($t0, [gettimeofday]);

$mainpage->replaceContent ("elapsedtime", $elapsed);

$mainpage->replaceContent ("debug", $c->{pid});

$mainpage->replaceContent ("queries", $c->{queries});

$mainpage->clearAllTags ();

$mainpage->print ();

}

sub loadprices {

my $user = $c->{cgi}->param ('user');

my $pass = $c->{cgi}->param ('pass');

my ($id,$admin) = checkPass ($user,$pass);

my $zip;

my $status;

print "Content-type: text/html\n";

print "\n";

if ($admin) {

# $zip = Archive:: Zip->new ();

# $status = $zip->read ($files:: archive_file);

# if ($status! = AZ_OK) {

# print "prices read archive.. FAILED\n $status";

# } else {

# print "prices read archive.. OK\n";

# $zip->extractMember ('oldi. txt');

# $zip->extractMember ('nix. txt');

# #$zip->extractTree ('','',$paths:: root);

#

# }

load_price ('o');

load_price ('n');

my $t = time;

$t += 60*60*3;

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime ($t);

$mon++;

$year += 1900;

setSettings ($settings:: pricedate,"$mday/$mon/$year $hour: $min: $sec");

} else {

print 'Only for ADMINISTRATORS! ';

}

}

sub myaccountinfo {

my $script = shift;

my $page = new template ("$paths:: root/myaccountinfo_frame. htm",'ALL');

my $uid = $c->{uid};

if ($uid) {

my $goodscount = getCountGoodByUser ($uid);

my $goodssum = getSumGoodByUser ($uid);

$goodssum = sprintf ("%.2f", $goodssum);

$page->clearLoopTags ('alreadylogin');

if (! $c->{admin}) {

$page->clearLoopTags ('admin');

}

$page->replaceContent ("script",$script);

$page->replaceContent ("count",$goodscount);

$page->replaceContent ("summa",$goodssum);

} else {

$page->clearLoopTags ('clear');

}

$page->replaceContent ("username",$c->{uname});

$page->clearAllTags ();

$page->print ();

}

sub checkprint {

my $script = shift;

my $page = new template ("$paths:: root/checkprint. htm",'ALL');

my $uid = $c->{uid};

my $goodscount = getCountGoodByUser ($uid);

my $sth;

my @out;

my $sum = 0;

my $class;

my $count;

my $curdate = strftime "%d. %m. %Y", localtime;

if ($goodscount) {

$sth = $c->prepare ("select t1. id,t1. number,t1. seller,t1. gid,t1. oldname,t2. name,t2. cost from $tables:: mygoods as t1

left join goods as t2 ON t1. gid = t2. id

and t1. pid = t2. pid

and t1. seller = t2. seller

where t1. uid =?");

$c->execute ($sth,$uid);

while (my ($id_,$number_,$seller_,$gid_,$oldname_,$name_,$cost_) = $sth->fetchrow_array) {

$sum = $sum + $cost_ * $number_;

$sum = sprintf ("%.2f", $sum);

$count += 1;

if (! $name_) {

$cost_ = 0;

$number_ = 0;

$name_ = "<span class='warning'>Товар с артикулом $seller_$gid_ не найден. ($oldname_) </span>";

}

if ($count & 1) {

$class ='even';

} else {

$class ='';

}

push @out, {

npp => $count,

class => $class,

sum => sprintf ("%.2f", ($cost_ * $number_)),

name => $name_,

cost => $cost_,

number => $number_,

id=>"$seller_$gid_",

};

}

$page->replaceLoopContent ("goodsloop", \@out);

} else {

$page->clearLoopTags ();

}

my $print = getSettings ($settings:: printcount);

$print++;

setSettings ($settings:: printcount,$print);

$page->replaceContent ("summa",$sum);

$page->replaceContent ("curdate",$curdate);

$page->clearAllTags ();

$page->print ();

}

sub register {

my $info = shift;

my $page = new template ("$paths:: root/reg_frame. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub register2 {

my $user = $c->{cgi}->param ('user');

my $phone = $c->{cgi}->param ('phone');

my $pass = $c->{cgi}->param ('pass');

my $pass1 = $c->{cgi}->param ('pass1');

my $email = $c->{cgi}->param ('email');

if (UserAlreadyExist ($user)) {

register ("Пользователь $user уже зарегистрирован. Выберите другое имя. ");

} elsif (! $user) {

register ("Введите имя пользователя!");

} elsif ($pass ne $pass1 or! $pass) {

register ("Введите одинаковые пароли не пустые пароли!");

} else {

AddUser ($user,$phone,$pass,$email);

login2 ($user,$pass);

}

}

sub AddUser {

my $user = shift;

my $phone = shift;

my $pass = shift;

my $email = shift;

my $cryptpass = crypt ($pass,substr ($pass,0,2));

my $sth;

$sth = $c->prepare ("insert into $tables:: users (id,name,phone,password,createdate,accessdate,email,admin)

values (null,?,?,?,now (),now (),?,0)");

$c->execute ($sth,$user,$phone,$cryptpass,$email);

}

sub UserAlreadyExist {

my $user = shift;

my $sth;

$sth = $c->prepare ("select count (*) from $tables:: users where name=?");

$c->execute ($sth,$user);

my $count = $sth->fetchrow_array;

return $count;

}

sub logout {

$c->clearCookie ();

DeleteSession ();

myaccountgoods ("window. parent. reloadInfo (); \nwindow. parent. Welcome (); \n");

}

sub changepass {

my $info = shift;

my $uid = $c->{uid};

if ($uid) {

my $page = new template ("$paths:: root/changepass_frame. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

}

sub changepass2 {

my $info = shift;

my $user = $c->{uname};

my $oldpass = $c->{cgi}->param ('oldpass');

my $pass = $c->{cgi}->param ('pass');

my $pass1 = $c->{cgi}->param ('pass1');

if (! checkPass ($user,$oldpass)) {

changepass ("Старый пароль не верен!");

} elsif ($pass ne $pass1) {

changepass ("Разные новые пароли!");

} else {

ChangePASS ($user,$pass);

myaccountgoods ();

}

}

sub login {

my $info = shift;

my $page = new template ("$paths:: root/login_frame. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub login2 {

my $user = shift || $c->{cgi}->param ('user');

my $pass = shift || $c->{cgi}->param ('pass');

my ($id,$admin) = checkPass ($user,$pass);

if (! $id) {

login ("Неверное имя пользователя или пароль!");

return;

} else {

CreateSession ($id);

$c->{admin} = $admin;

$c->{uid} = $id;

$c->{uname} = $user;

myaccountgoods ("window. parent. reloadInfo (); \nwindow. parent. Welcome (); \n"." // == $c->{pid} == \n");

}

}

sub DeleteSession {

my $sid = $c->{pid};

my $sth;

$sth = $c->prepare ("delete from $tables:: sessions where id=?");

$c->execute ($sth,$sid);

$c->{uid} = 0;

$c->{admin} = 0;

$c->{uname} = 'Гость';

}

sub CreateSession {

my $uid = shift;

$c->setCookie ();

my $sid = $c->{pid};

my $sth;

$sth = $c->prepare ("insert into $tables:: sessions (id,uid,createdate,accessdate) values (?,?,now (),now ())");

$c->execute ($sth,$sid,$uid);

}

sub ChangePASS () {

my $user = shift;

my $pass = shift;

my $cryptpass = crypt ($pass,substr ($pass,0,2));

my $sth;

$sth = $c->prepare ("update $tables:: users set password=? where name=?");

$c->execute ($sth,$cryptpass,$user);

}

sub checkPass {

my $user = shift;

my $pass = shift;

my $sth;

$sth = $c->prepare ("select id,password,admin from $tables:: users where name=?");

$c->execute ($sth,$user);

my ($id,$password,$admin) = $sth->fetchrow_array;

if (crypt ($pass,$password) ne $password) {

return (0,0);

} else {

return ($id,$admin);

}

}

sub myaccountgoods {

my $script = shift;

my $page = new template ("$paths:: root/myaccountgoods_frame. htm",'ALL');

my $uid = $c->{uid};

my $goodscount = getCountGoodByUser ($uid);

my $sth;

my @out;

my $sum = 0;

my $class;

my $count;

my $error = '';

if ($goodscount) {

$sth = $c->prepare ("select t1. id,t1. number,t1. seller,t1. gid,t1. oldname,t2. name,t2. cost from $tables:: mygoods as t1

left join goods as t2 ON t1. gid = t2. id

and t1. pid = t2. pid

and t1. seller = t2. seller

where t1. uid =?");

$error. = $sth->errstr if $sth->err;

$c->execute ($sth,$uid);

$error. = $sth->errstr if $sth->err;

while (my ($id_,$number_,$seller_,$gid_,$oldname_,$name_,$cost_) = $sth->fetchrow_array) {

if (! $name_) {

$cost_ = 0;

$number_ = 0;

$name_ = "<span class='warning'>Товар с артикулом $seller_$gid_ не найден. ($oldname_) </span>";

}

$sum = $sum + $cost_ * $number_;

$cost_ = sprintf ("%.2f", $cost_);

$count += 1;

if ($count & 1) {

$class ='even';

} else {

$class ='';

}

push @out, {

class => $class,

name => $name_,

cost => $cost_,

number => $number_,

id=>"$seller_$gid_",

idgoods=>"$id_",

};

}

$page->replaceLoopContent ("goodsloop", \@out);

} else {

$page->clearLoopTags ();

}

if ($script) {

$page->replaceContent ("script","$script\n $error");

}

$page->clearAllTags ();

$page->print ();

}

sub getSumGoodByUser {

my $uid = shift;

my $sth;

my $sum = 0;

$sth = $c->prepare ("select t2. cost,t1. number from $tables:: mygoods as t1,$tables:: goods as t2 where

t1. uid=? and t2. id = t1. gid and t2. seller=t1. seller and t2. pid=t1. pid");

$c->execute ($sth,$uid);

while (my ($cost,$number) = $sth->fetchrow_array) {

$sum = $sum + $cost * $number;

}

if ($sum eq '0E0' ||! $sum) {

$sum = 0;

}

return $sum;

}

sub getCountGoodByUser {

my $uid = shift;

my $sth;

#$sth = $c->prepare ("select sum (t1. number) from $tables:: mygoods as t1,$tables:: goods as t2 where

# t1. uid=? and t2. id = t1. gid and t2. seller=t1. seller and t2. pid=t1. pid");

$sth = $c->prepare ("select sum (number) from $tables:: mygoods where uid=?");

$c->execute ($sth,$uid);

my $count = $sth->fetchrow_array;

if ($count eq '0E0' ||! $count) {

$count = 0;

}

return $count;

}

sub deletemygoods {

my $id = $c->{cgi}->param ('id');

my $uid = $c->{uid};

my $sth;

my $script;

if ($id eq 'all') {

$sth = $c->prepare ("delete from $tables:: mygoods where uid=?");

$c->execute ($sth,$uid);

myaccountinfo ("window. parent. reloadGoods (); ");

} else {

$sth = $c->prepare ("delete from $tables:: mygoods where id=? and uid=?");

$c->execute ($sth,$id,$uid);

$script = "window. parent. reloadInfo (); \n";

myaccountgoods ($script);

}

}

sub editmygoods {

my $id = $c->{cgi}->param ('id');

my $uid = $c->{uid};

my $number = $c->{cgi}->param ('number');

my $sth;

my $script;

$sth = $c->prepare ("update $tables:: mygoods set number=? where id=? and uid=?");

$c->execute ($sth,$number,$id,$uid);

$script = "window. parent. reloadInfo (); \n";

$script. = "window. parent. document. getElementById ('infoelapsedtime'). innerHTML = ''; \n";

myaccountgoods ($script);

}

sub getNameByID {

my $id = shift;

my $pid = shift;

my $seller = shift;

my $sth;

$sth = $c->prepare ("select name from $tables:: goods where id=? and pid=? and seller=?");

$c->execute ($sth,$id,$pid,$seller);

return $sth->fetchrow_array;

}

sub addmygoods {

my $gid = $c->{cgi}->param ('id');

my $pid = $c->{cgi}->param ('pid');

my $uid = $c->{uid};

my $seller = $c->{cgi}->param ('seller');

my $number = $c->{cgi}->param ('number');

my $sth;

my $script;

if ($uid) {

my $oldname = getNameByID ($gid,$pid,$seller);

if ($gid && $uid && $seller && $pid && $number) {

$sth = $c->prepare ("insert into $tables:: mygoods (oldname, id,uid,gid,pid,seller,number,createdate)

values (?,null,?,?,?,?,?,now ())");

#$error. = $sth->errstr if $sth->err;

$c->execute ($sth,$oldname,$uid,$gid,$pid,$seller,$number);

#$error. = $sth->errstr if $sth->err;

}

$script = "window. parent. reloadInfo (); \n";

}

myaccountgoods ($script);

}

sub search {

showgoods ('search');

}

sub showgoods {

my $cmd = shift;

my $str = $c->{cgi}->param ('str'); # search text

my $artikul = $c->{cgi}->param ('artikul');

my $str1 = $str;

if ($str) {

$str =~ s/'/\\'/;

$str =~ s/</&lt; /;

$str =~ s/>/&gt; /;

}

my $from = $c->{cgi}->param ('from') || 0;

my $t0 = [gettimeofday];

my $pid = $c->{cgi}->param ('pid');

my $seller = $c->{cgi}->param ('seller');

my $page;

my $sth;

my @out;

my $count = 0;

my $class;

my $p;

my $img;

my $parent;

my $url;

$page = new template ("$paths:: root/goods_frame. htm",'ALL');

my $sql;

my $invalue = "";

if ($cmd eq 'search') {

if ($artikul) {

my @list = split (/\|/,$str);

my $index;

foreach $index (0. $#list) {

$invalue. = $list [$index];

if ($index < $#list) {

$invalue. = ",";

}

}

$sth = $c->prepare ("select count (*) from $tables:: goods

where id in ($invalue) and isgoods=? and cost>? order by cost");

$c->execute ($sth,1,0);

} else {

$sth = $c->prepare ("select count (*) from $tables:: goods

where name like? and isgoods=? and cost>? order by cost");

$c->execute ($sth,"%$str%",1,0);

}

my $count = $sth->fetchrow_array;

my $url;

if ($from > 0) {

my $from1 = $from - $max:: goodsperpage;

if ($from1 < 0) {

$from1 = 0;

}

$url ="<a href='? cmd=search&from=". ($from1). "&str=$str&artikul=$artikul'>

<img src='img/back. gif' width='16' height='16' border='0' align='middle'> Назад</a>";

}

if ($from + $max:: goodsperpage < $count) {

if ($url) {

$url. = " | ";

}

$url. = " <a href='? cmd=search&from=". ($from+$max:: goodsperpage). "&str=$str&artikul=$artikul'>

Вперед <img src='img/go. gif' width='16' height='16' border='0' align='middle'></a>";

}

$page->replaceContent ("nextprevurl",$url);

my $to = $from + $max:: goodsperpage;

if ($to > $count) {

$to = $count;

}

$parent = "Поиск: $str1 Найдено товаров: $count Показаны:". ($from+1)." - $to";

$page->replaceContent ("parent","$parent");

$sth = 0;

if ($artikul) {

$sth = $c->prepare ("select name,cost,oldcost, id,seller,pid from $tables:: goods

where id in ($invalue) and isgoods=? and cost>? order by cost limit?,?");

$c->execute ($sth,1,0,$from,$max:: goodsperpage);

} else {

$sth = $c->prepare ("select name,cost,oldcost, id,seller,pid from $tables:: goods

where name like? and isgoods=? and cost>? order by cost limit?,?");

$c->execute ($sth,"%$str%",1,0,$from,$max:: goodsperpage);

}

} else {

if ($pid) {

$parent = getParentName ($pid,$seller);

$page->replaceContent ("parent","$parent");

$sth = $c->prepare ("select name,cost,oldcost, id,seller,pid from $tables:: goods

where pid=? and seller=? and isgoods=? and cost>?

order by cost");

$c->execute ($sth,$pid,$seller,1,0);

}

}

$page->replaceContent ("pid", $pid);

$page->replaceContent ("seller", $seller);

if ($sth) {

while (my ($name,$cost,$oldcost,$id,$seller_,$pid_) = $sth->fetchrow_array) {

if ($oldcost > 0) {

if ($cost > $oldcost) {

$img = "<img src='img/up. gif' width='10' height='10' title='$oldcost'>";

} elsif ($cost < $oldcost) {

$img = "<img src='img/down. gif' width='10' height='10' title='$oldcost'>";

}

} else {

$img = "";

}

$p = $parent;

$count++;

if (! ($count & 1)) {

$class = "even";

} else {

$class="";

}

if ($seller_ eq 'o') {

$url = $name;

$url =~ s/\\'/'/;

$url =~ s/&lt; /</;

$url =~ s/&gt; />/;

$url =~ s/. +" //;

$url =~ s/,. + //;

#$url =~ s/"/&quot; /;

$url = "http://www.oldi.ru/catalog/search. php? str=$url";

} else {

$url = "http://www.nix.ru/dealers/includes/find_by_label.html? id=$id"

}

push @out, {

urlinfo => $url,

name => $name,

cost => $cost,

class=> $class,

oldcost=>$img,

id=>"$seller_$id",

idshow=>"$id",

addgoods=>"javascript: window. parent. addGoods ($id,$pid_,'$seller_',1)",

addgoods2=>"javascript: window. parent. addGoods2 ($id,$pid_,'$seller_')",

};

}

if (! $c->{uid}) {

$page->clearLoopTags ('useronly');

}

$page->replaceLoopContent ("goodsloop", \@out);

} else {

$page->clearLoopTags ();

}

my $elapsed = tv_interval ($t0, [gettimeofday]);

my $script. = "window. parent. document. getElementById ('infoelapsedtime'). innerHTML = '$elapsed'; \n";

$script. = "window. parent. document. getElementById ('infoqueries'). innerHTML = '$c->{queries}'; \n";

$page->replaceContent ("script",$script);

$page->clearAllTags ();

$page->print ();

}

sub getSubDivCount {

my $pid = shift;

my $seller = shift;

my $sth;

my $count = 0;

$sth = $c->prepare ("select count (*) from $tables:: goods where pid=? and seller=? and isgoods=?");

$c->execute ($sth,$pid,$seller,0);

$count = $sth->fetchrow_array;

return $count;

}

sub getParentName {

my $pid = shift;

my $seller = shift;

my $sth;

my $parentname;

$sth = $c->prepare ("select name,pid, id from $tables:: goods where id=? and seller=? and isgoods=?");

$c->execute ($sth,$pid,$seller,0);

my ($name,$pid1,$id) = $sth->fetchrow_array;

$name =~ s/\\'/'/;

$name =~ s/\\"/"/;

if (! $pid1) {

return $name;

} else {

$parentname = $name;

my ($parname,$parid) = getParentName ($pid1,$seller);

$parentname = "$parname &raquo; $parentname";

return $parentname;

}

}

sub getGoodsCount {

my $pid = shift;

my $seller = shift;

my $sth;

my $count = 0;

$sth = $c->prepare ("select count (*) from $tables:: goods where pid=? and seller=? and isgoods=? and cost>?");

$c->execute ($sth,$pid,$seller,1,0);

$count = $sth->fetchrow_array;

return $count;

}

sub showTreeByID {

my $t0 = [gettimeofday];

my $pid = shift;

my $seller = shift;

my $sth;

my $tree_items = "parent. t. removeChilds ('$pid', false); \n";

my $page = new template ("$paths:: root/showtree. htm",'ALL');

my $goodsurl;

my $goodscount;

if ( (substr ($pid,0,1) eq 'o' || substr ($pid,0,1)) && length ($pid) > 1) {

$pid = substr ($pid,1,length ($pid) - 1);

}

my $pid1 = $pid;

if ( ($pid + 1) == 1) {

$pid = 0;

}

if (length ($pid1) > 1) {

$pid1= "$seller$pid1";

}

$sth = $c->prepare ("Select id,name from $tables:: goods where pid=? and seller=? and isgoods=?");

$c->execute ($sth,$pid,$seller,0);

while (my ($id,$name) = $sth->fetchrow_array) {

if ($goodscount = getGoodsCount ($id,$seller)) {

#$goodsurl = "? cmd=showgoods&pid=$id";

$goodsurl = "\"javascript: showGoods ($id,'$seller') \"";

$goodscount = " ($goodscount)";

} else {

$goodsurl = "\"\"";

$goodscount = "";

}

if (getSubDivCount ($id,$seller)) {

$tree_items. = "parent. t. add ('$seller$id','$pid1','$name $goodscount', $goodsurl, '',false,false,'$seller'); \n";

$tree_items. = "parent. t. add ('C$seller$id','$seller$id','Загрузка. ','','',false); \n";

} else {

if ($goodscount) {

$tree_items. = "parent. t. add ('$seller$id','$pid1','$name $goodscount', $goodsurl, ''); \n";

}

}

}

my $elapsed = tv_interval ($t0, [gettimeofday]);

$tree_items. = "window. parent. document. getElementById ('infoelapsedtime'). innerHTML = '$elapsed'; \n";

$tree_items. = "window. parent. document. getElementById ('infoqueries'). innerHTML = '$c->{queries}'; \n";

$tree_items. = "parent. t. reloadNode ('$pid1'); \n";

$tree_items. = "var nd = parent. t. getNodeById ('$pid1'); \n";

$tree_items. = "nd. xtra =''; \n";

$page->replaceContent ("script",$tree_items);

$page->clearAllTags ();

$page->print ();

}

sub showtree {

my $seller = $c->{cgi}->param ('seller');

my $pid = $c->{cgi}->param ('pid');

if ($seller) {

showTreeByID ($pid,$seller);

} else {

my $page = new template ("$paths:: root/showtree. htm",'ALL');

$page->replaceContent ("script"," // NULL");

$page->clearAllTags ();

$page->print ();

}

}

sub home {

my $page = new template ("$paths:: root/stoik_goods. htm");

my $prdate = getSettings ($settings:: pricedate);

$page->replaceContent ("pricedate", "$prdate");

$mainpage->replaceContent ("data", $page->getContent ());

CreateSellerTree ();

}

sub upload {

my $param = shift || return;

my $outputfile = shift || return;

my $inputfile = $c->{cgi}->param ($param);

my $bytesread;

my $buffer;

my $sizefile = 0;

open (OUTFILE,">$outputfile");

binmode (OUTFILE);

binmode ($inputfile);

while ($bytesread = read ($inputfile,$buffer,1024)) {

$sizefile += $bytesread;

print OUTFILE $buffer;

}

close (OUTFILE);

close ($inputfile);

goadmin ("Файл $outputfile загружен (размер = $sizefile)");

}

sub upload_price {

my $oldi = $c->{cgi}->param ('upload_oldi');

my $nix = $c->{cgi}->param ('upload_nix');

my $stoik = $c->{cgi}->param ('upload_stoik');

my $file;

if ($oldi) {

$file = $files:: oldi_file;

} elsif ($nix) {

$file = $files:: nix_file;

} elsif ($stoik) {

$file = $files:: stoik_file;

}

upload ("file",$file);

}

sub admin_set_info {

my $info = shift;

$mainpage->replaceContent ("info", $info);

}

sub admin_set_status {

my $info = shift;

$mainpage->replaceContent ("status", $info);

}

sub goadmin {

my $info = shift;

my $page = new template ("$paths:: root/admin_go. htm");

my $print = getSettings ($settings:: printcount);

$page->replaceContent ("printcount", $print);

$mainpage->replaceContent ("data", $page->getContent ());

admin_set_status ($info);

}

sub ClearSessions {

my $sth;

$sth = $c->prepare ("delete from $tables:: sessions where UNIX_TIMESTAMP () - UNIX_TIMESTAMP (accessdate) >?");

$c->execute ($sth,$max:: sessionlength*60);

}

sub admin {

if ($c->{admin}) {

ClearSessions ();

my $page = new template ("$paths:: root/admin. htm");

$mainpage->replaceContent ("data", $page->getContent ());

my $cmd2 = $c->{cgi}->param ('cmd2') || 'goadmin';

my %func;

$func{'upload_price'} = \&upload_price;

$func{'load_price'} = \&load_price;

$func{'goadmin'} = \&goadmin;

$func{$cmd2}-> ();

}

}

sub addGoods {

my $pid = shift;

my $list_ref = shift;

my $count;

my $sth;

$list_ref-> [3] =~ s/,/\. /;

$sth = $c->prepare ("update $tables:: oldi set pid=?,name=?,cost=?, isGoods=1 where id=?");

$count = $c->execute ($sth,$pid,$list_ref-> [2],$list_ref-> [3],$list_ref-> [1]);

if (! $count || $count eq '0E0') {

$sth = $c->prepare ("insert into $tables:: oldi (id,pid,name,cost, isGoods) values (?,?,?,?,1)");

$c->execute ($sth,$list_ref-> [1],$pid,$list_ref-> [2],$list_ref-> [3]);

}

}

sub addSubDiv {

my $pid = shift;

my $list_ref = shift;

my $count;

my $sth;

$sth = $c->prepare ("update $tables:: oldi set pid=?,name=? where id=?");

$count = $c->execute ($sth,$pid,$list_ref-> [2],$list_ref-> [1]);

if (! $count || $count eq '0E0') {

$sth = $c->prepare ("insert into $tables:: oldi (id,pid,name) values (?,?,?)");

$c->execute ($sth,$list_ref-> [1],$pid,$list_ref-> [2]);

}

}

sub addDiv {

my $list_ref = shift;

my $count;

my $sth;

$sth = $c->prepare ("update $tables:: oldi set name=? where id=?");

$count = $c->execute ($sth,$list_ref-> [2],$list_ref-> [1]);

if (! $count || $count eq '0E0') {

$c->prepare ("insert into $tables:: oldi (id,name) values (?,?)");

$c->execute ($list_ref-> [1],$list_ref-> [2]);

}

}

sub addItem {

my $seller = shift;

my $list_ref = shift;

my $sth;

my $count;

# isGood|ID|PID|NAME|PRICE

# 0 |1 |2 |3 |4

my ($isgoods,$id,$pid,$name,$cost);

($isgoods,$id,$pid,$name,$cost) = @$list_ref;

if ($isgoods) {

$sth = $c->prepare ("update $tables:: goods set name=?,cost=? where id=? and pid=? and seller=?");

$count = $c->execute ($sth,$name,$cost,$id,$pid,$seller);

if (! $count || $count eq '0E0') {

$sth = $c->prepare ("insert into $tables:: goods (id,pid,name,cost, isGoods,seller) values (?,?,?,?,?,?)");

$c->execute ($sth,$id,$pid,$name,$cost,$isgoods,$seller);

}

} else {

$sth = $c->prepare ("update $tables:: goods set name=?,cost=?,pid=? where id=? and seller=? and pid=?");

$count = $c->execute ($sth,$name,$cost,$pid,$id,$seller,$pid);

if (! $count || $count eq '0E0') {

$sth = $c->prepare ("insert into $tables:: goods (id,pid,name,cost, isGoods,seller) values (?,?,?,?,?,?)");

$c->execute ($sth,$id,$pid,$name,$cost,$isgoods,$seller);

}

}

}

sub load_price {

my $mseller = shift;

my $line;

my @lines;

my @list;

my $from = $c->{cgi}->param ('start') || 0;

my $begintime = time;

my $endtime;

my $seller;

my $file;

my $sth;

if ($c->{cgi}->param ('load_oldi') || $c->{cgi}->param ('seller') eq 'o' || $mseller eq 'o') {

$seller = 'o';

$file = $files:: oldi_file;

} elsif ($c->{cgi}->param ('load_nix') || $c->{cgi}->param ('seller') eq 'n' || $mseller eq 'n') {

$seller = 'n';

$file = $files:: nix_file;

} elsif ($c->{cgi}->param ('load_stoik') || $c->{cgi}->param ('seller') eq 's' || $mseller eq 's') {

$seller = 's';

$file = $files:: stoik_file;

}

open (FILE, $file) || die "Не могу открыть $file";

@lines = <FILE>;

my $size = @lines;

my $i;

if (! $from) {

if ($seller eq 'o') {

$sth = $c->prepare ("delete from $tables:: goods where seller=?");

$c->execute ($sth,$seller);

} else {

$sth = $c->prepare ("update $tables:: goods set oldcost=cost,cost=0 where isgoods=? and cost>? and seller=?");

$c->execute ($sth,1,0,$seller);

}

}

for ($i = $from; $i < $size; $i++) {

$line = $lines [$i];

$endtime = time;

chomp ($line);

@list = split (/\|/,$line);

# isGood|ID|PID|NAME|PRICE

# 0 |1 |2 |3 |4

$list [4] =~ s/,/\. /;

if (! $list [4]) {

$list [4] = 0;

}

$list [3] =~ s/'/\\'/;

$list [3] =~ s/</&lt; /;

$list [3] =~ s/>/&gt; /;

addItem ($seller,\@list);

$endtime = time;

if ( ($endtime - $begintime) >= $max:: scripttime) {

$i++;

admin_set_status ("Добавлено". ($i+1)." из $size строк<br>");

admin_set_info ("Выгрузка прайса в базу ($seller)");

$mainpage->replaceContent ("meta","<meta http-equiv='refresh' content='3;

URL=$paths:: url? cmd=admin&cmd2=load_price&start=$i&seller=$seller'");

return;

}

}

goadmin ("Добавлено $i из $size строк<br>Обработка завершена!");

}

sub CreateSellerTree {

my $tree_items = "t. add ('root',0,'Поставщики товара','','',true); \n";

my $sth;

$tree_items. = "t. add ('o','root','OLDI','','',false, false, 'o'); \n";

$tree_items. = "t. add ('LoadO','o','Загрузка. ','','',false); \n";

$tree_items. = "t. add ('n','root','NIX','','',false, false, 'n'); \n";

$tree_items. = "t. add ('LoadN','n','Загрузка. ','','',false); \n";

$tree_items. = "t. add ('s','root','Стоик','','',false, false, 's'); \n";

$tree_items. = "t. add ('LoadS','s','Загрузка. ','','',false); \n";

$mainpage->replaceContent ("tree", $tree_items);

#$mainpage->replaceContent ("body", "onload='CreateTree () '");

}

sub getSettings {

my $name = shift || return 0;

my $sth;

$sth = $c->prepare ("select value from $tables:: settings where name=?");

$c->execute ($sth,$name);

my $value = $sth->fetchrow_array;

return $value;

}

sub setSettings {

my $name = shift || return 0;

my $value = shift || '';

my $sth;

$sth = $c->prepare ("update $tables:: settings set value=? where name=?");

my $count = $c->execute ($sth,$value,$name);

if (! $count || $count eq '0E0') {

$sth = $c->prepare ("insert into $tables:: settings (id,name,value) values (null,?,?)");

$c->execute ($sth,$name,$value);

}

sub welcome {

my $info = shift;

my $page = new template ("$paths:: root/welcome. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub aboutus {

my $info = shift;

my $page = new template ("$paths:: root/aboutus. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub order {

my $info = shift;

my $page = new template ("$paths:: root/order. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub buy {

my $info = shift;

my $page = new template ("$paths:: root/buy. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub deliver {

my $info = shift;

my $page = new template ("$paths:: root/deliver. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub uslugi {

my $info = shift;

my $page = new template ("$paths:: root/uslugi. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub menuhow {

my $info = shift;

my $page = new template ("$paths:: root/menu_how. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub basket {

my $info = shift;

my $page = new template ("$paths:: root/myaccountgoods_frame. htm",'ALL');

$page->replaceContent ("info",$info);

$page->clearAllTags ();

$page->print ();

}

sub sendmail {

my $script = shift;

my $page = new template ("$paths:: root/sendmail. htm",'ALL');

my $uid = $c->{uid};

my $goodscount = getCountGoodByUser ($uid);

my $sth;

my @out;

my $sum = 0;

my $class;

my $count;

my $curdate = strftime "%d. %m. %Y", localtime;

if ($goodscount) {

$sth = $c->prepare ("select t1. id,t1. number,t1. seller,t1. gid,t1. oldname,t2. name,t2. cost from $tables:: mygoods as t1

left join goods as t2 ON t1. gid = t2. id

and t1. pid = t2. pid

and t1. seller = t2. seller

where t1. uid =?");

$c->execute ($sth,$uid);

while (my ($id_,$number_,$seller_,$gid_,$oldname_,$name_,$cost_) = $sth->fetchrow_array) {

$sum = $sum + $cost_ * $number_;

$sum = sprintf ("%.2f", $sum);

$count += 1;

if (! $name_) {

$cost_ = 0;

$number_ = 0;

$name_ = "<span class='warning'>Товар с артикулом $seller_$gid_ не найден. ($oldname_) </span>";

}

if ($count & 1) {

$class ='even';

} else {

$class ='';

}

push @out, {

npp => $count,

class => $class,

sum => sprintf ("%.2f", ($cost_ * $number_)),

name => $name_,

cost => $cost_,

number => $number_,

id=>"$seller_$gid_",

};

}

$page->replaceLoopContent ("goodsloop", \@out);

} else {

$page->clearLoopTags ();

}

my $print = getSettings ($settings:: printcount);

$print++;

setSettings ($settings:: printcount,$print);

$page->replaceContent ("summa",$sum);

$page->replaceContent ("curdate",$curdate);

$page->replaceContent ("username",$c->{uname});

$page->clearAllTags ();

$page->print ();

}

}

exit (0);

daemon. pl

use LWP:: Simple;

use Archive:: Zip qw (: ERROR_CODES: CONSTANTS);

use Spreadsheet:: ParseExcel;

use Spreadsheet:: ParseExcel:: FmtUnicode;

use Net:: FTP;

use CGI:: Carp qw (carpout);

BEGIN {

use CGI:: Carp qw (carpout);

open (LOG, ">>error. log");

carpout (LOG);

}

close STDOUT;

open (STDOUT, ">>logfile. log");

STDOUT->autoflush (1);

$nixfile = 'c: \nix. zip';

$nixprice = 'ftp: // ftp2. nix.ru/download/price/Nix3. ZIP';

$oldifile = 'c: \oldi. zip';

$oldiprice = 'http://www.oldi.ru/price/oldipr. zip';

$extractpath = 'c: ';

$oldixls = $extractpath. '\OLDIPR. XLS';

$nixxls = $extractpath. '\NIX3. XLS';

$olditxt = $extractpath. '\oldi. txt';

$nixtxt = $extractpath. '\nix. txt';

$archive = $extractpath. '\archive. zip';

$ftphost = 'stoik.5gigs.com';

$ftpuser = 'stoi9984';

$ftppass = '111111';

$loadurl = 'http://stoik.5gigs.com/? cmd=loadprices&user=dmit&pass=777';

print "-== - Загрузка прайсов - ==-\n";