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