IT::Scripting::JavaScript::SJAX(AJAX)のサンプル::Perl側 - 色々雑多メモ::コンピュータ関連

use Data::Dumper;
use Jcode;
use CGI;

BEGIN
{
  #ログ取り対策
  $|=1;
  
  ######### ログファイルのオープン #########
  $logpath   = '..\\tmp\\';
  $logfile   = 'err.log';
  
  %filemode  = (
                'readonly'  => ''   ,
                'addwrite'  => '>>' ,
                'overwrite' => '>'  ,
                'readwrite' => '+>' 
               );
  
  # r ... reading / w ... writing / c ... cancel / rtn ... return 
  %floc_mode = (
                'r_wloc'       => 1 ,
                'w_rwloc'      => 2 ,
                'r_wloc_rtn0'  => 5 ,
                'w_rwloc_rtn0' => 6 ,
                'cloc'         => 8 
               );
  
  open LOGFILE , "$filemode{addwrite}"."$logpath"."$logfile";
  flock( LOGFILE , $floc_mode{w_rwloc} );
  
}

# パッケージデストラクタ
END
{
  ######### ログファイルのクローズ #########
  close LOGFILE;
}


############################################################################################
# main コード

#CGI引数取得
my $query=new CGI;
my $openwindowflag    = $query->param('openwindowflag');    # windowが開かれる際のHTTP出力


#$env_all = all_env_info();
$env_cstm = cstm_env_info_ajax();
if($openwindowflag == 1){
   print $env_all;
}else{
   print httpHeader();
   print $env_cstm;
   #print $env_all;
##   
##   all_env_info_ajax();
}
log_w("\n".$env_cstm , 1 );


##print dmy();

sub dmy()
{

##  return printf "moji";
##  return printf ("");
  $rtn = sprintf("");return $rtn;
}


##############################################################
# ログの書き出し

sub log_w
{
  my ( $log_string , $flgLOG ) = @_;
  
  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
  my $timestamp = sprintf("%04d/%02d/%02d %03s %02d:%02d:%02d", $year + 1900, $mon +1, $mday,
                                                                ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")[$wday],
                                                                $hour, $min, $sec
                                                                );
  if( $flgLOG == 1 ){
    print LOGFILE $timestamp."  ScriptName ::".$0." ::   ".&jcode($log_string)->sjis."\n";
  }
}


##############################################################
# 環境変数の出力（全て） AJAX用


sub cstm_env_info_ajax()
{
    my $rtn = '';
    my $key = '';
    
    my @defult_keys =(
                      'LOCAL_ADDR'      , 
                      'SCRIPT_NAME'     , 
                      'REMOTE_HOST'     , 
                      'REMOTE_ADDR'     , 
                      'HTTP_REFERER'    , 
                      'HTTP_USER_AGENT'
                      );
    foreach $key (@defult_keys){
        $rtn = $rtn.$key.':'.$ENV{$key}."\n";
    }
#    $key = 'PATH' ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'LOCAL_ADDR'      ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'SCRIPT_NAME'     ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'REMOTE_HOST'     ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'HTTP_REFERER'    ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'REMOTE_ADDR'     ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
##    $key = 'HTTP_USER_AGENT' ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
#    $key = '' ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
#    $key = '' ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
#    $key = '' ;$rtn = $rtn.$key.':'.$ENV{$key}."\n";
    return $rtn;
    
    #return sprintf "".Dumper(%ENV)."";
}

sub all_env_info_ajax()
{
    return sprintf "".Dumper(%ENV)."";
}
sub httpHeader
{
# http://www.bayashi.net/archives/entry/2006/000211.html
# キャッシュ回避ヘッダの出力
return 
"Content-type: text/html;charset=UTF-8
Pragma: no-cache
Cache-Control: no-cache
Expires: Thu, 01 Dec 1994 16:00:00 GMT

";

}

##############################################################
# 環境変数の出力（全て） Window open版

sub all_env_info()
{
    return sprintf "Content-type: text/html;charset=UTF-8

    <HTML><BODY>
    <PRE>".Dumper(%ENV)."
    </PRE></BODY></HTML>";
}