XXX邮件的一段代码

不小心点开了邮件的一段代码

这是什么语言写的？

#!/usr/bin/perl -w

use strict;
use POSIX;
use IO::Socket;
use CGI::Fast qw(:standard);
use CGI::Cookie;
use LWP::UserAgent;
use URI::Escape;

use lib '/home/apache/fcgi_files';
use Util;
use CMAPI;
use MySes;
use Grade;
use UserInfo;
use MyLog;
#use URI::Escape;
#use MIME::Base64;

sub handle_term;

$SIG{'TERM'} = /&handle_term;
$SIG{'INT'} = /&handle_term;
$SIG{'ABRT'} = /&handle_term;
$SIG{'CHLD'} = 'IGNORE';

my $domain = 'XXX.com';

#my $title = "query";
#my $LOGDIR = "/home/coremail/logs";
my $LOGDIR = "/home/webedit/young/logs";
my $logname = "Grade_XXX";

my $PAGEDIR = '/home/apache/fcgi_files/html/XXX';

# read page
open(INDEX,"$PAGEDIR/index.htm") || exit(0);#die "Open login.htm: $!";
my @page_index = <INDEX>;
close(INDEX);

open(LOGIN,"$PAGEDIR/login.htm") || exit(0);#die "Open login.htm: $!";
my @page_login = <LOGIN>;
close(LOGIN);

=head
open(ERROR,"$PAGEDIR/error.htm") || die "Open error.htm: $!";
my @page_error = <ERROR>;
close(ERROR);
=cut

my $errmsg = "系统繁忙，暂时未能响应你的请求，请稍候。";
my $loginerrmsg = "验证失败，请先登录";
my $loginblockmsg = "失败尝试次数过多，请稍后再登录";
#my $pre_url = "http://reg.XXXcom/servlet/netease.user.Login2Servlet?username=&password=&userip=";

my $ua = LWP::UserAgent->new(
    'keep_alive'    =>  30,
    'timeout'       =>  1,
);

#my $sesh = MySes->connect || die "Connect mysql err: $!";

my $logdate = POSIX::strftime("%y%m%d",localtime);
my $statlog = "$LOGDIR/$logname/_$logdate.log";
&InitMyLog($statlog);

my $cmapi_host = 'api.XXX.internal';
my $cmapi_port = 2700;

