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