2009年12月アーカイブ

実行中のプロセスのCPU使用率やメモリ占有率などをリアルタイムで監視するUNIXコマンド。

-----------------------------------------------------------------

$ su （rootになる）

# top

（プロセス一覧が表示される）


"q"で終了
----------------------------------------------------------------

以上。


オプションとして便利なのは、

-d: 更新間隔を指定する: -d ss.tt (秒.10分の1秒)
-u: 指定した実効UIDかユーザ名にマッチするプロセスだけをモニターする: -u somebody


例えばWEBサーバが実効しているプロセスだけを0.5秒間隔に確認したい場合は、

--------------------------------------------
# top -d 0.5 -u apache
--------------------------------------------

でOK。

とりあえずサンプルスクリプト↓

-----------------------------------------------------------------------

use strict;
use CGI::Carp qw(fatalsToBrowser);
use Net::SMTP;
use Net::SMTP::SSL;
use Net::SMTP::TLS;
use Encode qw(from_to encode);

#メールアドレス設定
my $from = 'hoge@gmail.com';
my $mailto= 'huga@nantoka.com';

#件名設定
my $subject = 'SMTPを指定してメール送信！';
from_to($subject, 'shiftjis', 'iso-2022-jp');
encode('MIME-Header-ISO_2022_JP', $subject);

#メールヘッダー設定
my $header = << "MAILHEADER";
From: $from
To: $mailto
Subject: $subject
Mime-Version: 1.0
Content-Type: text/plain; charset = 'ISO-2022-JP"
Content-Trensfer-Encoding: 7bit

MAILHEADER

#メール本文設定
my $message = << 'MAILBODY';
本日は晴天なり。

あああいいいううう
さよーなら！
MAILBODY

#文字コードをJISに変換
from_to($message, 'shiftjis', 'iso-2022-jp');

#SMTP設定（適宜変更してください）
my $server = 'smtp.gmail.com';　#ホスト名
my $auth = 1;　#SMTPAuthを使用する場合は1
my $tls = 0;　#TLS接続を使う場合は1
my $ssl = 1;　#SSL接続を使う場合は1
my $port = 465;　#ポート指定。指定しないと25番が勝手に設定される
my $user = 'hoge@gmail.com';　#SMTPAuthのユーザ名
my $pass = 'passwaord';　#SMTPAuthのパスワード

#メール送信オブジェクト設定
my $smtp = '';

#TLSのときは、オブジェクト生成時にAuthデータを渡す
if($tls){
　$smtp = Net::SMTP::TLS->new(
　　$server,
　　Port => $port ,
　　User => $user ,
　　Password => $pass
　) || die "Connect failed over tls";
}
elsif($ssl){
　$smtp = Net::SMTP::SSL->new(
　　$server,
　　Port => $port
　) || die "Connect failed over ssl";
}
else{
　$smtp = Net::SMTP->new($server, Port => $port) || die "Connect failed";
}
if(!$tls && $auth){
　$smtp->auth($user, $pass) || die "auth failed";
}

#メール送信
$smtp->mail($from);
$smtp->to($mailto);
$smtp->data();
$smtp->datasend($header);
$smtp->datasend($message);
$smtp->dataend();
$smtp->quit;

print <<EOM;
Content-type: text/html

送信しました～！
EOM

exit;
1;

---------------------------------------------------------------------------------

※Net::SMTP::SSLおよびNet::SMTP::TLSを使うには、IO::Socket::SSLモジュールが必要。
※IO::Socket::SSLをインストールするには、Net::SSLeayモジュールが必要
※試したところ、gmailの場合は、TLS使用＆ポート587でも送信できた。
※例ではエンコードにEncodeモジュールを使っているが、Jcodeとか使いたい人はお好きなように。

自動でファイルの書き換えをした場合とかに、最後に古いファイル・新しいファイルのチェックを行うために辿り着いた作戦。

新しい同名・同パッケージ名のファイルを別のディレクトから"require"すればOK。
同名のパッケージ名が新しく読み込んだパッケージで上書きされる。

ただし、useはコンパイル時に参照されるからだめかも知れない。
試してないけど。

---------------------------------------------------------------------------------------------

sub update_files_and_check{

　my $dir = '.';　##　古いファイルが入ったディレクトリ
　###　一度古いfile_list.plを読み込む
　require "$dir/file_list.pl";
　print "

現在あるファイルは、

\n";
　foreach(@file_list::req){
　　print $_ ."
\n";
　}
　print "です。";

　my $dir = '.';　##　古いファイルが入ったディレクトリ
　my $newdir = './newdir'; ## 新しいファイルが入ったディレクトリ（この中に新しいfile_list.plも入っている）


　###　ファイル書き換え

　opendir(NEW_DIR,$new_dir) || die "Can't open $new_dir !";
　　while(my $doc = readdir(NEW_DIR)){
　　　if($doc !~ /^\.+$/){
　　　　open(FILE,"$new_dir/$doc") || die "Can't open $new_dir/$doc !";
　　　　my $buff = '';
　　　　binmode FILE;
　　　　while(){
　　　　　$buff .= $_;
　　　　}
　　　　close(FILE);
　　　　if(-e "$dir/$doc"){
　　　　　unlink "$dir/$doc" || die "Can't delete $dir/$doc!";
　　　　}
　　　　open(FILE,">$dir/$doc") || die "Can't open $dir/$doc !";
　　　　flock(FILE,2);
　　　　print FILE $buff;
　　　　flock(FILE,8);
　　　　close(FILE);
　　　}
　　}
　closedir();

　###　チェック＆不要ファイル削除
　if(! eval "require $new_dir/file_list.pl;"){
　## ↑ のrequireが成功すれば、この時点で変数「@file_list::xxx」が上書きされる
　## "require $dir/file_list.pl;" にしてしまうと、最初にすでに読み込んでるので失敗する。

　　print "新しいファイルが参照できません。";
　　exit;
　}
　foreach(@file_list::req){
　　if(!-e "$dir/$_"){
　　　print "$_が見つかりません！！";
　　　exit;
　　}
　}
　foreach(@file_list::des){
　　if(-e "$dir/$_"){
　　　unlink "$dir/$_" || die "$dir/$_が削除できません！";
　　}
　}
}

---------------------------------------------------------------------------------------------


（書き換えられた新しいfile_list.pl）
------------------------------------------------------------------------------------
package file_list;

use strict;

### 今回必要なファイル
our @req = ( 'aaa.pl','bbb.pl','ccc.txt');

### 不要になったファイル
our @des = ('ddd.pl','eee.pl');

1;
------------------------------------------------------------------------------------