version 1.1, 2001/09/03 21:45:32
|
version 1.4, 2001/09/11 20:19:42
|
Line 26 $Date$
|
Line 26 $Date$
|
|
|
$Revision$ |
$Revision$ |
|
|
=cut |
|
|
|
|
=cut |
|
|
|
|
|
################################################### |
|
# Starting up |
|
################################################### |
|
|
|
use strict; |
|
use CGI qw(:standard); |
|
use DBI; |
|
use POSIX qw(locale_h); |
|
|
|
setlocale(LC_CTYPE,'russian'); |
|
|
|
my ($SENDMAIL) = "/usr/sbin/sendmail"; |
|
my $TO = 'borisv@lk.net, igra@gorlovka.net'; |
|
my $FROM = 'borisv@lk.net'; |
|
|
|
my $date='$Date$'; |
|
$date =~ s/[^ ]* ([^ ]*) .*/$1/; |
|
|
|
|
|
my $dbh = DBI->connect("DBI:mysql:chgk", "piataev", "") |
|
or do { |
|
print h1("Временные проблемы") . "База данных временно не |
|
работает. Заходите попозже."; |
|
print &Include_virtual("../dimrub/db/reklama.html"); |
|
print end_html; |
|
die "Can't connect to DB chgk\n"; |
|
}; |
|
|
|
print header; |
|
|
|
|
|
################################################## |
|
# Printing top |
|
################################################## |
|
print start_html(-"title"=>'Register of Clubs', |
|
-author=>'borisv@lk.net', |
|
-background=>"../images/map.jpg"); |
|
print &Include_virtual("../dimrub/db/reklama.html"); |
|
print <<END; |
|
<table> |
|
<tr> |
|
<td background=../images/compass.gif valign=top> |
|
END |
|
|
|
################################################ |
|
# NAVIGATION PANEL |
|
################################################ |
|
|
|
my $self=url(); |
|
|
|
|
|
|
|
############################################### |
|
# The navigation panel has three special lines |
|
############################################### |
|
print <<END; |
|
<dl> |
|
<dt><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></dt> |
|
<dt><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></dt> |
|
<dt><a href="$self?addclub=1">Добавить клуб</a></dt> |
|
END |
|
|
|
################################################# |
|
# And the navpanel itself |
|
################################################## |
|
|
|
print ListRegions(dbh=>$dbh,rid=>1,level=>1,tag=>'dt', |
|
self=>$self); |
|
|
|
print <<END; |
|
</dl> |
|
END |
|
|
|
|
|
|
|
print <<END; |
|
</td> |
|
<td width=100% valign=top> |
|
END |
|
|
|
|
|
###################################################### |
|
# MAIN PANEL |
|
###################################################### |
|
|
|
# |
|
# First, we introduce ourselves |
|
# |
|
print <<END; |
|
|
|
<h1 align=center> |
|
Журнал "Игра"<br> |
|
и<br> |
|
<a href="http:/znatoki/klub/znat.html"><img |
|
ismap border=0 src= "http:../images/logo.gif" |
|
alt="Интернет Клуб Что? Где? Когда?" width=319 height=27></a> |
|
<br>ПРЕДСТАВЛЯЮТ<br> |
|
Регистр Клубов Интеллектуальных Игр |
|
</h1> |
|
END |
|
|
|
# |
|
# Now check the parameters... |
|
# |
|
if (param('rid')) { |
|
my $rid = param('rid'); |
|
$rid =~ s/(\d*)/$1/; |
|
print ListRegions(dbh=>$dbh,rid=>$rid, |
|
level=>param('level'), |
|
clubs=>param('clubs'), |
|
tag=>'h2', |
|
self=>$self); |
|
} elsif (param('cid')) { |
|
my $cid = param('cid'); |
|
$cid =~ s/(\d*)/$1/; |
|
print ClubInfo(dbh=>$dbh,cid=>$cid, |
|
self=>$self); |
|
} elsif (param('addclub')) { |
|
print AddClub(); |
|
} elsif (param('Submit')) { |
|
print SendLetter(); |
|
} else { |
|
print <<END; |
|
<dl> |
|
<dt><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></dt> |
|
<dt><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></dt> |
|
<dt><a href="$self?addclub=1">Добавить клуб или изменить сведения |
|
о клубе</a></dt> |
|
</dl> |
|
END |
|
} |
|
|
|
#################################################################### |
|
# And the bottom of the page |
|
################################################################### |
|
|
|
print "<p align=center>"; |
|
print "Эту страничку посмотрели "; |
|
print `/home/piataev/public_html/cgi-bin/counter.sh /znatoki/cgi-bin/register.cgi`; |
|
print " раз(а)</p>\n"; |
|
|
|
print <<END; |
|
<hr> |
|
<address> |
|
<img width = 60 height = 80 src="../images/owl.gif" alt = "owl"> |
|
<a href="http://users.lk.net/~borisv"> |
|
Boris Veytsman</a>, $date |
|
</address> |
|
</body> |
|
</html> |
|
END |
|
|
|
|
|
print <<END; |
|
</td> |
|
</tr> |
|
</table> |
|
END |
|
|
|
print end_html; |
|
|
|
exit 0; |
|
|
|
################################################### |
|
# Parsing included file |
|
################################################## |
|
sub Include_virtual { |
|
my ($fn, $output) = (@_, ''); |
|
|
|
open F , $fn |
|
or return; #die "Can't open the file $fn: $!\n"; |
|
|
|
while (<F>) { |
|
if (/<!--#include/o) { |
|
s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e; |
|
} |
|
if (/<!--#exec/o) { |
|
s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e; |
|
} |
|
$output .= $_; |
|
} |
|
return $output; |
|
} |
|
|
|
|
|
|
|
############################################################# |
|
# Listing the given region and optionally its children |
|
############################################################# |
|
|
|
|
|
sub ListRegions { |
|
my %args = @_; |
|
my $sth = $args{'dbh'}->prepare(" |
|
SELECT Name FROM Regions WHERE RID=$args{'rid'}"); |
|
$sth->execute; |
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
my ($name)=$sth->fetchrow_array; |
|
$name="<a href=\"$self?rid=$args{'rid'}&level=100&clubs=1\">$name</a>"; |
|
my $result="<$args{'tag'}>$name</$args{'tag'}>\n"; |
|
if ($args{'level'}>0) { # Print children |
|
|
|
# Frist, we print clubs |
|
if ($args{'clubs'}) { |
|
$result .= ListClubs(%args); |
|
} |
|
$sth=$args{'dbh'}->prepare(" |
|
SELECT Child FROM RegionRegion WHERE Parent=$args{'rid'}"); |
|
$sth->execute; |
|
if ($sth->rows) { |
|
my @kids=(); |
|
while (my ($kid)=$sth->fetchrow_array) { |
|
push @kids,"rid=$kid"; |
|
} |
|
my $clause = join(' OR ', @kids); |
|
$result .= "<dl>\n"; |
|
$sth=$args{'dbh'}->prepare(" |
|
SELECT rid FROM Regions WHERE $clause ORDER BY Name"); |
|
$sth->execute; |
|
while (my ($kid)=$sth->fetchrow_array) { |
|
$result .= ListRegions( |
|
%args,'rid'=>$kid, |
|
'level'=>$args{'level'}-1, |
|
'tag'=>'dt'); |
|
} |
|
$result .= "</dl>\n"; |
|
} |
|
} |
|
return $result; |
|
} |
|
|
|
############################################################ |
|
# List the clubs of a given region or a given association |
|
########################################################### |
|
sub ListClubs { |
|
my %args = @_; |
|
my $sth; |
|
if ($args{'cid'}) { |
|
$sth = $args{'dbh'}->prepare(" |
|
SELECT Child FROM ClubClub WHERE Parent=$args{'cid'}"); |
|
} else { |
|
$sth = $args{'dbh'}->prepare(" |
|
SELECT cid FROM ClubRegion WHERE rid=$args{'rid'}"); |
|
} |
|
|
|
$sth->execute; |
|
|
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
|
|
my $result; |
|
|
|
if ($args{'cid'}) { |
|
|
|
$result=<<END; |
|
<h3>Клубы:</h3> |
|
<dd><dl>\n |
|
END |
|
} else { |
|
|
|
$result=<<END; |
|
<dl><dt>Клубы:</dt> |
|
<dd><dl>\n |
|
END |
|
} |
|
my @clubs=(); |
|
while (my ($club)=$sth->fetchrow_array) { |
|
push @clubs,"cid=$club"; |
|
} |
|
my $clause = join(' OR ', @clubs); |
|
$sth=$args{'dbh'}->prepare(" |
|
SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name"); |
|
$sth->execute; |
|
while (my ($cid,$Name)=$sth->fetchrow_array) { |
|
$result .= dt("<a href=\"$self?cid=$cid\">$Name</a>\n"); |
|
} |
|
$result .= "</dl></dd></dl>\n"; |
|
} |
|
|
|
|
|
############################################################ |
|
# List the association a given club belongs to |
|
########################################################### |
|
sub ListParents { |
|
my %args = @_; |
|
my $sth; |
|
|
|
$sth = $args{'dbh'}->prepare(" |
|
SELECT Parent FROM ClubClub WHERE Child=$args{'cid'}"); |
|
|
|
$sth->execute; |
|
|
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
|
|
my $result; |
|
|
|
$result=<<END; |
|
<h3>Коллективный член ассоциаций:</h3> |
|
<dd><dl>\n |
|
END |
|
|
|
my @clubs=(); |
|
while (my ($club)=$sth->fetchrow_array) { |
|
push @clubs,"cid=$club"; |
|
} |
|
my $clause = join(' OR ', @clubs); |
|
$sth=$args{'dbh'}->prepare(" |
|
SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name"); |
|
$sth->execute; |
|
while (my ($cid,$Name)=$sth->fetchrow_array) { |
|
$result .= dt("<a href=\"$self?cid=$cid\">$Name</a>\n"); |
|
} |
|
$result .= "</dl></dd></dl>\n"; |
|
} |
|
|
|
############################################################# |
|
# The longest subroutine in the list... |
|
############################################################# |
|
sub ClubInfo { |
|
my %args = @_; |
|
my $sth = $args{'dbh'}->prepare(" |
|
SELECT * FROM Clubs WHERE cid=$args{'cid'}"); |
|
$sth->execute; |
|
|
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
|
|
my $result=""; |
|
my $club=$sth->fetchrow_hashref; |
|
$result .= h2($club->{'Name'}); |
|
|
|
if (my $string=$club->{'Address'}) { |
|
$string =~ s/\n/<br>\n/g; |
|
$result .= h3('Адрес')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'URL'}) { |
|
$string = htmlize($string); |
|
$result .= h3('Домашняя страничка')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'Phone'}) { |
|
$result .= h3('Телефон')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'Fax'}) { |
|
$result .= h3('Факс')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'Email'}) { |
|
$string = htmlize($string,'mailto:'); |
|
$result .= h3('E-mail')."\n".p($string); |
|
} |
|
|
|
|
|
$result .= ListPeople(%args); |
|
|
|
$result .= ListParents(%args); |
|
|
|
$result .= ListClubs(%args); |
|
|
|
|
|
if (my $string=$club->{'DoB'}) { |
|
$result .= h3('История создания клуба')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'Sponsor'}) { |
|
$result .= h3('Спонсор')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'Meetings'}) { |
|
$result .= h3('Форма деятельности клуба')."\n".p($string); |
|
} |
|
|
|
if (my $string=$club->{'AdultTeams'}) { |
|
$result .= h3('Взрослые команды')."\n".p($string); |
|
|
|
} |
|
|
|
if (my $string=$club->{'KidTeams'}) { |
|
$result .= h3('Детские команды')."\n".p($string); |
|
|
|
} |
|
|
|
if (my $string=$club->{'ForeignFests'}) { |
|
$result .= h3('Иногородние фестивали, традиционно посещаемые командами клуба')."\n".p($string); |
|
|
|
} |
|
|
|
if (my $string=$club->{'Braglist'}) { |
|
$result .= h3('Высшие достижения команд клуба')."\n".p($string); |
|
|
|
} |
|
|
|
if (my $string=$club->{'OwnFests'}) { |
|
$result .= h3('Фестивали, организуемые клубом')."\n".p($string); |
|
|
|
} |
|
|
|
|
|
return $result; |
|
|
|
} |
|
|
|
|
|
############################################################## |
|
# Adding a href=... The second optional argument may be |
|
# 'mailto:' |
|
############################################################## |
|
|
|
sub htmlize { |
|
my($string,$proto)=@_; |
|
$string =~ s/^\s+//; |
|
$string =~ s/\s+$//; |
|
my @entities = split /\s+/, $string; |
|
my @hrefs=map {"<a href=\"$proto$_\">$_</a>"} @entities; |
|
return join(", ",@hrefs); |
|
} |
|
|
|
|
|
############################################################## |
|
# List the bosses.... |
|
############################################################## |
|
sub ListPeople { |
|
my %args = @_; |
|
my $sth = $args{'dbh'}->prepare(" |
|
SELECT pid,Position FROM ClubPeople WHERE cid=$args{'cid'} ORDER BY Weight DESC"); |
|
$sth->execute; |
|
|
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
|
|
my $result=h3('Руководство'); |
|
while (my($pid,$Position)=$sth->fetchrow_array) { |
|
$result .= h4($Position); |
|
$result .= ListPerson(%args,pid=>$pid); |
|
} |
|
return $result; |
|
} |
|
|
|
############################################################## |
|
# Listing one person |
|
############################################################# |
|
sub ListPerson { |
|
my %args=@_; |
|
my $sth = $args{'dbh'}->prepare(" |
|
SELECT * FROM People WHERE pid=$args{'pid'}"); |
|
$sth->execute; |
|
|
|
if (!$sth->rows) { |
|
return ""; |
|
} |
|
|
|
my @entries=(); |
|
my $person=$sth->fetchrow_hashref; |
|
if (my $string = $person->{'Name'}) { |
|
push @entries, $string; |
|
} |
|
if (my $string=$person->{'Address'}) { |
|
push @entries, "Адрес: $string"; |
|
} |
|
|
|
if (my $string=$person->{'URL'}) { |
|
$string = htmlize($string); |
|
push @entries, "Домашнаяя страничка: $string"; |
|
} |
|
|
|
if (my $string=$person->{'Phone'}) { |
|
push @entries, "Телефон: $string"; |
|
} |
|
|
|
if (my $string=$person->{'Fax'}) { |
|
push @entries, "Факс: $string"; |
|
} |
|
|
|
if (my $string=$person->{'Email'}) { |
|
$string = htmlize($string,'mailto:'); |
|
push @entries, "E-mail: $string"; |
|
} |
|
|
|
return p(join('; ',@entries)."."); |
|
|
|
} |
|
|
|
|
|
######################################################### |
|
# Adding club |
|
######################################################### |
|
sub AddClub { |
|
my $result=h2("Добавить клуб или изменить информацию о клубе"); |
|
|
|
|
|
$result .= start_form; |
|
|
|
$result .= h3("Контактная информация"); |
|
$result .= p("Адрес, телефон, email и т.д. ниже -- НЕ адреса руководства |
|
клуба (их Вы введёте ниже), |
|
а официальные адреса самого клуба. Если отдельного адреса, |
|
телефона, и т.д. у клуба нет, просто оставьте |
|
поля пустыми"); |
|
$result .= table(Tr(td(["Название клуба", |
|
textfield(-name=>'Name', |
|
-size=>60)])), |
|
Tr(td(["Официальный адрес клуба", |
|
textarea(-name=>'Address', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Страничка клуба", |
|
textfield(-name=>'URL', |
|
-size=>60)])), |
|
Tr(td(["Телефон клуба", |
|
textfield(-name=>'Phone', |
|
-size=>60)])), |
|
Tr(td(["Факс клуба", |
|
textfield(-name=>'Fax', |
|
-size=>60)])), |
|
Tr(td(["E-mail клуба", |
|
textfield(-name=>'Email', |
|
-size=>60)])), |
|
); |
|
$result .= h3("Руководство клуба"); |
|
$result .= p("Адреса и телефоны ниже будут опубликованы. Если Вы не хотите |
|
афишировать чьи-то адреса и телефоны, просто оставьте соответствующие поля |
|
пустыми"); |
|
$result .= "<ol>\n"; |
|
for(my $i=1;$i<=5;$i++) { |
|
$result .=li; |
|
$result .= table( |
|
|
|
Tr(td(["Должность", |
|
textfield(-name=>"Position$i", |
|
-size=>50)])), |
|
Tr(td(["ФИО", |
|
textfield(-name=>"Name$i", |
|
-size=>50)])), |
|
Tr(td(["Адрес", |
|
textarea(-name=>"Address$i", |
|
-columns=>50, |
|
-rows=>5)])), |
|
Tr(td(["Телефон", |
|
textfield(-name=>"Phone$i", |
|
-size=>50)])), |
|
Tr(td(["Факс", |
|
textfield(-name=>"Fax$i", |
|
-size=>50)])), |
|
Tr(td(["Email", |
|
textfield(-name=>"Email$i", |
|
-size=>50)])), |
|
Tr(td(["Домашняя страничка", |
|
textfield(-name=>"URL$i", |
|
-size=>50)])), |
|
); |
|
} |
|
$result .= "</ol>\n"; |
|
$result .= h3("Ассоциации и объединения"); |
|
$result .= table( |
|
Tr(td(["Ассоциации, членом котрых является клуб", |
|
textarea(-name=>'Parents', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Для ассоциаций: коллективные члены ассоциации", |
|
textarea(-name=>'Members', |
|
-rows=>5, |
|
-columns=>60)])), |
|
); |
|
$result .= h3("Жизнь клуба"); |
|
$result .= table( |
|
Tr(td(["История создания клуба", |
|
textarea(-name=>'DoB', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Основной спонсор клуба", |
|
textarea(-name=>'Sponsor', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Основные формы деятельности клуба", |
|
textarea(-name=>'Meetings', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Взрослые команды", |
|
textarea(-name=>'AdultTeams', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Детские команды", |
|
textarea(-name=>'KidTeams', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Иногородние фестивали, на которые ездят команды клуба", |
|
textarea(-name=>'ForeignFests', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Высшие достижения команд клуба", |
|
textarea(-name=>'Braglist', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Фестивали, которые организовывает клуб", |
|
textarea(-name=>'OwnFests', |
|
-rows=>5, |
|
-columns=>60)])), |
|
); |
|
|
|
$result .= h3("География клуба (для будущей карты)"); |
|
$result .= table( |
|
Tr(td(["Долгота", |
|
textfield(-name=>"Longitude", |
|
-size=> 60)])), |
|
Tr(td(["Широта", |
|
textfield(-name=>"Latitude", |
|
-size=> 60)])), |
|
); |
|
|
|
$result .= h3("Дополнительные вопросы"); |
|
$result .= table( |
|
|
|
Tr(td(["Что вам больше всего нравится в журнале 'Игра'?", |
|
textarea(-name=>'IgraA', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Что вам больше всего не нравится в журнале 'Игра'?", |
|
textarea(-name=>'IgraB', |
|
-rows=>5, |
|
-columns=>60)])), |
|
Tr(td(["Что бы вы хотели увидеть в журнале 'Игра' - то |
|
чего нет в настоящее время?", |
|
textarea(-name=>'IgraC', |
|
-rows=>5, |
|
-columns=>60)])), |
|
); |
|
|
|
$result .= p("Нажав кнопку 'Submit', Вы отправите Вашу регистрационную |
|
карточку службе поддержки регистра. Пожалуйста, подождите несколько дней, пока |
|
Ваша информация будет обработана и попадёт в регистр"); |
|
$result .= submit(-name=>'Submit'); |
|
$result .= end_form; |
|
return $result; |
|
} |
|
|
|
################################################################### |
|
# Sending the letter with results |
|
##################################################################### |
|
sub SendLetter { |
|
open(MAIL,"| $SENDMAIL -t -n"); |
|
print MAIL <<END; |
|
To: $TO |
|
From: $FROM |
|
Subject: Registracionnaya kartochka kluba |
|
MIME-Version: 1.0 |
|
Content-type: text/plain; charset=koi8-r |
|
|
|
END |
|
foreach my $key (param) { |
|
my $value = param($key); |
|
if ($value =~ /^\s*$/) { |
|
next; |
|
} |
|
print MAIL "$key=$value\n\n"; |
|
} |
|
|
|
|
|
close MAIL; |
|
return p("Спасибо за регистрацию. Ваши данные приняты и после ". |
|
"обработки будут внесены в базу данных"); |
|
} |
|
|