Perlの最近のブログ記事

あるディレクトリにあるログファイルのなかからエラー情報を抜き出し、指定したメールに送信するというプログラムを書きました。cron登録して毎日エラーチェックしています。サーバの都合上、Perl5.8.0でCPANは使用できず。Linux、EUC環境でログファイルはShift-JISという環境で動作しています。メールはsendmailを使用しています。

1度チェックしたファイルはbackupディレクトリに移動し、2度はチェックしないようになっています。

ソースはクリエイティブコモンズでお願いします。

#!/usr/bin/perl

use strict;
use File::Copy;

require "mimew.pl";
require "jcode.pl";

my $ERROR_DIR = '/var/log/error';
my $BACK_UP = '/var/log/error/backup';

opendir(DIR, $ERROR_DIR) or die;
foreach (readdir(DIR)){
  my $file = $_;
  my $error = "";
  next if $file =~ /^\./ ;
  next if $file =~ /backup/ ;
  open(FILE, $ERROR_DIR."/".$file ) or die;
  foreach (){
    $error .= $_ unless $_ =~ /,0,0,/;
  }
  close(FILE);
  print $file."\n";
  jcode::convert(\$error, 'euc', 'sjis');
  if ( length($error) > 1 ){
    sendmail($file, $error)
  }
  move $ERROR_DIR."/".$file, $BACK_UP."/".$file or die "move Error. $!";
}
closedir(DIR);

sub sendmail(){
    my @arg = @_;
    my $sendmail = '/usr/lib/sendmail';

    my $to = "to\@example.com"; 
    my $from = "from\@example.com";
    my $subject = @arg[0];
    my $body = @arg[1];

    jcode::convert(\$body,'jis', 'euc');
    jcode::convert(\$subject,'jis', 'euc');
    $subject = mimeencode($subject);

    open(MAIL,"| $sendmail -t");

    print MAIL "To: $to\n";
    print MAIL "From: $from\n";
    print MAIL "Subject: $subject\n";
    print MAIL "\n";
    print MAIL "$body\n";

    close(MAIL);
}

しばらく、Rubyをやっていたので忘れないようにPerlでクロールスクリプトを書いてみます。
PerlもWebアプリ開発はやったことがないですが、、、仕事でパッチワーク的なツールをつくるのによく使っています。

環境はWindows＆ActivePerl（）で実施しました。

指定したURLにアクセスし、検索結果から価格等の情報を抜き取る
input.txtに検索ワードを読み込み、LWP::UserAgent->getで検索結果からコンテンツを抜き出し、欲しい情報をCSVファイルに保存する

    

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use URI;
use Encode;
use encoding 'shiftjis';
binmode(STDERR, ':raw :encoding(shiftjis)');
use Text::CSV_XS;

####################
###  初期設定    ###
####################
my $inputfile = "input.txt";
my ($day,$month,$year) = (localtime)[3..5];
my $outputfile = 1900 + $year . $month+1 . $day . ".csv";
my $baseUrl = 'http://target_domain/';
my @cvs_header = qw(no name price url);
my $user_agent = ’user_agent';

sub input_data{
    open(IN, $inputfile) || die "Can't open $inputfile ：$!";
    my @data = ;
    my $num = @data;
    print "取得データ件数：$num\n";
    close(IN) || die "Can't close $inputfile ：$!";
    return \@data;
}

sub url_encode($) {
    my $str = shift;
    $str =~ s/([^\w ])/'%'.unpack('H2', $1)/eg;
    $str =~ tr/ /+/;
    return $str;
}

sub http_connect {
    my $data = shift;
    my @output;
    push @output, \@cvs_header;
    my @headers = ('User-Agent' => $user_agent);
    my $url = URI->new($baseUrl);
    my $browse = LWP::UserAgent->new;
    foreach (@$data) {
        chomp;
        $url->query_form(
            sitem => $_
            );

        my $response = $browse->get($url, @headers);
        my $content=decode('euc-jp',$response->content);
        print "#";

        my ($rec)   = $content =~ m#\n(.*?)\n#mis;
        my ($link, $name)  = $rec =~ m#([^<]*?)#;
        my ($price) = $rec =~ m#(.+?円)#mis;
        push @output, [($_,$name,$price,$link)];
        sleep 3;
    }
    return \@output;
}

sub output_CSV {
    my $output = shift;
    my $csv = Text::CSV_XS->new({'binary' => 1});

    open(OUT, ">:encoding(shiftjis)", "$outputfile") || die "Can't open outputfile!：$!";
    foreach(@$output){
        $csv->combine(@$_);
        print OUT decode('utf8', $csv->string);
        print OUT "\n";
    }
    close(OUT) || die "Can't close outputfile!：$!";
}

my $data = input_data;
my $output = http_connect($data);
output_CSV($output);

まぁ、こんな感じでしょうか？
とりあえず、Rubyでも同様のプログラム作ってみたいな。

※Rubyでもクローラー作成しました。詳細はこちら

• Rubyでクローラー作成(mechanize, hpricot)