#!/usr/bin/perl
=pod
=head1 NAME
register.cgi - a universal script for club regiter
=head1 SYNOPSIS
register.cgi?[I<options>]
=head1 DESCRIPTION
The script draws the hierarchy in the form suitable for WWW
=head1 AUTHOR
Boris Veytsman
=head1 DATE
$Date: 2001/09/04 19:33:18 $
=head1 REVISION
$Revision: 1.2 $
=cut
###################################################
# Starting up
###################################################
use strict;
use CGI qw(:standard);
use DBI;
use POSIX qw(locale_h);
use FileHandle;
setlocale(LC_CTYPE,'russian');
my ($SENDMAIL) = "/usr/sbin/sendmail";
my $TO = 'borisv@lk.net';
my $FROM = 'borisv@lk.net';
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><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();
}
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=1&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');
}
}
}
return $result;
}
############################################################
# List the clubs of a given region
###########################################################
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";
}
#############################################################
# 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 .= 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 .= <<END;
<p>
Спасибо за помощь в ведении реестра клубов.
Вы можете заполнить форму ниже или послать e-mail Борису Вейцману
по адресу <a href="mailto:borisv\@lk.net">borisv\@lk.net</a>
</p>
END
$result .= start_form;
$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)])),
Tr(td(["Руководство клуба: должность, ФИО, ".
"адрес, телефон, факс, домашняя страница, e-mail",
textarea(-name=>'People',
-rows=>10,
-columns=>60)])),
Tr(td(["Ассоциации, членом котрых является клуб",
textarea(-name=>'Parents',
-rows=>5,
-columns=>60)])),
Tr(td(["Для ассоциаций: коллективные члены ассоциации",
textarea(-name=>'Members',
-rows=>5,
-columns=>60)])),
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)])),
Tr(td(["Дополнительные вопросы: А) Что вам больше всего нравится в журнале 'Игра'?
Б) Что вам больше всего не нравится в журнале 'Игра'?
В) Что бы вы хотели увидеть в журнале 'Игра' - то чего нет в настоящее
время?",
textarea(-name=>'Igra',
-rows=>10,
-columns=>60)])),
);
$result .= submit(-name=>'Submit');
$result .= end_form;
return $result;
}
###################################################################
# Sending the letter with results
#####################################################################
sub SendLetter {
my $MAIL= new FileHandle("| $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
print $MAIL &CGI::dump;
close $MAIL;
return p("Спасибо за регистрацию. Ваши данные приняты и после ".
"проверки будт внесены в базу данных");
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>