OUTER: while(my $req = new CGI::Fast)
{
my $cmh;
eval{
my %replace = ();
my $today = POSIX::strftime("%y%m%d",localtime);
    unless($today eq $logdate)
    {
        $logdate = $today;
        $statlog = "$LOGDIR/$logname/_$logdate.log";
        &InitMyLog($statlog);
    }
my $logfile = "$LOGDIR/$logname/_$today.err";
my $sid = $req->param('sid');
my $username = $req->param('username');
my $password = $req->param('password');
my $uid=$req->param('uid');
    my $userip = $ENV{'REMOTE_ADDR'};
    my $fullname;
    my $dispname;
unless($uid || $username || $sid)
{
print $req->header(-charset=>'gb2312');
PrintPage(/@page_index,/%replace);
die;
}
if($uid)
    {
$uid = uri_unescape($uid);
$cmh = CM_Conn($cmapi_host,$cmapi_port);
        unless($cmh)
        {
            print $req->header(-charset=>'gb2312');
PrintPage(/@page_index,/%replace);
            die;
        }
my $ret = CheckSesTimeOut($cmh,$uid);
$fullname = $$ret{'uid'};
        unless($fullname)
        {
            print $req->header(-charset=>'gb2312');
PrintPage(/@page_index,/%replace);
            die;
        }
        $username = (split(/@/,$fullname))[0];
        #my $session = MySes->new($sesh);
#my $session = MySes->new($uid);
my $session = MySes->new();
        my $sess_ret = $session->WriteSes($fullname);
        unless($sess_ret)
        {
            print $req->header(-charset=>'gb2312');
Error($errmsg);
            die;
        }
        $sid = $session->GetSid;
CM_Close($cmh);
    }
elsif($sid)
{
        #my $session = MySes->new($sesh,$sid);
my $session = MySes->new($sid);
        unless($fullname=$session->CheckSes())
        {
            print $req->header(-charset=>'gb2312');
#$replace{'errmsg'} = $loginerrmsg;
#PrintPage(/@page_error,/%replace);
Error($loginerrmsg);
            die;
        }
        $username = (split(/@/,$fullname))[0];
    }
    elsif($username)
    {
        unless($password)
        {
            print $req->header(-charset=>'gb2312');
#$replace{'title'} = $replace{'errmsg'} = "未输入密码";
#PrintPage(/@page_error,/%replace);
Error("请输入密码");
            PrintErr($logfile,"$username|password required");
            die;
        }
        $username = uri_unescape($username);
        $password = uri_unescape($password);
        if($username =~ /@/)
        {
            $fullname = $username;
            $username = (split(/@/,$fullname))[0];
        }else
        {
            $fullname = $username."/@$domain";
        }
my $cmh = CM_Conn($cmapi_host,$cmapi_port);
        unless($cmh)
        {
            print $req->header(-charset=>'gb2312');
PrintPage(/@page_index,/%replace);
            die;
        }
        my $ret = CheckPass($cmh,$fullname,$password);
        unless($ret == 0)
        {
            print $req->header(-charset=>'gb2312');
PrintPage(/@page_index,/%replace);
            CM_Close($cmh);
            die;
        }
        CM_Close($cmh);
        #my $session = MySes->new($sesh);
        my $session = MySes->new();
        $session->WriteSes($fullname);
        $sid = $session->GetSid;
    }
    #undef $session;

# 验证完成

##############################################################

    my ($jifen,$level,$rcode);

    $|=1;
    $fullname = "$username/@$domain";
    WriteLog("Login: $fullname($userip)");
    #my $grade = Grade->new('192.168.2.106',7788);
    my $grade = new Grade($ua);
unless($grade){
print $req->header(-charset=>'gb2312');
        #$replace{'title'} = $replace{'errmsg'} = "积分对象创建失败";
#$replace{'title'} = $replace{'errmsg'} = $errmsg;
#PrintPage(/@page_error,/%replace);
Error($errmsg);
PrintErr($logfile,"Can't new Grade:$!");
die;
}
    my $ret = $grade->Query($fullname);
unless($ret){
print $req->header(-charset=>'gb2312');
        #$replace{'title'} = $replace{'errmsg'} = "服务器内部通信失败";
#$replace{'title'} = $replace{'errmsg'} = $errmsg;
#PrintPage(/@page_error,/%replace);
Error($errmsg);
PrintErr($logfile,"Can't connect to server:$!");
die;
}
$rcode = $grade->rcode;
if($rcode <= 0)
{
print $req->header(-charset=>'gb2312');
        #$replace{'title'} = $replace{'errmsg'} = "数据库出错";
#$replace{'title'} = $replace{'errmsg'} = $errmsg;
#PrintPage(/@page_error,/%replace);
Error($errmsg);
PrintErr($logfile,"$username|DB server error: $rcode");
die;
}
    $jifen = $grade->grade;
    $level = $grade->level;

    my $uinfo = UserInfo->new($ua,$fullname);
    if($uinfo)
    {
        my %user_info = $uinfo->QueryBatch('nickname','realname');
        if( %user_info && $user_info{'rcode'}>=-1 )
        {
            $dispname ||= $user_info{'nickname'};
            $dispname ||= $user_info{'realname'};
        }
    }
    #print STDERR "here $username/n";
    $dispname ||= $username;

# 页面输出
    $replace{'uname'} = $dispname;
    $replace{'sid'} = $sid;


    $replace{'jifen'} = $jifen;
    $replace{'level'} = $level;

=head_暂不提供用户查询
    $replace{'jifen'} = 0;
    $replace{'level'} = '<img src="http://mimg.XXX.com/jsstyle/icon/jifen/jf_null.gif" border="0" />';
=cut

    my $cookie_jifen = new CGI::Cookie(-name=>"jifenXXX_$username",-value=>$jifen,-domain=>'mail.XXX.com');
    my $cookie_level = new CGI::Cookie(-name=>"levelXXX_$username",-value=>$level,-domain=>'mail.XXX.com');
my $cookie_name = new CGI::Cookie(-name=>'nameXXX',-value=>$dispname,-domain=>'mail.XXX.com');
    #my $cookie_sid = new CGI::Cookie(-name=>'grade_sid',-value=>$sid);
   
print $req->header(-charset=>'gb2312',-cookie=>[$cookie_jifen,$cookie_level,$cookie_name]);
    PrintPage(/@page_login,/%replace);
};
if($@){
if($cmh){
CM_Close($cmh);
}
}
sub handle_term
{
#next OUTER;
=head
if($sesh)
    {
        $sesh->disconnect;
    }
=cut
print CGI::header;
if($cmh){
CM_Close($cmh);
}
exit(0);
}
}