#!/usr/bin/perl =pod =head1 NAME register.cgi - a universal script for club regiter =head1 SYNOPSIS register.cgi?[I] =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 ################################################ # NAVIGATION PANEL ################################################ my $self=url(); ############################################### # The navigation panel has three special lines ############################################### print <
Все регионы
Все клубы
Добавить клуб
END ################################################# # And the navpanel itself ################################################## print ListRegions(dbh=>$dbh,rid=>1,level=>1,tag=>'dt', self=>$self); print < END print < END ###################################################### # MAIN PANEL ###################################################### # # First, we introduce ourselves # print <Интернет Клуб Что? Где? Когда?
ПРЕДСТАВЛЯЕТ
Реестр Клубов Интеллектуальных Игр 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 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 () { if (//&Include_virtual($1)/e; } if (//`$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="$name"; my $result="<$args{'tag'}>$name\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 .= "
\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=<Клубы:
\n END } else { $result=<
Клубы:
\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("$Name\n"); } $result .= "
\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/
\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 {"$_"} @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 .= < Спасибо за помощь в ведении реестра клубов. Вы можете заполнить форму ниже или послать e-mail Борису Вейцману по адресу borisv\@lk.net

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 <