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