Annotation of register/prgsrc/register.cgi, revision 1.2
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.2 ! boris 23: $Date: 2001/09/03 21:45:32 $
1.1 boris 24:
25: =head1 REVISION
26:
1.2 ! boris 27: $Revision: 1.1 $
! 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: }
1.1 boris 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