1: #!/usr/bin/perl
2:
3: =pod
4:
5: =head1 NAME
6:
7: register.cgi - a universal script for club regiter
8:
9: =head1 SYNOPSIS
10:
11: register.cgi?[I<options>]
12:
13: =head1 DESCRIPTION
14:
15: The script draws the hierarchy in the form suitable for WWW
16:
17: =head1 AUTHOR
18:
19: Boris Veytsman
20:
21: =head1 DATE
22:
23: $Date: 2002/12/25 21:36:01 $
24:
25: =head1 REVISION
26:
27: $Revision: 1.15 $
28:
29: =cut
30:
31:
32: ###################################################
33: # Starting up
34: ###################################################
35:
36: use strict;
37: use vars qw(%ENV);
38: use CGI qw(:standard);
39: use DBI;
40: use POSIX qw(locale_h);
41:
42: setlocale(LC_CTYPE,'russian');
43: $ENV{'LANG'}='ru_RU.KOI8-R';
44: my ($SENDMAIL) = "mail";
45: my $TO = 'borisv@lk.net, igra@gorlovka.net, erudit@mail.od.ua';
46: my $FROM = 'borisv@lk.net';
47:
48: my $date='$Date: 2002/12/25 21:36:01 $';
49: $date =~ s/[^ ]* ([^ ]*) .*/$1/;
50:
51:
52: my $dbh = DBI->connect("DBI:mysql:chgk", "piataev", "")
53: or do {
54: print h1("Временные проблемы") . "База данных временно не
55: работает. Заходите попозже.";
56: print &Include_virtual("../dimrub/db/reklama.html");
57: print end_html;
58: die "Can't connect to DB chgk\n";
59: };
60:
61: print header(-charset=>'koi8-r');
62:
63:
64: ##################################################
65: # Printing top
66: ##################################################
67: print start_html(-"title"=>'Register of Clubs',
68: -author=>'borisv@lk.net',
69: -background=>"../images/map.jpg");
70: print &Include_virtual("../dimrub/db/reklama.html");
71: print <<END;
72: <table>
73: <tr>
74: <td background=../images/compass.gif valign=top>
75: END
76:
77: ################################################
78: # NAVIGATION PANEL
79: ################################################
80:
81: my $self=url();
82:
83:
84:
85: ###############################################
86: # The navigation panel has three special lines
87: ###############################################
88: print <<END;
89: <ul>
90: <li><a href="$self">Home</a></li>
91: <li><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></li>
92: <li><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></li>
93: <li><a href="$self?addclub=1">Добавить клуб</a></li>
94: <li><a href="$self?whoiswho=1">Кто есть кто</a></li>
95: END
96:
97: #################################################
98: # And the navpanel itself
99: ##################################################
100:
101: print ListRegions(dbh=>$dbh,rid=>1,level=>1,tag=>'li',
102: self=>$self);
103:
104: print <<END;
105: </ul>
106: END
107:
108:
109:
110: print <<END;
111: </td>
112: <td width=100% valign=top>
113: END
114:
115:
116: ######################################################
117: # MAIN PANEL
118: ######################################################
119:
120: #
121: # First, we introduce ourselves
122: #
123: print <<END;
124:
125: <h1 align=center>
126: Журнал "Игра"<br>
127: и<br>
128: <a href="/znatoki/klub/znat.html"><img
129: ismap border=0 src= "../images/logo.gif"
130: alt="Интернет Клуб Что? Где? Когда?" width=319 height=27></a>
131: <br>ПРЕДСТАВЛЯЮТ<br>
132: Регистр Клубов Интеллектуальных Игр
133: </h1>
134: END
135:
136: #
137: # Now check the parameters...
138: #
139: if (param('rid')) {
140: my $rid = param('rid');
141: $rid =~ s/(\d*)/$1/;
142: print ListRegions(dbh=>$dbh,rid=>$rid,
143: level=>param('level'),
144: clubs=>param('clubs'),
145: tag=>'h2',
146: self=>$self);
147: } elsif (param('cid')) {
148: my $cid = param('cid');
149: $cid =~ s/(\d*)/$1/;
150: print ClubInfo(dbh=>$dbh,cid=>$cid,
151: self=>$self);
152: } elsif (param('pid')) {
153: my $pid = param('pid');
154: $pid =~ s/(\d*)/$1/;
155: print ListPerson(dbh=>$dbh,pid=>$pid,
156: self=>$self,
157: positions=>1,
158: displayperson=>1);
159: } elsif (param('whoiswho')) {
160: print PrintWhoIsWho(dbh=>$dbh,
161: self=>$self);
162: } elsif (param('addclub')) {
163: print AddClub();
164: } elsif (param('Submit')) {
165: print SendLetter();
166: } else {
167: print <<END;
168: <dl>
169: <dt><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></dt>
170: <dt><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></dt>
171: <dt><a href="$self?addclub=1">Добавить клуб или изменить сведения
172: о клубе</a></dt>
173: <dt><a href="$self?whoiswho=1">Кто есть кто</a></dt>
174: </dl>
175: <p align=center>
176: END
177: print &Include_virtual("../boris/register/regions.html");
178: print <<END;
179: </p>
180: END
181: }
182:
183: ####################################################################
184: # And the bottom of the page
185: ###################################################################
186: my $sth=$dbh->prepare("select count(*) from Clubs");
187: $sth->execute;
188: my ($count) = $sth->fetchrow_array;
189: $sth->finish;
190:
191: print "<p align=center>";
192: print "Всего клубов: $count</p>\n";
193:
194: print <<END;
195: <hr>
196: <address>
197: <img width = 60 height = 80 src="../images/owl.gif" alt = "owl">
198: <a href="http://users.lk.net/~borisv">
199: Boris Veytsman</a>, $date
200: </address>
201: </body>
202: </html>
203: END
204:
205:
206: print <<END;
207: </td>
208: </tr>
209: </table>
210: END
211:
212: print end_html;
213:
214: exit 0;
215:
216: ###################################################
217: # Parsing included file
218: ##################################################
219: sub Include_virtual {
220: my ($fn, $output) = (@_, '');
221:
222: open F , $fn
223: or return; #die "Can't open the file $fn: $!\n";
224:
225: while (<F>) {
226: if (/<!--#include/o) {
227: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
228: }
229: if (/<!--#exec/o) {
230: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
231: }
232: $output .= $_;
233: }
234: return $output;
235: }
236:
237:
238:
239: #############################################################
240: # Listing the given region and optionally its children
241: #############################################################
242:
243:
244: sub ListRegions {
245: my %args = @_;
246: my $sth = $args{'dbh'}->prepare("
247: SELECT Name FROM Regions WHERE RID=$args{'rid'}");
248: $sth->execute;
249: if (!$sth->rows) {
250: return "";
251: }
252: my ($name)=$sth->fetchrow_array;
253: $name="<a href=\"$self?rid=$args{'rid'}&level=100&clubs=1\">$name</a>";
254: my $result="<$args{'tag'}>$name</$args{'tag'}>\n";
255: if ($args{'level'}>0) { # Print children
256:
257: # Frist, we print clubs
258: if ($args{'clubs'}) {
259: $result .= ListRegionURLs(%args);
260: $result .= ListClubs(%args);
261: }
262: $sth=$args{'dbh'}->prepare("
263: SELECT Child FROM RegionRegion WHERE Parent=$args{'rid'}");
264: $sth->execute;
265: if ($sth->rows) {
266: my @kids=();
267: while (my ($kid)=$sth->fetchrow_array) {
268: push @kids,"rid=$kid";
269: }
270: my $clause = join(' OR ', @kids);
271: $result .= "<ul>\n";
272: $sth=$args{'dbh'}->prepare("
273: SELECT rid FROM Regions WHERE $clause ORDER BY Name");
274: $sth->execute;
275: while (my ($kid)=$sth->fetchrow_array) {
276: $result .= ListRegions(
277: %args,'rid'=>$kid,
278: 'level'=>$args{'level'}-1,
279: 'tag'=>'li');
280: }
281: $result .= "</ul>\n";
282: }
283: }
284: return $result;
285: }
286:
287: ############################################################
288: # List the URLs of a given region
289: ###########################################################
290: sub ListRegionURLs {
291: my %args = @_;
292: my $sth;
293: $sth = $args{'dbh'}->prepare("
294: SELECT URL FROM Regions WHERE rid=$args{'rid'} and NOT ISNULL(URL)");
295:
296: $sth->execute;
297:
298: if (!$sth->rows) {
299: return "";
300: }
301:
302: my $result;
303:
304: $result=<<END;
305: <dl><dt>Странички:</dt>
306: <dd><dl>\n
307: END
308:
309: while (my ($string)=$sth->fetchrow_array) {
310: $string=htmlize($string);
311: $result .= p($string);
312: }
313: $result .= "</dl></dd></dl>\n";
314: return $result;
315: }
316:
317:
318: ############################################################
319: # List the clubs of a given region or a given association
320: ###########################################################
321: sub ListClubs {
322: my %args = @_;
323: my $sth;
324: if ($args{'cid'}) {
325: $sth = $args{'dbh'}->prepare("
326: SELECT Child FROM ClubClub WHERE Parent=$args{'cid'}");
327: } else {
328: $sth = $args{'dbh'}->prepare("
329: SELECT cid FROM ClubRegion WHERE rid=$args{'rid'}");
330: }
331:
332: $sth->execute;
333:
334: if (!$sth->rows) {
335: return "";
336: }
337:
338: my $result;
339:
340: if ($args{'cid'}) {
341:
342: $result=<<END;
343: <h3>Клубы:</h3>
344: <ul>\n
345: END
346: } else {
347:
348: $result=<<END;
349: <ul>\n
350: END
351: }
352: my @clubs=();
353: while (my ($club)=$sth->fetchrow_array) {
354: push @clubs,"cid=$club";
355: }
356: my $clause = join(' OR ', @clubs);
357: $sth=$args{'dbh'}->prepare("
358: SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name");
359: $sth->execute;
360: while (my ($cid,$Name)=$sth->fetchrow_array) {
361: $result .= li("<a href=\"$self?cid=$cid\">$Name</a>\n");
362: }
363: $result .= "</ul>\n";
364: }
365:
366:
367: ############################################################
368: # List the association a given club belongs to
369: ###########################################################
370: sub ListParents {
371: my %args = @_;
372: my $sth;
373:
374: $sth = $args{'dbh'}->prepare("
375: SELECT Parent FROM ClubClub WHERE Child=$args{'cid'}");
376:
377: $sth->execute;
378:
379: if (!$sth->rows) {
380: return "";
381: }
382:
383: my $result;
384:
385: $result=<<END;
386: <h3>Коллективный член ассоциаций:</h3>
387: <dl>\n
388: END
389:
390: my @clubs=();
391: while (my ($club)=$sth->fetchrow_array) {
392: push @clubs,"cid=$club";
393: }
394: my $clause = join(' OR ', @clubs);
395: $sth=$args{'dbh'}->prepare("
396: SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name");
397: $sth->execute;
398: while (my ($cid,$Name)=$sth->fetchrow_array) {
399: $result .= dt("<a href=\"$self?cid=$cid\">$Name</a>\n");
400: }
401: $result .= "</dl></dd></dl>\n";
402: }
403:
404: #############################################################
405: # The longest subroutine in the list...
406: #############################################################
407: sub ClubInfo {
408: my %args = @_;
409: my $sth = $args{'dbh'}->prepare("
410: SELECT * FROM Clubs WHERE cid=$args{'cid'}");
411: $sth->execute;
412:
413: if (!$sth->rows) {
414: return "";
415: }
416:
417: my $result="";
418: my $club=$sth->fetchrow_hashref;
419: $result .= h2($club->{'Name'});
420:
421: if (my $string=$club->{'Address'}) {
422: $string =~ s/\n/<br>\n/g;
423: $result .= h3('Адрес')."\n".p($string);
424: }
425:
426: if (my $string=$club->{'URL'}) {
427: $string = htmlize($string);
428: $result .= h3('Домашняя страничка')."\n".p($string);
429: }
430:
431: if (my $string=$club->{'Phone'}) {
432: $result .= h3('Телефон')."\n".p($string);
433: }
434:
435: if (my $string=$club->{'Fax'}) {
436: $result .= h3('Факс')."\n".p($string);
437: }
438:
439: if (my $string=$club->{'Email'}) {
440: $string = htmlize($string,'mailto:');
441: $result .= h3('E-mail')."\n".p($string);
442: }
443:
444:
445: $result .= ListPeople(%args);
446:
447: $result .= ListParents(%args);
448:
449: $result .= ListClubs(%args);
450:
451:
452: if (my $string=$club->{'DoB'}) {
453: $result .= h3('История создания клуба')."\n".p($string);
454: }
455:
456: if (my $string=$club->{'Sponsor'}) {
457: $result .= h3('Спонсор')."\n".p($string);
458: }
459:
460: if (my $string=$club->{'Meetings'}) {
461: $result .= h3('Форма деятельности клуба')."\n".p($string);
462: }
463:
464: if (my $string=$club->{'AdultTeams'}) {
465: $result .= h3('Взрослые команды')."\n".p($string);
466:
467: }
468:
469: if (my $string=$club->{'KidTeams'}) {
470: $result .= h3('Детские команды')."\n".p($string);
471:
472: }
473:
474: if (my $string=$club->{'ForeignFests'}) {
475: $result .= h3('Иногородние фестивали, традиционно посещаемые командами клуба')."\n".p($string);
476:
477: }
478:
479: if (my $string=$club->{'Braglist'}) {
480: $result .= h3('Высшие достижения команд клуба')."\n".p($string);
481:
482: }
483:
484: if (my $string=$club->{'OwnFests'}) {
485: $result .= h3('Фестивали, организуемые клубом')."\n".p($string);
486:
487: }
488:
489:
490: return $result;
491:
492: }
493:
494:
495: ##############################################################
496: # Adding a href=... The second optional argument may be
497: # 'mailto:'
498: ##############################################################
499:
500: sub htmlize {
501: my($string,$proto)=@_;
502: $string =~ s/^\s+//;
503: $string =~ s/\s+$//;
504: my @entities = split /\s+/, $string;
505: my @hrefs=map {"<a href=\"$proto$_\">$_</a>"} @entities;
506: return join(", ",@hrefs);
507: }
508:
509:
510: ##############################################################
511: # List the bosses....
512: ##############################################################
513: sub ListPeople {
514: my %args = @_;
515: my $sth = $args{'dbh'}->prepare("
516: SELECT pid,Position FROM ClubPeople WHERE cid=$args{'cid'} ORDER BY Weight DESC");
517: $sth->execute;
518:
519: if (!$sth->rows) {
520: return "";
521: }
522:
523: my $result=h3('Руководство');
524: while (my($pid,$Position)=$sth->fetchrow_array) {
525: $result .= h4($Position);
526: $result .= ListPerson(%args,pid=>$pid);
527: }
528: return $result;
529: }
530:
531: ##############################################################
532: # Listing one person
533: #############################################################
534: sub ListPerson {
535: my %args=@_;
536: my $sth = $args{'dbh'}->prepare("
537: SELECT * FROM People WHERE pid=$args{'pid'}");
538: $sth->execute;
539:
540: if (!$sth->rows) {
541: return "";
542: }
543:
544: my $result="";
545: my @entries=();
546: my $person=$sth->fetchrow_hashref;
547: if (my $string = $person->{'Name'}) {
548: if ($args{'displayperson'}) {
549: $result=h2($string);
550: } else {
551: push @entries,
552: "<a href=\"$args{'self'}?pid=$args{'pid'}\">$string</a>";
553: }
554: }
555: if (my $string=$person->{'Address'}) {
556: push @entries, "Адрес: $string";
557: }
558:
559: if (my $string=$person->{'URL'}) {
560: $string = htmlize($string);
561: push @entries, "Домашняя страничка: $string";
562: }
563:
564: if (my $string=$person->{'Phone'}) {
565: push @entries, "Телефон: $string";
566: }
567:
568: if (my $string=$person->{'Fax'}) {
569: push @entries, "Факс: $string";
570: }
571:
572: if (my $string=$person->{'Email'}) {
573: $string = htmlize($string,'mailto:');
574: push @entries, "E-mail: $string";
575: }
576:
577: $result.=p(join('; ',@entries).".");
578: if ($args{'positions'}) {
579: my $sth=$dbh->prepare("SELECT cid,Position FROM ClubPeople
580: WHERE pid=$args{'pid'} ORDER by Weight");
581: $sth->execute;
582: $result .= "<dl>\n";
583: while (my ($cid,$Position)=$sth->fetchrow_array) {
584: my $sth1=$dbh->prepare("Select Name from Clubs where
585: cid=$cid");
586: $sth1->execute;
587: my ($Name)=$sth1->fetchrow_array;
588: $sth1->finish;
589: $result .= "<dd><strong>$Position,</strong> ";
590: $result .= "<a href=\"$args{self}?cid=$cid\">$Name</a></dd>\n";
591: }
592: $sth->finish;
593: $result .= "</dl>\n";
594: }
595: return $result;
596:
597: }
598:
599:
600: #########################################################
601: # Adding club
602: #########################################################
603: sub AddClub {
604: my $result=h2("Добавить клуб или изменить информацию о клубе");
605:
606:
607: $result .= start_form;
608:
609: $result .= h3("Контактная информация");
610: $result .= p("Адрес, телефон, email и т.д. ниже -- НЕ адреса руководства
611: клуба (их Вы введёте ниже),
612: а официальные адреса самого клуба. Если отдельного адреса,
613: телефона, и т.д. у клуба нет, просто оставьте
614: поля пустыми");
615: $result .= table(Tr(td(["Название клуба",
616: textfield(-name=>'Name',
617: -size=>60)])),
618: Tr(td(["Официальный адрес клуба",
619: textarea(-name=>'Address',
620: -rows=>5,
621: -columns=>60)])),
622: Tr(td(["Страничка клуба",
623: textfield(-name=>'URL',
624: -size=>60)])),
625: Tr(td(["Телефон клуба",
626: textfield(-name=>'Phone',
627: -size=>60)])),
628: Tr(td(["Факс клуба",
629: textfield(-name=>'Fax',
630: -size=>60)])),
631: Tr(td(["E-mail клуба",
632: textfield(-name=>'Email',
633: -size=>60)])),
634: );
635: $result .= h3("Руководство клуба");
636: $result .= p("Адреса и телефоны ниже будут опубликованы. Если Вы не хотите
637: афишировать чьи-то адреса и телефоны, просто оставьте соответствующие поля
638: пустыми");
639: $result .= "<ol>\n";
640: for(my $i=1;$i<=5;$i++) {
641: $result .=li;
642: $result .= table(
643:
644: Tr(td(["Должность",
645: textfield(-name=>"Position$i",
646: -size=>50)])),
647: Tr(td(["ФИО",
648: textfield(-name=>"Name$i",
649: -size=>50)])),
650: Tr(td(["Адрес",
651: textarea(-name=>"Address$i",
652: -columns=>50,
653: -rows=>5)])),
654: Tr(td(["Телефон",
655: textfield(-name=>"Phone$i",
656: -size=>50)])),
657: Tr(td(["Факс",
658: textfield(-name=>"Fax$i",
659: -size=>50)])),
660: Tr(td(["Email",
661: textfield(-name=>"Email$i",
662: -size=>50)])),
663: Tr(td(["Домашняя страничка",
664: textfield(-name=>"URL$i",
665: -size=>50)])),
666: );
667: }
668: $result .= "</ol>\n";
669: $result .= h3("Ассоциации и объединения");
670: $result .= table(
671: Tr(td(["Ассоциации, членом котрых является клуб",
672: textarea(-name=>'Parents',
673: -rows=>5,
674: -columns=>60)])),
675: Tr(td(["Для ассоциаций: коллективные члены ассоциации",
676: textarea(-name=>'Members',
677: -rows=>5,
678: -columns=>60)])),
679: );
680: $result .= h3("Жизнь клуба");
681: $result .= table(
682: Tr(td(["История создания клуба",
683: textarea(-name=>'DoB',
684: -rows=>5,
685: -columns=>60)])),
686: Tr(td(["Основной спонсор клуба",
687: textarea(-name=>'Sponsor',
688: -rows=>5,
689: -columns=>60)])),
690: Tr(td(["Основные формы деятельности клуба",
691: textarea(-name=>'Meetings',
692: -rows=>5,
693: -columns=>60)])),
694: Tr(td(["Взрослые команды",
695: textarea(-name=>'AdultTeams',
696: -rows=>5,
697: -columns=>60)])),
698: Tr(td(["Детские команды",
699: textarea(-name=>'KidTeams',
700: -rows=>5,
701: -columns=>60)])),
702: Tr(td(["Иногородние фестивали, на которые ездят команды клуба",
703: textarea(-name=>'ForeignFests',
704: -rows=>5,
705: -columns=>60)])),
706: Tr(td(["Высшие достижения команд клуба",
707: textarea(-name=>'Braglist',
708: -rows=>5,
709: -columns=>60)])),
710: Tr(td(["Фестивали, которые организовывает клуб",
711: textarea(-name=>'OwnFests',
712: -rows=>5,
713: -columns=>60)])),
714: );
715:
716: $result .= h3("География клуба (для будущей карты)");
717: $result .= table(
718: Tr(td(["Долгота",
719: textfield(-name=>"Longitude",
720: -size=> 60)])),
721: Tr(td(["Широта",
722: textfield(-name=>"Latitude",
723: -size=> 60)])),
724: );
725:
726: $result .= h3("Дополнительные вопросы");
727: $result .= table(
728:
729: Tr(td(["Что вам больше всего нравится в журнале 'Игра'?",
730: textarea(-name=>'IgraA',
731: -rows=>5,
732: -columns=>60)])),
733: Tr(td(["Что вам больше всего не нравится в журнале 'Игра'?",
734: textarea(-name=>'IgraB',
735: -rows=>5,
736: -columns=>60)])),
737: Tr(td(["Что бы вы хотели увидеть в журнале 'Игра' - то
738: чего нет в настоящее время?",
739: textarea(-name=>'IgraC',
740: -rows=>5,
741: -columns=>60)])),
742: );
743:
744: $result .= h3("Кто регистрировал");
745: $result .= table(
746: Tr(td(["Имя",
747: textfield(-name=>'RegistrarName',
748: -size=>60)])),
749: Tr(td(["Email",
750: textfield(-name=>'RegistrarEmail',
751: -size=>60)])),
752: );
753:
754: $result .= p("Нажав кнопку 'Submit', Вы отправите Вашу регистрационную
755: карточку службе поддержки регистра. Пожалуйста, подождите несколько дней, пока
756: Ваша информация будет обработана и попадёт в регистр");
757: $result .= submit(-name=>'Submit');
758: $result .= end_form;
759: return $result;
760: }
761:
762: ###################################################################
763: # Sending the letter with results
764: #####################################################################
765: sub SendLetter {
766: open(MAIL,"| $SENDMAIL -s 'Registracionnaya kartochka kluba' $TO");
767: print MAIL <<END;
768: MIME-Version: 1.0
769: Content-type: text/plain; charset=koi8-r
770:
771: END
772: foreach my $key (param) {
773: my $value = param($key);
774: if ($value =~ /^\s*$/) {
775: next;
776: }
777: print MAIL "$key=$value\n\n";
778: }
779:
780:
781: close MAIL;
782: return p("Спасибо за регистрацию. Ваши данные приняты и после ".
783: "обработки будут внесены в базу данных");
784: }
785:
786: ###############################################################
787: # Printing Who is Who list
788: ###############################################################
789: sub PrintWhoIsWho {
790: my %args =@_;
791: my $result = h2("Кто есть кто");
792: $result .= "\n<dl>\n";
793: my $sth = $dbh->prepare("SELECT pid,Name FROM People ORDER BY Name");
794: $sth->execute;
795: while (my($pid,$Name)=$sth->fetchrow_array) {
796: $result .= dd("<a href=\"$args{'self'}?pid=$pid\">$Name</a>");
797: $result .= "\n";
798: }
799: $sth->finish;
800: $result .= "</dl>\n";
801: return $result;
802: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>