[BACK]Return to register.cgi CVS log [TXT] [DIR] Up to [Local Repository] / register / prgsrc

Diff for /register/prgsrc/register.cgi between versions 1.1 and 1.2

version 1.1, 2001/09/03 21:45:32 version 1.2, 2001/09/04 19:33:18
Line 26  $Date$ Line 26  $Date$
   
 $Revision$  $Revision$
   
 =cut  
   
   =cut
   
   
   ###################################################
   # Starting up
   ###################################################
   
       use strict;
   use CGI qw(:standard);
   use DBI;
   use POSIX qw(locale_h);
   use FileHandle;
   
   setlocale(LC_CTYPE,'russian');
   
   my ($SENDMAIL) = "/usr/sbin/sendmail";
   my $TO = 'borisv@lk.net';
   my $FROM = 'borisv@lk.net';
   
   my $dbh = DBI->connect("DBI:mysql:chgk", "piataev", "")
       or do {
           print h1("Временные проблемы") . "База данных временно не
                           работает. Заходите попозже.";
           print &Include_virtual("../dimrub/db/reklama.html");
           print end_html;
           die "Can't connect to DB chgk\n";
       };
   
   print header;
   
   
   ##################################################
   # Printing top
   ##################################################
   print start_html(-"title"=>'Register of Clubs',
                    -author=>'borisv@lk.net',
                    -background=>"../images/map.jpg");
   print &Include_virtual("../dimrub/db/reklama.html");
   print <<END;
   <table>
   <tr>
   <td background=../images/compass.gif valign=top>
   END
   
   ################################################
   # NAVIGATION PANEL
   ################################################
       
   my $self=url();
   
   
   
   ###############################################
   # The navigation panel has three special lines
   ###############################################
   print <<END;
   <dl>
   <dt><a href="$self?rid=1&level=1000&clubs=0">Все регионы</a></dt>
   <dt><a href="$self?rid=1&level=1000&clubs=1">Все клубы</a></dt>
   <dt><a href="$self?addclub=1">Добавить клуб</a></dt>
   END
   
   #################################################
   # And the navpanel itself
   ##################################################
   
       print ListRegions(dbh=>$dbh,rid=>1,level=>1,tag=>'dt',
                         self=>$self);
       
   print <<END;
   </dl>
   END
   
   
   
       print <<END;
   </td>
   <td width=100% valign=top>
   END
   
   
   ######################################################
   #        MAIN PANEL
   ######################################################
   
   #
   # First, we introduce ourselves
   #
       print <<END;
   
   <h1 align=center><a href="http:/znatoki/klub/znat.html"><img 
   ismap border=0 src= "http:../images/logo.gif" 
   alt="Интернет Клуб Что? Где? Когда?" width=319 height=27></a>
   <br>ПРЕДСТАВЛЯЕТ<br>
   Реестр Клубов Интеллектуальных Игр
   </h1>
   END
   
   #
   # Now check the parameters...
   #
       if (param('rid')) {
           my $rid = param('rid');
           $rid =~ s/(\d*)/$1/;
           print ListRegions(dbh=>$dbh,rid=>$rid,
                             level=>param('level'),
                             clubs=>param('clubs'),
                             tag=>'h2',
                             self=>$self);
       } elsif (param('cid')) {
           my $cid = param('cid');
           $cid =~ s/(\d*)/$1/;
           print ClubInfo(dbh=>$dbh,cid=>$cid,
                          self=>$self);
       } elsif (param('addclub')) {
           print AddClub();
       } elsif (param('Submit')) {
           print SendLetter();
       }
   
       print <<END;
   </td>
   </tr>
   </table>
   END
   
   print end_html;
   
   exit 0;
   
   ###################################################
   # Parsing included file
   ##################################################
   sub Include_virtual {
       my ($fn, $output) = (@_, '');
       
       open F , $fn
           or return; #die "Can't open the file $fn: $!\n";
       
       while (<F>) {
           if (/<!--#include/o) {
               s/<!--#include virtual="\/(.*)" -->/&Include_virtual($1)/e;
           }
           if (/<!--#exec/o) {
               s/<!--#exec.*cmd\s*=\s*"([^"]*)".*-->/`$1`/e;
           }
           $output .= $_;
       }
       return $output;
   }
   
   
   
   #############################################################
   # Listing the given region and optionally its children
   #############################################################
   
   
   sub ListRegions {
       my %args = @_;
       my $sth = $args{'dbh'}->prepare("
   SELECT Name FROM Regions WHERE RID=$args{'rid'}");
       $sth->execute;
       if (!$sth->rows) {
           return "";
       }
       my ($name)=$sth->fetchrow_array;
       $name="<a href=\"$self?rid=$args{'rid'}&level=1&clubs=1\">$name</a>";
       my $result="<$args{'tag'}>$name</$args{'tag'}>\n";
       if ($args{'level'}>0) { # Print children
   
           # Frist, we print clubs
           if ($args{'clubs'}) {
               $result .= ListClubs(%args);
           }
           $sth=$args{'dbh'}->prepare("
   SELECT Child FROM RegionRegion WHERE Parent=$args{'rid'}");
           $sth->execute;
           if ($sth->rows) {
               my @kids=();
               while (my ($kid)=$sth->fetchrow_array) {
                   push @kids,"rid=$kid";
               }
               my $clause = join(' OR ', @kids);
               $result .= "<dl>\n";
               $sth=$args{'dbh'}->prepare("
   SELECT rid FROM Regions WHERE $clause ORDER BY Name");
               $sth->execute;
               while (my ($kid)=$sth->fetchrow_array) {
                   $result .= ListRegions(
                                          %args,'rid'=>$kid,
                                          'level'=>$args{'level'}-1,
                                          'tag'=>'dt');
               }
           }
       }
       return $result;
   }
   
   ############################################################
   # List the clubs of a given region
   ###########################################################
   sub ListClubs {
       my %args = @_;
       my $sth;
       if ($args{'cid'}) {
           $sth = $args{'dbh'}->prepare("
   SELECT Child FROM ClubClub WHERE Parent=$args{'cid'}");
       } else {
           $sth = $args{'dbh'}->prepare("
   SELECT cid FROM ClubRegion WHERE rid=$args{'rid'}");
       }
   
       $sth->execute;
           
       if (!$sth->rows) {
           return "";
       }
       
       my $result;
           
       if ($args{'cid'}) {
   
           $result=<<END;
   <h3>Клубы:</h3>
   <dd><dl>\n
   END
        } else {
    
            $result=<<END;
   <dl><dt>Клубы:</dt>
   <dd><dl>\n
   END
       }
       my @clubs=();
       while (my ($club)=$sth->fetchrow_array) {
           push @clubs,"cid=$club";
       }
       my $clause = join(' OR ', @clubs);
       $sth=$args{'dbh'}->prepare("
   SELECT cid, Name FROM Clubs WHERE $clause ORDER BY Name");
       $sth->execute;
       while (my ($cid,$Name)=$sth->fetchrow_array) {
           $result .= dt("<a href=\"$self?cid=$cid\">$Name</a>\n");
       }
       $result .= "</dl></dd></dl>\n";
   }
   
   #############################################################
   # The longest subroutine in the list...
   #############################################################
   sub ClubInfo {
       my %args = @_;
       my $sth = $args{'dbh'}->prepare("
   SELECT * FROM Clubs WHERE cid=$args{'cid'}");
       $sth->execute;
   
       if (!$sth->rows) {
           return "";
       }
       
       my $result="";
       my $club=$sth->fetchrow_hashref;
       $result .= h2($club->{'Name'});
   
       if (my $string=$club->{'Address'}) {
           $string =~ s/\n/<br>\n/g;
           $result .= h3('Адрес')."\n".p($string);
       }
   
       if (my $string=$club->{'URL'}) {
           $string = htmlize($string);
           $result .= h3('Домашняя страничка')."\n".p($string);
       }
   
       if (my $string=$club->{'Phone'}) {
           $result .= h3('Телефон')."\n".p($string);
       }
   
       if (my $string=$club->{'Fax'}) {
           $result .= h3('Факс')."\n".p($string);
       }
   
       if (my $string=$club->{'Email'}) {
           $string = htmlize($string,'mailto:');
           $result .= h3('E-mail')."\n".p($string);
       }
   
   
       $result .= ListPeople(%args); 
   
       $result .= ListClubs(%args); 
   
       if (my $string=$club->{'DoB'}) {
           $result .= h3('История создания клуба')."\n".p($string);
       }
   
       if (my $string=$club->{'Sponsor'}) {
           $result .= h3('Спонсор')."\n".p($string);
       }
   
       if (my $string=$club->{'Meetings'}) {
           $result .= h3('Форма деятельности клуба')."\n".p($string);
       }
   
       if (my $string=$club->{'AdultTeams'}) {
           $result .= h3('Взрослые команды')."\n".p($string);
       
       }
   
       if (my $string=$club->{'KidTeams'}) {
           $result .= h3('Детские команды')."\n".p($string);
       
       }
   
       if (my $string=$club->{'ForeignFests'}) {
           $result .= h3('Иногородние фестивали, традиционно посещаемые командами клуба')."\n".p($string);
       
       }
   
       if (my $string=$club->{'Braglist'}) {
           $result .= h3('Высшие достижения команд клуба')."\n".p($string);
       
       }
   
       if (my $string=$club->{'OwnFests'}) {
           $result .= h3('Фестивали, организуемые клубом')."\n".p($string);
       
       }
   
   
       return $result;
   
   }
   
   
   ##############################################################
   # Adding a href=... The second optional argument may be 
   # 'mailto:'
   ##############################################################
   
   sub htmlize {
       my($string,$proto)=@_;
       $string =~ s/^\s+//;
       $string =~ s/\s+$//;
       my @entities = split /\s+/, $string;
       my @hrefs=map {"<a href=\"$proto$_\">$_</a>"} @entities;
       return join(", ",@hrefs);
   }
   
   
   ##############################################################
   # List the bosses....
   ##############################################################
   sub ListPeople {
       my %args = @_;
       my $sth = $args{'dbh'}->prepare("
   SELECT pid,Position FROM ClubPeople WHERE cid=$args{'cid'} ORDER BY Weight DESC");
       $sth->execute;
   
       if (!$sth->rows) {
           return "";
       }
   
       my $result=h3('Руководство');
       while (my($pid,$Position)=$sth->fetchrow_array) {
           $result .= h4($Position);
           $result .= ListPerson(%args,pid=>$pid);
       }
       return $result;
   }
   
   ##############################################################
   # Listing one person
   #############################################################
   sub ListPerson {
       my %args=@_;
       my $sth = $args{'dbh'}->prepare("
   SELECT * FROM People WHERE pid=$args{'pid'}");
       $sth->execute;
   
       if (!$sth->rows) {
           return "";
       }
   
       my @entries=();
       my $person=$sth->fetchrow_hashref;
       if (my $string = $person->{'Name'}) {
           push @entries, $string;
       }
       if (my $string=$person->{'Address'}) {
           push @entries, "Адрес: $string";
       }
   
       if (my $string=$person->{'URL'}) {
           $string = htmlize($string);
           push @entries, "Домашнаяя страничка: $string";
       }
   
       if (my $string=$person->{'Phone'}) {
           push @entries, "Телефон: $string";
       }
   
       if (my $string=$person->{'Fax'}) {
           push @entries, "Факс: $string";
       }
   
       if (my $string=$person->{'Email'}) {
           $string = htmlize($string,'mailto:');
           push @entries, "E-mail: $string";
       }
   
       return p(join('; ',@entries).".");
   
   }
   
   
   #########################################################
   # Adding club
   #########################################################
   sub AddClub {
       my $result=h2("Добавить клуб или изменить информацию о клубе");
       
       $result .= <<END;
   <p>
   Спасибо за помощь в ведении реестра клубов. 
   Вы можете заполнить форму ниже или послать e-mail Борису Вейцману
   по адресу <a href="mailto:borisv\@lk.net">borisv\@lk.net</a>
   </p>
   END
       $result .= start_form;
       $result .= table(Tr(td(["Название клуба",
                               textfield(-name=>'Name',
                                      -size=>60)])),
                        Tr(td(["Официальный адрес клуба, если есть",
                               textarea(-name=>'Address',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Страничка клуба, если есть",
                               textfield(-name=>'URL',
                                        -size=>60)])),
                        Tr(td(["Телефон клуба, если есть",
                               textfield(-name=>'Phone',
                                        -size=>60)])),
                        Tr(td(["Факс клуба, если есть",
                               textfield(-name=>'Fax',
                                        -size=>60)])),
                        Tr(td(["E-mail клуба, если есть",
                               textfield(-name=>'Email',
                                        -size=>60)])),
                        Tr(td(["Руководство клуба: должность, ФИО, ".
                               "адрес, телефон, факс, домашняя страница, e-mail",
                               textarea(-name=>'People',
                                        -rows=>10,
                                        -columns=>60)])),
                        Tr(td(["Ассоциации, членом котрых является клуб",
                               textarea(-name=>'Parents',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Для ассоциаций: коллективные члены ассоциации",
                               textarea(-name=>'Members',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["История создания клуба",
                               textarea(-name=>'DoB',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Основной спонсор клуба",
                               textarea(-name=>'Sponsor',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Основные формы деятельности клуба",
                               textarea(-name=>'Meetings',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Взрослые команды",
                               textarea(-name=>'AdultTeams',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Детские команды",
                               textarea(-name=>'KidTeams',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Иногородние фестивали, на которые ездят команды клуба",
                               textarea(-name=>'ForeignFests',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Высшие достижения команд клуба",
                               textarea(-name=>'Braglist',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Фестивали, которые организовывает клуб",
                               textarea(-name=>'OwnFests',
                                        -rows=>5,
                                        -columns=>60)])),
                        Tr(td(["Дополнительные вопросы: А) Что вам больше всего нравится в журнале 'Игра'?
   Б) Что вам больше всего не нравится в журнале 'Игра'?
   В) Что бы вы хотели увидеть в журнале 'Игра' - то чего нет в настоящее
   время?",
                               textarea(-name=>'Igra',
                                        -rows=>10,
                                        -columns=>60)])),
                        );
       $result .= submit(-name=>'Submit');
       $result .= end_form;
       return $result;
   }
   
   ###################################################################
   # Sending the letter with results
   #####################################################################
   sub SendLetter {
       my $MAIL= new FileHandle("| $SENDMAIL -t -n");
       print $MAIL <<END;
   To: $TO
   From: $FROM
   Subject: Registracionnaya kartochka kluba
   MIME-Version: 1.0
   Content-type: text/plain; charset=koi8-r
   
   END
       print $MAIL &CGI::dump;
   
       close $MAIL;
       return p("Спасибо за регистрацию. Ваши данные приняты и после ".
                "проверки будт внесены в базу данных");
   }
   
Removed from v.1.1  
changed lines
  Added in v.1.2

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>