perl-POE框架学习:邮件控制电脑

perl的POE模块··是一个很不错的框架,是一个单进程模拟多线程的多任务执行模块,并提供的非阻塞的IO操作~~可以干的东西很多···并且写起来··思路很清晰,可读性非常好~~至于具体的有关POE的资料大家可以上网找一下虽然不多··

#BY Weigun http://blog.chinaunix.net/u2/70443/

use 5.010;
use strict;
use warnings;
use Config::IniFiles;
use Data::Dumper;
use Net::IMAP::Simple;
use POSIX qw(strftime);
use mail_parse;
use Mail::Sender;
use File::Spec::Functions;
use Cwd;
use Fcntl qw/:flock/;
use POE;
use POE::Wheel::Run::Win32;
BEGIN
{    push (@INC,'.');}
$|++;
my $conf_dir = catdir(getcwd(),'conf');
my $cfg_file = catfile($conf_dir,'conf.ini');
my $cmd_file = catfile($conf_dir,'list.ini');
my $pre_mails_num = 'pre mails num.ini';
my $mails_ref;
create POE::Session(
    inline_states =>
        {_start => \&init,
#            conf_change => \&load_config,

            imap_connect => \&imap_connect,
            check_new_mail => \&check_new_mail,
            new_jobs_arrive => \&new_jobs_arrive,
            write_cmd_log => \&write_cmd_log,
            start_job => \&start_job,
            send_mail => \&sendMail,
            error => \&err,
            _stop => sub{say "i will exit in 10 second";sleep 10;},
        },
    );
POE::Kernel->run;
exit(0);

sub init
{
    my ($kernel,$heap) = @_[KERNEL,HEAP];
    $kernel->alias_set('main');
    $heap->{cfg} = load_config($cfg_file);
    $heap->{cmd} = load_config($cmd_file);
    $kernel->yield('imap_connect');
    say "init....";
}

sub imap_connect
{
    say "connecting server";
    my $host = $_[HEAP]->{cfg}->{IMAP_SERVER}->{host};
    my $retry_time = $_[HEAP]->{cfg}->{General}->{max_try};
    my $retry_delay = 60;
    my $imap = Net::IMAP::Simple->new($host,retry => $retry_time,retry_delay => $retry_delay);# || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";}

#    my $imap = Net::IMAP::Simple->new($host,timeout => 1) ;#|| warn "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";

    unless(defined $imap && $imap->login($_[HEAP]->{cfg}->{IMAP_SERVER}->{user},$_[HEAP]->{cfg}->{IMAP_SERVER}->{pwd}))
    {
        $_[KERNEL]->yield('error',"can't connect server");
    }
    else
    {
        $_[KERNEL]->yield('check_new_mail');
        $_[HEAP]->{imap} = $imap;
    }
}

sub check_new_mail
{
    say "checking new Mail";
    my ($kernel,$heap) = @_[KERNEL,HEAP];
    my $count_of_messages = $heap->{imap}->select('INBOX');
    my $pre = 74||get_pre_mails_num($pre_mails_num);
    if ($pre < $count_of_messages)
    {
        save_mail_num_to_file($pre);
        $kernel->yield('new_jobs_arrive',$count_of_messages,$pre);
    }
    else
    {
        print "无新邮件\n";
        $heap->{imap}->quit;
        delete $heap->{imap};
        $kernel->delay_set('imap_connect',$heap->{General}->{sleep_time});
    }
}

sub new_jobs_arrive
{
    say "getting new jobs";
    my ($total,$pre) = @_[ARG0,ARG1];
    my $mail_info = {};
    for(my $i = $total; $pre < $i; $i--)
    {
     next if $_[HEAP]->{imap}->seen($i);
     my $mail = mail_parse::new(\@{$_[HEAP]->{imap}->top($i)});
        $mail_info->{$i}->{subject} = $mail->get('subject');
     $mail_info->{$i}->{date} = format_date($mail->get('date'),'/');
#        $imap->see($i)    #设置已读

    }
    $_[HEAP]->{jobs} = get_jobs(map {$mail_info->{$_}->{subject}} sort{$a <=> $b} keys(%$mail_info));
    $_[KERNEL]->yield('write_cmd_log');
}

sub write_cmd_log
{
    say "writing cmd log";
    open LOG,">>",catfile($_[HEAP]->{cfg}->{General}->{log_dir},'cmd.log');
    for (@{$_[HEAP]->{jobs}})
    {
        my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime; #这里可以取邮件的时间作为参考

        print LOG "$date_time $_\n" ;
    }
    close LOG;
    $_[KERNEL]->yield('start_job');
}

sub start_job
{
    say "start new job";
    my ($kernel,$heap) = @_[KERNEL,HEAP];
    print "@{$heap->{jobs}}\n";
    create POE::Session(
        inline_states => {
            _start => \&run_job,
            child_stdin => \&child_stdin,
            child_err => \&child_err,
            child_close => \&job_end,
            child_signal => \&signal_handle,
        }
        );
    $kernel->delay_set('imap_connect',$heap->{cfg}->{General}->{sleep_time});
}

