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