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