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