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/04 19:33:18 $
24:
25: =head1 REVISION
26:
27: $Revision: 1.2 $
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: use FileHandle;
41:
42: setlocale(LC_CTYPE,'russian');
43:
44: my ($SENDMAIL) = "/usr/sbin/sendmail";
45: my $TO = 'borisv@lk.net';
46: my $FROM = 'borisv@lk.net';
47:
48: my $dbh = DBI->connect("DBI:mysql:chgk", "piataev", "")
49: or do {
50: print h1("Временные проблемы") . "База данных временно не
51: работает. Заходите попозже.";
52: print &Include_virtual("../dimrub/db/reklama.html");
53: print end_html;
54: die "Can't connect to DB chgk\n";
55: };
56:
57: print header;
58:
59:
60: ##################################################
61: # Printing top
62: ##################################################
63: print start_html(-"title"=>'Register of Clubs',
64: -author=>'borisv@lk.net',
65: -background=>"../images/map.jpg");
66: print &Include_virtual("../dimrub/db/reklama.html");
67: print <<END;
68: <table>
69: <tr>
70: <td background=../images/compass.gif valign=top>
71: END
72:
73: ################################################
74: # NAVIGATION PANEL
75: ################################################
76:
77: my $self=url();
78:
79:
80:
81: ###############################################
82: # The navigation panel has three special lines
83: ###############################################
84: print <<END;
85: <dl>
86: <dt><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></dt>
87: <dt><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></dt>
88: <dt><a href="$self?addclub=1">Добавить клуб</a></dt>
89: END
90:
91: #################################################
92: # And the navpanel itself
93: ##################################################
94:
95: print ListRegions(dbh=>$dbh,rid=>1,level=>1,tag=>'dt',
96: self=>$self);
97:
98: print <<END;
99: </dl>
100: END
101:
102:
103:
104: print <<END;
105: </td>
106: <td width=100% valign=top>
107: END
108:
109:
110: ######################################################
111: # MAIN PANEL
112: ######################################################
113:
114: #
115: # First, we introduce ourselves
116: #
117: print <<END;
118:
119: <h1 align=center><a href="http:/znatoki/klub/znat.html"><img
120: ismap border=0 src= "http:../images/logo.gif"
121: alt="Интернет Клуб Что? Где? Когда?" width=319 height=27></a>
122: <br>ПРЕДСТАВЛЯЕТ<br>
123: Реестр Клубов Интеллектуальных Игр
124: </h1>
125: END
126:
127: #
128: # Now check the parameters...
129: #
130: if (param('rid')) {
131: my $rid = param('rid');
132: $rid =~ s/(\d*)/$1/;
133: print ListRegions(dbh=>$dbh,rid=>$rid,
134: level=>param('level'),
135: clubs=>param('clubs'),
136: tag=>'h2',
137: self=>$self);
138: } elsif (param('cid')) {
139: my $cid = param('cid');
140: $cid =~ s/(\d*)/$1/;
141: print ClubInfo(dbh=>$dbh,cid=>$cid,
142: self=>$self);
143: } elsif (param('addclub')) {
144: print AddClub();
145: } elsif (param('Submit')) {
146: print SendLetter();
147: }
148:
149: print <<END;
150: </td>
151: </tr>
152: </table>
153: END
154:
155: print end_html;
156:
157: exit 0;
158:
159: ###################################################
160: # Parsing included file
161: ##################################################
162: sub Include_virtual {
163: my ($fn, $output) = (@_, '');
164:
165: open F , $fn
166: or return; #die "Can't open the file $fn: $!\n";
167:
168: while (<F>) {
169: if (/<!--#include/o) {
170: s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
171: }
172: if (/<!--#exec/o) {
173: s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
174: }
175: $output .= $_;
176: }
177: return $output;
178: }
179:
180:
181:
182: #############################################################
183: # Listing the given region and optionally its children
184: #############################################################
185:
186:
187: sub ListRegions {
188: my %args = @_;
189: my $sth = $args{'dbh'}->prepare("
190: SELECT Name FROM Regions WHERE RID=$args{'rid'}");
191: $sth->execute;
192: if (!$sth->rows) {
193: return "";
194: }
195: my ($name)=$sth->fetchrow_array;
196: $name="<a href=\"$self?rid=$args{'rid'}&level=1&clubs=1\">$name</a>";
197: my $result="<$args{'tag'}>$name</$args{'tag'}>\n";
198: if ($args{'level'}>0) { # Print children
199:
200: # Frist, we print clubs
201: if ($args{'clubs'}) {
202: $result .= ListClubs(%args);
203: }
204: $sth=$args{'dbh'}->prepare("
205: SELECT Child FROM RegionRegion WHERE Parent=$args{'rid'}");
206: $sth->execute;
207: if ($sth->rows) {
208: my @kids=();
209: while (my ($kid)=$sth->fetchrow_array) {
210: push @kids,"rid=$kid";
211: }
212: my $clause = join(' OR ', @kids);
213: $result .= "<dl>\n";
214: $sth=$args{'dbh'}->prepare("
215: SELECT rid FROM Regions WHERE $clause ORDER BY Name");
216: $sth->execute;
217: while (my ($kid)=$sth->fetchrow_array) {
218: $result .= ListRegions(
219: %args,'rid'=>$kid,
220: 'level'=>$args{'level'}-1,
221: 'tag'=>'dt');
222: }
223: }
224: }
225: return $result;
226: }
227:
228: ############################################################
229: # List the clubs of a given region
230: ###########################################################
231: sub ListClubs {
232: my %args = @_;
233: my $sth;
234: if ($args{'cid'}) {
235: $sth = $args{'dbh'}->prepare("
236: SELECT Child FROM ClubClub WHERE Parent=$args{'cid'}");
237: } else {
238: $sth = $args{'dbh'}->prepare("
239: SELECT cid FROM ClubRegion WHERE rid=$args{'rid'}");
240: }
241:
242: $sth->execute;
243:
244: if (!$sth->rows) {
245: return "";
246: }
247:
248: my $result;
249:
250: if ($args{'cid'}) {
251:
252: $result=<<END;
253: <h3>Клубы:</h3>
254: <dd><dl>\n
255: END
256: } else {
257:
258: $result=<<END;
259: <dl><dt>Клубы:</dt>
260: <dd><dl>\n
261: END
262: }
263: my @clubs=();
264: while (my ($club)=$sth->fetchrow_array) {
265: push @clubs,"cid=$club";
266: }
267: my $clause = join(' OR ', @clubs);
268: $sth=$args{'dbh'}->prepare("
269: SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name");
270: $sth->execute;
271: while (my ($cid,$Name)=$sth->fetchrow_array) {
272: $result .= dt("<a href=\"$self?cid=$cid\">$Name</a>\n");
273: }
274: $result .= "</dl></dd></dl>\n";
275: }
276:
277: #############################################################
278: # The longest subroutine in the list...
279: #############################################################
280: sub ClubInfo {
281: my %args = @_;
282: my $sth = $args{'dbh'}->prepare("
283: SELECT * FROM Clubs WHERE cid=$args{'cid'}");
284: $sth->execute;
285:
286: if (!$sth->rows) {
287: return "";
288: }
289:
290: my $result="";
291: my $club=$sth->fetchrow_hashref;
292: $result .= h2($club->{'Name'});
293:
294: if (my $string=$club->{'Address'}) {
295: $string =~ s/\n/<br>\n/g;
296: $result .= h3('Адрес')."\n".p($string);
297: }
298:
299: if (my $string=$club->{'URL'}) {
300: $string = htmlize($string);
301: $result .= h3('Домашняя страничка')."\n".p($string);
302: }
303:
304: if (my $string=$club->{'Phone'}) {
305: $result .= h3('Телефон')."\n".p($string);
306: }
307:
308: if (my $string=$club->{'Fax'}) {
309: $result .= h3('Факс')."\n".p($string);
310: }
311:
312: if (my $string=$club->{'Email'}) {
313: $string = htmlize($string,'mailto:');
314: $result .= h3('E-mail')."\n".p($string);
315: }
316:
317:
318: $result .= ListPeople(%args);
319:
320: $result .= ListClubs(%args);
321:
322: if (my $string=$club->{'DoB'}) {
323: $result .= h3('История создания клуба')."\n".p($string);
324: }
325:
326: if (my $string=$club->{'Sponsor'}) {
327: $result .= h3('Спонсор')."\n".p($string);
328: }
329:
330: if (my $string=$club->{'Meetings'}) {
331: $result .= h3('Форма деятельности клуба')."\n".p($string);
332: }
333:
334: if (my $string=$club->{'AdultTeams'}) {
335: $result .= h3('Взрослые команды')."\n".p($string);
336:
337: }
338:
339: if (my $string=$club->{'KidTeams'}) {
340: $result .= h3('Детские команды')."\n".p($string);
341:
342: }
343:
344: if (my $string=$club->{'ForeignFests'}) {
345: $result .= h3('Иногородние фестивали, традиционно посещаемые командами клуба')."\n".p($string);
346:
347: }
348:
349: if (my $string=$club->{'Braglist'}) {
350: $result .= h3('Высшие достижения команд клуба')."\n".p($string);
351:
352: }
353:
354: if (my $string=$club->{'OwnFests'}) {
355: $result .= h3('Фестивали, организуемые клубом')."\n".p($string);
356:
357: }
358:
359:
360: return $result;
361:
362: }
363:
364:
365: ##############################################################
366: # Adding a href=... The second optional argument may be
367: # 'mailto:'
368: ##############################################################
369:
370: sub htmlize {
371: my($string,$proto)=@_;
372: $string =~ s/^\s+//;
373: $string =~ s/\s+$//;
374: my @entities = split /\s+/, $string;
375: my @hrefs=map {"<a href=\"$proto$_\">$_</a>"} @entities;
376: return join(", ",@hrefs);
377: }
378:
379:
380: ##############################################################
381: # List the bosses....
382: ##############################################################
383: sub ListPeople {
384: my %args = @_;
385: my $sth = $args{'dbh'}->prepare("
386: SELECT pid,Position FROM ClubPeople WHERE cid=$args{'cid'} ORDER BY Weight DESC");
387: $sth->execute;
388:
389: if (!$sth->rows) {
390: return "";
391: }
392:
393: my $result=h3('Руководство');
394: while (my($pid,$Position)=$sth->fetchrow_array) {
395: $result .= h4($Position);
396: $result .= ListPerson(%args,pid=>$pid);
397: }
398: return $result;
399: }
400:
401: ##############################################################
402: # Listing one person
403: #############################################################
404: sub ListPerson {
405: my %args=@_;
406: my $sth = $args{'dbh'}->prepare("
407: SELECT * FROM People WHERE pid=$args{'pid'}");
408: $sth->execute;
409:
410: if (!$sth->rows) {
411: return "";
412: }
413:
414: my @entries=();
415: my $person=$sth->fetchrow_hashref;
416: if (my $string = $person->{'Name'}) {
417: push @entries, $string;
418: }
419: if (my $string=$person->{'Address'}) {
420: push @entries, "Адрес: $string";
421: }
422:
423: if (my $string=$person->{'URL'}) {
424: $string = htmlize($string);
425: push @entries, "Домашнаяя страничка: $string";
426: }
427:
428: if (my $string=$person->{'Phone'}) {
429: push @entries, "Телефон: $string";
430: }
431:
432: if (my $string=$person->{'Fax'}) {
433: push @entries, "Факс: $string";
434: }
435:
436: if (my $string=$person->{'Email'}) {
437: $string = htmlize($string,'mailto:');
438: push @entries, "E-mail: $string";
439: }
440:
441: return p(join('; ',@entries).".");
442:
443: }
444:
445:
446: #########################################################
447: # Adding club
448: #########################################################
449: sub AddClub {
450: my $result=h2("Добавить клуб или изменить информацию о клубе");
451:
452: $result .= <<END;
453: <p>
454: Спасибо за помощь в ведении реестра клубов.
455: Вы можете заполнить форму ниже или послать e-mail Борису Вейцману
456: по адресу <a href="mailto:borisv\@lk.net">borisv\@lk.net</a>
457: </p>
458: END
459: $result .= start_form;
460: $result .= table(Tr(td(["Название клуба",
461: textfield(-name=>'Name',
462: -size=>60)])),
463: Tr(td(["Официальный адрес клуба, если есть",
464: textarea(-name=>'Address',
465: -rows=>5,
466: -columns=>60)])),
467: Tr(td(["Страничка клуба, если есть",
468: textfield(-name=>'URL',
469: -size=>60)])),
470: Tr(td(["Телефон клуба, если есть",
471: textfield(-name=>'Phone',
472: -size=>60)])),
473: Tr(td(["Факс клуба, если есть",
474: textfield(-name=>'Fax',
475: -size=>60)])),
476: Tr(td(["E-mail клуба, если есть",
477: textfield(-name=>'Email',
478: -size=>60)])),
479: Tr(td(["Руководство клуба: должность, ФИО, ".
480: "адрес, телефон, факс, домашняя страница, e-mail",
481: textarea(-name=>'People',
482: -rows=>10,
483: -columns=>60)])),
484: Tr(td(["Ассоциации, членом котрых является клуб",
485: textarea(-name=>'Parents',
486: -rows=>5,
487: -columns=>60)])),
488: Tr(td(["Для ассоциаций: коллективные члены ассоциации",
489: textarea(-name=>'Members',
490: -rows=>5,
491: -columns=>60)])),
492: Tr(td(["История создания клуба",
493: textarea(-name=>'DoB',
494: -rows=>5,
495: -columns=>60)])),
496: Tr(td(["Основной спонсор клуба",
497: textarea(-name=>'Sponsor',
498: -rows=>5,
499: -columns=>60)])),
500: Tr(td(["Основные формы деятельности клуба",
501: textarea(-name=>'Meetings',
502: -rows=>5,
503: -columns=>60)])),
504: Tr(td(["Взрослые команды",
505: textarea(-name=>'AdultTeams',
506: -rows=>5,
507: -columns=>60)])),
508: Tr(td(["Детские команды",
509: textarea(-name=>'KidTeams',
510: -rows=>5,
511: -columns=>60)])),
512: Tr(td(["Иногородние фестивали, на которые ездят команды клуба",
513: textarea(-name=>'ForeignFests',
514: -rows=>5,
515: -columns=>60)])),
516: Tr(td(["Высшие достижения команд клуба",
517: textarea(-name=>'Braglist',
518: -rows=>5,
519: -columns=>60)])),
520: Tr(td(["Фестивали, которые организовывает клуб",
521: textarea(-name=>'OwnFests',
522: -rows=>5,
523: -columns=>60)])),
524: Tr(td(["Дополнительные вопросы: А) Что вам больше всего нравится в журнале 'Игра'?
525: Б) Что вам больше всего не нравится в журнале 'Игра'?
526: В) Что бы вы хотели увидеть в журнале 'Игра' - то чего нет в настоящее
527: время?",
528: textarea(-name=>'Igra',
529: -rows=>10,
530: -columns=>60)])),
531: );
532: $result .= submit(-name=>'Submit');
533: $result .= end_form;
534: return $result;
535: }
536:
537: ###################################################################
538: # Sending the letter with results
539: #####################################################################
540: sub SendLetter {
541: my $MAIL= new FileHandle("| $SENDMAIL -t -n");
542: print $MAIL <<END;
543: To: $TO
544: From: $FROM
545: Subject: Registracionnaya kartochka kluba
546: MIME-Version: 1.0
547: Content-type: text/plain; charset=koi8-r
548:
549: END
550: print $MAIL &CGI::dump;
551:
552: close $MAIL;
553: return p("Спасибо за регистрацию. Ваши данные приняты и после ".
554: "проверки будт внесены в базу данных");
555: }
556:
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