Документ взят из кэша поисковой машины. Адрес оригинального документа : http://hea.iki.rssi.ru/Z-90/z90-prereg.pl~
Дата изменения: Fri Sep 17 10:19:38 2004
Дата индексирования: Mon Oct 1 20:51:30 2012
Кодировка:
Поисковые слова: южная атлантическая аномалия

#!/usr/bin/perl

#use Text::BibTeX;

require "bp.pl";

# get current time and data
@TIME = localtime(time);
$DATE = @TIME[3].".".(@TIME[4]+1).".".(@TIME[5]+1900);
$time = @TIME[2].":".@TIME[1].":".@TIME[0];

$query_sav="/export/web/www/Z-90/data/z90-query.$$";
$bib_file="/tmp/z90-form.bib";
$head="/export/web/www/Z-90/head.html";
$tail="/export/web/www/Z-90/tail.html";
$form="form";

@TIME = localtime(time);
$DATE = @TIME[3].".".(@TIME[4]+1).".".(@TIME[5]+1900);
$time = @TIME[2].":".@TIME[1].":".@TIME[0];
$query;

if($ENV{'REQUEST_METHOD'} eq 'GET'){
$query = $ENV{'QUERY_STRING'};
}elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
sysread(STDIN,$query,$ENV{'CONTENT_LENGTH'});
}
$query=urldecode($query);

#
# END OF PRE-REGISTRATION
#

print "Content-Type: text/html\n\n";

if(checkf($head)){
open FD,"<$head" ;
while (){
print;
}close FD;
}

print "

Sorry, pre-registration is finished

";

if(checkf($tail)){
open FD,"<$tail" ;
while (){
print;
}close FD;
}

exit 0;

if($query ne ''){

open RAW,">>$query_sav";
print RAW "$query\n\n";
close RAW;

@fvalues = split(/&/,$query);

foreach $i (0 .. $#fvalues){
$str=$fvalues[$i];
($name,$val) = split(/=/,$fvalues[$i],2);
$name=&urldecode($name);
$val=&urldecode($val);
$field{$name} = $val;
}
$id=$field{author};
$id=~tr/ /_/;

$bib="";
open BIB,">>$bib_file";
print BIB "# $DATE $time\n";
$bib="@\inproceedings \{ $id,\n";
print BIB $bib;
foreach $i (sort keys %field){
$str="$i={$field{$i}},\n";
print BIB $str;
$bib.=$str;
}
$str="}\n";
print BIB $str;
$bib.=$str;
close BIB;
}

print "Content-Type: text/html\n\n";

# my $bibfile = new Text::BibTeX::File "/tmp/foo.bib";
# my $newfile = new Text::BibTeX::File ">/tmp/newfoo.bib";
# while ($entry = new Text::BibTeX::Entry $bibfile)
# {
# next unless $entry->parse_ok;
# print "

".$entry->key."
";
# $entry->write ($newfile);
# }
# exit 0;

if(checkf($head)){
open FD,"<$head" ;
while (){
print;
}close FD;
}

if($query ne ''){

if(ValidEmailAddr ($field{email})){

$msg="
The following entry has been added:

$bib
--
See also applications full list:
http://hea.iki.rssi.ru/Z-90/z90-prelist.pl
http://hea.iki.rssi.ru/Z-90/z90-bibtex.pl

";
&send_file("\"Z-90 Application Form\"",
"z90info\@hea.iki.rssi.ru", "$field{author}", $msg,$bib_file);

print "

Thank you for pre-registration.

The confirmation message will be sent to $field{email}.
";

$msg="
Dear $field{author},

Thank you for pre-registration for the conference \"Cosmology and High
Energy Astrophysics (Zeldovich-90)\". The conference will be held in
Moscow (Russia) from December 20 to 24, 2004, at the Space Research Institute
(IKI).

You will soon receive the Second Circular containing further details
on the conference. Please note that you will have to fill the
Registration Form to attend the conference. The deadline for
registration will be provided in the Circular.

If you have any questions or need additional information, please do not
hesitate to contact the organizing committee.

Looking forward to seeing you in Moscow!

LOC
";

&send_mail("LOC",$field{email},
"Zeldovich-90 Conference: Pre-registration Confirmation", $msg);

}else{
print "

ERROR: Please check your e-mail for correctness.

E-mail you have entered: $field{email}

Use \"Back\" button at your browser, or this link to return.
";
}
#&check ("/tmp/z90-form.bib");
}else{
#
# print FORM body if query is empty
#
if(checkf($form)){
open FD,"<$form";
while (){
print;
}close FD;
}
}

if(checkf($tail)){
open FD,"<$tail" ;
while (){
print;
}close FD;
}

sub ValidEmailAddr { #check if e-mail address format is valid
my $mail = shift; #in form name@host
return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ ); #characters allowed on name: 0-9a-Z-._ on host: 0-9a-Z-. on between: @
return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/); #must start or end with alpha or num
return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ ); #name must end with alpha or num
return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ ); #host must start with alpha or num
return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g ); #pair .- or -. or -- or .. not allowed
return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g ); #pair ._ or -_ or _. or _- or __ not allowed
return 0 if ( $mail !~ /\.([a-zA-Z]{2,3})$/ ); #host must end with '.' plus 2 or 3 alpha for TopLevelDomain (MUST be modified in future!)
return 1;
}

sub urldecode{
local($val)=@_;
$val =~ s/\+/ /g;
$val =~ s/%([0-9a-hA-H]{2})/pack('C',hex($1))/ge;
return $val;
}

sub check{
&bib'format("auto");

print "

";

foreach $file ($_[0]) {

  next unless &bib'open($file);

  $totrecs = 0;

  while ($record = &bib'read($file) ) {

    print "$record";

    $totrecs++;

  }

  &bib'close($file);

  print "$file has $totrecs records.\n";

}

print "

";
}

sub send_mail {

#&send_mail("\"Z-90 Application Form\"",
# "z90info\@hea.iki.rssi.ru", "$field{author}", $msg);

use MIME::Lite;
$msg = MIME::Lite->new(
From =>$_[0],
To =>$_[1],
Subject =>$_[2],
Type =>'TEXT',
Data =>$_[3]
);

MIME::Lite->send('smtp', "localhost");
$msg->send || die "Can not send message via SMTP server\n";
}

sub send_file {
use Mail::Sender;
use Mail::Internet;
use Mail::Address;

$sender = new Mail::Sender{smtp => 'localhost', from => $_[0]};
$sender->MailFile({to => $_[1],subject => $_[2],msg => $_[3],file => $_[4]});
}

sub checkf{
unless (-f $_[0]){
print "ERROR: Can\'t open file \"$_[0]\"" ;
return false;
}else{
return true;
}
}