sub run_job
{
    my ($kernel,$heap) = @_[KERNEL,HEAP];
    $kernel->alias_set('do_job');
    my $sess = $kernel->alias_resolve('main');
    $heap->{sess} = $sess;    #notice

    say "Session is not exist" unless defined $sess;
    for my $job (@{$sess->get_heap()->{jobs}})
    {
        my $out_file = catfile($sess->get_heap()->{cfg}->{General}->{neRe_dir},$job.'.txt');
        say $out_file;
        $heap->{out_file} = $out_file;
        my $cmd = exists $heap->{cmd}->{$job} ? $heap->{cmd}->{$job} : $job=~/\[script\](.*)/i ? catfile($sess->get_heap()->{cfg}->{General}->{script_dir},$1) :return;        
        say "cmd:$cmd";
        my $child = POE::Wheel::Run::Win32->new(
         Program => sub{exec "$cmd $out_file" or die "Can't exec: $!\n";},
         StdoutEvent => "child_stdin",
         StderrEvent => "child_err",    #StderrEvent- 子程序运行出错时触发,错误输出存于$_[ARG0]

         CloseEvent => "child_close",    #CloseEvent - 子程序运行完(无论成功与否)退出时触发该事件

        );
        $kernel->sig_child($child->PID, "child_signal");
        $heap->{children_by_wid}->{$child->ID}= $child;
        $heap->{children_by_pid}->{$child->PID}->{wheel} = $child;
        $heap->{children_by_pid}->{$child->PID}->{job} = $job;
    }
}

sub child_stdin
{
    my ($stdout_line, $wheel_id) = @_[ARG0, ARG1];
    my $child = $_[HEAP]->{children_by_wid}->{$wheel_id};
# print "pid ", $child->PID, " STDOUT: $stdout_line\n";

  print "$stdout_line";

}

sub child_err
{
    my ($stderr_line, $wheel_id) = @_[ARG0, ARG1];
  my $child = $_[HEAP]->{children_by_wid}->{$wheel_id};
  print "pid ", $child->PID, " STDERR: $stderr_line\n";
# err(

}

sub job_end
{
    my $wheel_id = $_[ARG0];
    my $child = delete $_[HEAP]->{children_by_wid}->{$wheel_id};
    unless (defined $child) {
    print "wid $wheel_id closed all pipes.\n";
    return;
    }
    print "pid ", $child->PID, " closed all pipes.\n";
}

sub signal_handle
{
    print "pid $_[ARG1] exited with status $_[ARG2].\n";
    my $job = $_[HEAP]{children_by_pid}{$_[ARG1]}{job};
    my $out_file = catfile($_[HEAP]->{sess}->get_heap()->{cfg}->{General}->{neRe_dir},$job.'.txt');
    if (!$_[ARG2])
    {
        $_[KERNEL]->post('main','send_mail',$job,$_[HEAP]->{out_file}) if $job=~/neRe/;
    }
    else
    {
        $_[KERNEL]->post('main','error',"can't run job:$job");
    }
    my $child = delete $_[HEAP]{children_by_pid}{$_[ARG1]}->{wheel};
    return unless defined $child;
    delete $_[HEAP]{children_by_wid}{$child->ID};
}

sub get_jobs
{
     my @jobs = grep {s{\s*\[cmd\](.*)\[\\cmd\]}{$1}i} @_;
     return \@jobs;
}

sub load_config
{
    my $file = shift;
    tie my %ini, 'Config::IniFiles', ( -file => $file );
#    print Dumper \%ini;

    return \%ini;    
}

sub get_pre_mails_num
{
    my $file = shift;
    my $mail_num_conf=Config::IniFiles->new( -file => $file);
    die "can't find $file:$!\n" if !$mail_num_conf;
    return $mail_num_conf->val('num', 'total mails');
}

sub format_date
{
    my ($date,$cvs) = @_;
    my ($day,$moon,$year,$time) = $date=~/\s*(\d+)\s+(\w+)\s+(\d+)\s+(.*?)\s+/;
    my %moon=(
                             'Jan' => '01',
                             'Feb' => '02',
                             'Mar' => '03',
                             'Apr' => '04',
                             'May' => '05',
                             'Jun' => '06',
                             'Jul' => '07',
                             'Aug' => '08',
                             'Sep' => '09',
                             'Oct' => '10',
                             'Nov' => '11',
                             'Dec' => '12',
                     );
  return join("$cvs",($year,$moon{$moon},$day))." $time";
}

sub save_mail_num_to_file
{
    my $file = 'pre mails num.txt';
    open F,">",$file;
    print F "total mails:",shift;
    close F;
}

sub err
{
    my $err_msg = $_[ARG0];
    open ERR,">>",catfile($_[HEAP]->{cfg}->{General}->{log_dir},'err.log');
    flock(ERR,LOCK_EX) || warn "can't get lock:$!\n";
    my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime;
    print ERR '[',$date_time,']',$err_msg,"\n";
    flock(ERR,LOCK_UN) || warn "can't unlock:$!\n";
    close ERR;
}

sub sendMail
{
    my ($kernel,$heap,$job,$file_name) = @_[KERNEL,HEAP,ARG0,ARG1];
    my $msg;
    open F,"<",$file_name;
    $msg.=$_ while (<F>);
    close F;
    my $subject = 'neRe:'.$job;
    my $sender;
    $sender=new Mail::Sender();
    #     #my @protocols = $sender->QueryAuthProtocols(); 查询服务器支持的认证方式

    if ($sender->MailMsg({
     smtp => $heap->{cfg}->{IMAP_SERVER}->{smtp},
     from => $heap->{cfg}->{neRe_mail}->{from},
     to =>$heap->{cfg}->{neRe_mail}->{to},
     subject => $subject, #主题

     msg => $msg, #内容

     auth => 'LOGIN', #smtp的验证方式    

     authid => $heap->{cfg}->{neRe_mail}->{user}, #user

     authpwd => $heap->{cfg}->{neRe_mail}->{pwd}, #pwd

     }) < 0) {
     warn "$Mail::Sender::Error\n";
     }
    else
    {
     print "neRe_mail sent from:$heap->{cfg}->{neRe_mail}->{from}\tOK.\n";
    }
    unlink $file_name || warn "can't del $file_name:$!\n";
}


作者: wfnh   发布时间: 2010-09-09