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