File:  [Local Repository] / register / prgsrc / register.cgi
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Tue Sep 4 19:33:18 2001 UTC (22 years, 10 months ago) by boris
Branches: MAIN
CVS tags: HEAD
Added new functionality

#!/usr/bin/perl

=pod

=head1 NAME 

register.cgi - a universal script for club regiter

=head1 SYNOPSIS

register.cgi?[I<options>]

=head1 DESCRIPTION

The script draws the hierarchy in the form suitable for WWW

=head1 AUTHOR

Boris Veytsman

=head1 DATE

$Date: 2001/09/04 19:33:18 $

=head1 REVISION

$Revision: 1.2 $

=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("Спасибо за регистрацию. Ваши данные приняты и после ".
	     "проверки будт внесены в базу данных");
}


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