#!/usr/local/bin/perl
#
# Поддержка базы данных по выпускникам Второй школы
#
#
# Структура базы:
#
# year, clid, lname, name, mname, e-mail, homepage, descr , photo , fname , comments
# год_выпуска, буква_класса, фамилия, имя, отчество, e-mail, homepage, имя_файла-описания, имя_файла-фото, новая фамилия, комментарии
#
# файл-описание -- текстовый файл, содержащий информацию по данному человеку
# если файл с расширением .htm или .html - то в качестве странички выдается он
#
# База хранится в поддиректории ./data, файлы-описания хранятся в верхней директории (т.е. над cgi-bin)
#
# На выдаваемой странице вверху должно быть крупно Имя Отчество Фамилия,
# далее чуть ниже e-mail и homesite, разделитель
# далее -- вставка файла-описания и фото, далее -- форма для комментария
# или письма
#
# Страница выдается только если определен параметр 'show'
# В противном случае выдается список формата
# "Фамилия Имя Отчество (год, "буква")" подходящих записей
#
# Если скрипт вызывается без параметров -- выдается страничка-приветствие
# со списком ссылок по годам + форма поиска.
use CGI;
use DBI;
use FileHandle;
use locale;
use POSIX;
setlocale(LC_ALL, "Russian_Russia.1251");
my $q = new CGI;
my @params = $q->param;
my $myself = $q->self_url;
my $table="graduates";
my $dbh = DBI->connect(qq{DBI:CSV:f_dir=./data;csv_sep_char=\\;});
my $sth;
my $file = new FileHandle;
my $comments = 'data/comments.txt';
my $log = 'data/who-is-who.log';
my $loglevel = 2; #0 - no logging, 1 - log, 2 - debug
#
# Определяем IP клиента
#
$ipa = $ENV{ REMOTE_ADDR };
#
# Корневая страница (вызов без параметров)
#
if (@params == 0) {
$sth = $dbh->prepare("SELECT DISTINCT year FROM $table ORDER BY year");
$sth->execute();
print $q->header(-charset=>'windows-1251');
print $q->start_html(-title=>'Выпускники Второй школы', -background=>'/Images/backgr_grid.gif'),
$q->h1({-align=>center},'Выпускники Второй школы'),
$q->p('Как известно, слава школы определяется успехами ее выпускников. И Вторая школа не исключение.',
'Вторая школа гордится своими выпускниками.'),
$q->p('Данная страничка – попытка организации базы данных по выпускникам Второй школы.',
'Вы можете либо выбрать год выпуска из представленных ниже (представлены все ',
'года, по которым в базе есть хотя бы одна запись), либо воспользоваться ',
$q->a({-href=>'#search_form'}, 'формой поиска'), ' по всей базе.');
print $q->hr;
while (my $row = $sth->fetchrow_hashref) {
print $q->p({-align=>'center'},
$q->a({-href=>$myself . '?year=' . $row->{'year'}},$row->{'year'}));
}
print $q->hr;
print $q->h2({-align=>'center'}, $q->a({-name=>'search_form'}, 'Поиск по базе'));
print $q->p('Вы можете воспользоваться поиском: введите те поля, которые Вам известны. ',
'В полях фамилии, имени и отчества можно ввести только часть слова, поставив ',
'в конце "звездочку". ');
print $q->p('База по выпускникам Второй школы пока не содержит информации по ',
'всем выпускникам. Поэтому Вы можете оставить информацию о каком-',
'либо человеке (как вообще отсутствующем в базе, так и дополнительную',
'информацию об уже введенном человеке). Для этого нажмите кнопку "',
'Добавить данные" внизу страницы поиска (о новом человеке), или в ',
'конце персональной странички (т.е. ссылки из результатов поиска).');
print $q->p($q->b('Введите параметры поиска: ФАМИЛИЮ и/или ИМЯ - БОЛЬШИМИ БУКВАМИ! Неизвестные или не значимые ',
'поля оставьте пустыми. ',
'В полях фамилии, имени и отчества можно использовать "звездочку".'));
my $years = $dbh->selectcol_arrayref($sth);
@{$years} = ('', @{$years});
print $q->startform;
print $q->center({-align=>'center'},
$q->b('Год выпуска: '), $q->popup_menu('year', $years),
$q->b(' Класс: '), $q->popup_menu('clid', ['', 'А', 'Б', 'В', 'Г', 'Д', 'Е', 'Ж', 'З']));
print $q->table({-border=>'0', -cellpadding=>'5', cellspacing=>'0', width=>'100%'},
$q->Tr({-align=>center, -valign=>top}, [
$q->td({-width=>'33%'}, [$q->b('Фамилия'), $q->b('Имя'), $q->b('Отчество')]),
$q->td({-width=>'33%'}, [
$q->textfield(-name=>'lname', -size=>20, -maxlength=>100),
$q->textfield(-name=>'name', -size=>20, -maxlength=>100),
$q->textfield(-name=>'mname', -size=>20, -maxlength=>100),
]) ]
)
);
print $q->center($q->p($q->submit(-name=>'Поиск')));
print $q->endform;
print $q->hr;
print $q->h6({align=>center}, 'Автор базы: ' . $q->a({href=>'mailto:ablov@school2.ru'}, 'Дмитрий Аблов'));
print $q->end_html;
}
#
# Обработка запроса
#
elsif (!($q->param('show') || $q->param('comment'))) {
my $search_string = '';
my $condition;
if ((my $year = $q->param('year'))) {
$search_string = 'Год выпуска: ' . $year;
$condition = '(year = ' . $year . ')';
}
if ((my $clid = $q->param('clid'))) {
$search_string .= '; Класс: \'' . $clid . '\'';
$condition .= 'AND' if ($condition);
$condition .= '(clid = \'' . $clid . '\' OR clid = \'\')';
}
if ((my $lname = uc($q->param('lname')))) {
$search_string .= '; Фамилия: ' . $lname;
$condition .= 'AND' if ($condition);
$condition .= "(lname LIKE '" . $lname . "' OR fname LIKE '" . $lname . "')";
}
if ((my $name = uc($q->param('name')))) {
$search_string .= '; Имя: ' . $name;
$condition .= 'AND' if ($condition);
$condition .= '(name LIKE \'' . $name . '\' OR name = \'\')';
}
if ((my $mname = uc($q->param('mname')))) {
$search_string .= '; Отчество: ' . $mname;
$condition .= 'AND' if ($condition);
$condition .= '(mname LIKE \'' . $mname . '\' OR mname = \'\')';
}
if ($search_string eq '') { # Если вообще ничего не введено
$condition = '(lname LIKE \'*\')';
}
$condition =~ tr/*/%/;
$condition =~ tr/?/_/;
print $q->header(-charset=>'windows-1251');
print $q->start_html(-title=>'Выпускники Второй школы: результаты поиска', -background=>'/Images/backgr_grid.gif');
print $q->h6({-style=>'color : red; font-style : italic'}, 'Результат поиска: "' . $search_string . '"');
print $q->hr;
print $q->p('ВНИМАНИЕ! База находится в состоянии заполнения. Если Вы не нашли того, кого искали, ' .
'или хотите оставить дополнительную информацию, пожалуйста, оставьте комментарий!');
print $q->p('Вы можете оставить комментарий ', $q->a({-href=>'#NB!'}, 'здесь'), '.');
$sth = $dbh->prepare("SELECT DISTINCT * FROM $table WHERE $condition ORDER BY lname");
$sth->execute();
if ($loglevel) {
if ($file->open('>> ' . $log)) {
my $time = localtime(time);
print $file ("<$time> - <$ipa> - Query: ", $condition, "\n");
$file->close;
}
}
my $count = 0;
my $user_url;
while (my $row = $sth->fetchrow_hashref) {
if (($row->{'descr'}) && (index ($row->{'descr'}, '.htm') != -1)) {
$user_url = '../' . $row->{'descr'};
} else {
$user_url = $q->url() . '?year=' . $row->{'year'} .
'&clid=' . $row->{'clid'} .
'&lname=' . $row->{'lname'} .
'&name=' . $row->{'name'} .
'&mname=' . $row->{'mname'} .
'&e-mail=' . $row->{'e-mail'} .
'&homepage=' . $row->{'homepage'} .
'&descr=' . $row->{'descr'} .
'&photo=' . $row->{'photo'} .
'&fname=' . $row->{'fname'} .
'&show=1';
}
print $q->p($q->a({-href=>$user_url} ,
$row->{'lname'} . ' ' .
($row->{'fname'} ? (' (' . $row->{'fname'} . ') ') : '') .
$row->{'name'} . ' ' .
$row->{'mname'} . ' (' .
$row->{'year'} .
($row->{'clid'} ? (' "' . $row->{'clid'} . '"') : '') . ')') .
($row->{'e-mail'} ? '' : '') .
($row->{'homepage'} ? '' : '') .
($row->{'descr'} ? '' : '') .
($row->{'photo'} ? '' : '')
);
$count++;
}
if (!$count) {
print $q->h2('Записей, соответствующих Вашему запросу, в базе не найдено.');
if ($loglevel > 1) {
if ($file->open('>> ' . $log)) {
my $time = localtime(time);
print $file ("<$time> - <$ipa> - Query: NO RECORDS FOUND\n");
$file->close;
}
}
} else {
if ($loglevel > 1) {
if ($file->open('>> ' . $log)) {
my $time = localtime(time);
print $file ("<$time> - <$ipa> - Query: found $count record(s)\n");
$file->close;
}
}
print $q->h6({-style=>'font-weight : normal'}, 'Количество записей, соответствующих Вашему запросу: ' . $count);
}
print $q->hr;
print $q->a({-name=>'NB!'}, $q->h2({-align=>center}, 'Комментарий / информация:'));
print $q->p('Здесь Вы можете оставить свой комментарий или информацию. Если ',
'Вы не можете кого-то найти в базе или заметили неточность – ',
'пожалуйста, оставьте здесь комментарий – мы обязательно ',
'дополним или исправим базу.');
print $q->p({align=>center}, 'База обновляется по выходным, раз в одну-две недели.',
#
#Обновление базы
#
'Последнее обновление базы - 21 сентября 2003 г.');
print $q->p({align=>center}, 'Если Вам необходимо срочно что-то исправить или добавить,');
print $q->h6({align=>center}, 'ПИШИТЕ: ' . $q->a({href=>'mailto:mazine@fmf.uni-freiburg.de'}, 'mazine@fmf.uni-freiburg.de'));
print $q->startform;
print $q->center({-align=>center}, [$q->textarea('comment', '', 15, 70),
$q->submit('Сохранить!')]);
print $q->hidden('person', $search_string);
print $q->endform;
print $q->end_html;
}
#
# Показ персональной странички
#
elsif ($q->param('show')) {
my $person = $q->param('lname');
if ($q->param('fname')) {
$person .= ' (' . $q->param('fname') . ')';
}
$person .= ' ' . $q->param('name');
if ($q->param('mname')) {
$person .= ' ' . $q->param('mname');
}
$person = fn($person); # Каждое слово маленькими буквами с большой
print $q->header(-charset=>'windows-1251');
print $q->start_html(-title=>'Выпускники Второй школы: ' . $person,
-background=>'/Images/backgr_grid.gif');
print $q->h1({-align=>center}, $person);
print $q->start_table({-border=>'0', -cellpadding=>'0', cellspacing=>'0', width=>'100%'});
print $q->start_Tr({-valign=>top});
print $q->start_td({-align=>left, -width=>'50%'});
print (($q->param('e-mail'))?
($q->h5({-style=>'font-family: helvetica, sans-serif'},
'E-Mail: ',
$q->a({-href=>'mailto:' . $q->param('e-mail')},
$q->param('e-mail')))):
($q->p(' ')));
print $q->end_td();
print $q->start_td({-align=>right, -width=>'50%'});
print (($q->param('homepage'))?
($q->h5({-style=>'font-family: helvetica, sans-serif'},
'WWW: ',
$q->a({-href=>'http://' . $q->param('homepage')},
$q->param('homepage')))):
($q->p(' ')));
print $q->end_td();
print $q->end_Tr();
print $q->end_table();
print $q->hr;
print $q->start_table({-border=>'0', -cellpadding=>'0', cellspacing=>'0', width=>'100%'});
print $q->start_Tr({-valign=>top});
print $q->start_td({-align=>left});
if ($q->param('photo')) {
print $q->img({-align=>left, -src=>'../'.$q->param('photo')});
}
print $q->end_td();
print $q->start_td({-align=>left});
if (($q->param('descr')) && ($file->open('< ../'.$q->param('descr')))) {
print $q->p(<$file>);
$file->close;
}
print $q->end_td();
print $q->end_Tr();
print $q->end_table();
print $q->hr;
print $q->a({-name=>'NB!'}, $q->h2({-align=>center}, 'Комментарий / информация:'));
print $q->p('Здесь Вы можете оставить свой комментарий или информацию. Если ',
'Вы не можете кого-то найти в базе или заметили неточность – ',
'пожалуйста, оставьте здесь комментарий – мы обязательно ',
'дополним или исправим базу.');
print $q->p({align=>center}, 'База обновляется по выходным, раз в одну-две недели.',
#
#Обновление базы
#
'Последнее обновление базы - 21 сентября 2003 г.');
print $q->startform;
print $q->center([$q->textarea('comment', '', 15, 70),
$q->submit('Сохранить!')]);
print $q->hidden('person',$person . ' (' . $q->param('year') . $q->param('clid') . ')');
print $q->endform;
print $q->end_html;
}
#
# Обработка комментариев пользователя
#
elsif ($q->param('comment')) {
print $q->header(-charset=>'windows-1251');
print $q->start_html(-title=>'Спасибо за комментарий!', -background=>'/Images/backgr_grid.gif');
if ($file->open('>> ' . $comments)) {
my $time = localtime(time);
print $file ("<$time> - <$ipa>\n", '[', $q->param('person'), '] ', $q->param('comment'), "\n\n");
$file->close;
}
print $q->h2('Большое спасибо за помощь!');
print $q->startform;
print $q->button(-name=>'Назад', -onClick=>"self.location='" . $q->url() . "'");
print $q->endform;
print $q->end_html;
}
#
# Такого быть не может!
#
else {
print $q->header(-charset=>'windows-1251');
print $q->start_html(-title=>'ERROR',-background=>'/Images/backgr_grid.gif');
print $q->dump;
print $q->end_html;
}
$sth->finish();
$dbh->disconnect();
#
# Возвращает строку, каждое слово которой начинается с большой буквы и продолжается
# маленькими. Разделителями слова считаются пробел и дефис (для сложных фамилий),
# а также открывающая скобка (для новой фамилии)
#
# Пример:
#
# $person = "ВЛАДИМИР САВВИН-ПУШКИН";
# print fn($person); -> "Владимир Саввин-Пушкин"
#
sub fn
{
my $name = shift @_;
$name = lc $name;
$name =~ s/((^| |-|\').)/uc($1)/ge;
$name =~ s/(\(.)/uc($1)/ge; # Почему это отдельно? Понятия не имею, но вместе не работает
return $name;
}