Документ взят из кэша поисковой машины. Адрес оригинального документа : http://hea.iki.rssi.ru/Z-90/culture_prog.pl~
Дата изменения: Wed Oct 13 17:15:30 2004
Дата индексирования: Mon Oct 1 21:29:40 2012
Кодировка:
Поисковые слова: http astrokuban.info astrokuban

#!/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-culture_prog-query.$$";
$bib_file="/export/web/www/Z-90/data/z90-culture_prog.bib";
$head="/export/web/www/Z-90/head.html";
$tail="/export/web/www/Z-90/tail.html";
$form="culture-prog-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);

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/\./_/;
$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 ''){
print "

Thank you!

";

$msg="Registration for Cultural Programme:

entry:
$bib

---
";
&send_file("\"Z-90 Form\"","z90info\@hea.iki.rssi.ru", "Culture Programme Sign-Up: $field{first_name} $field{last_name}", $msg,$bib_file);

}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;
}
}