姫路図書館カテゴリ別新着書籍情報を取得し、Gmail送信するPerlスクリプト
@list 部分の数字がカテゴリを指す。
情報が欲しいカテゴリの数値を@listの配列に指定する。
カテゴリ毎の新着書籍情報がメールで送信される。
0. 日本の文学
- その他の日本文学
- 外国の文学
- 歴史・伝統・地理
- 政治・法律・軍事
- 経済・統計
- 社会・教育・民族
- 自然科学・医学
- 技術・工学・工業
- 家庭・家事・育児
- 芸術・スポーツ
- その他の一般書
#!/usr/bin/perl
use strict;
use warnings;
use URI;
use Encode;
use Web::Scraper;
use Email::Send;
use Email::Send::Gmail;
use Email::MIME;
use Email::MIME::Creator;
use Config::Pit;
use Encode;
use Data::Dumper;
my $config = pit_get("gmail.com");
my $scraper = scraper {
process '//table[6]/tr', 'list[]' => scraper {
process '//td[1]', 'title' => 'TEXT',
process '//td[2]', 'author' => 'TEXT',
process '//td[3]', 'publish' => 'TEXT',
}
};
my @list = ( 5, 8, 11);
foreach my $list_item (@list) {
my $url = 'https://www.library.city.himeji.hyogo.jp/cgi-bin/Sopcssin.sh?p_mode=1&g_mode=0&ryno=&c_key=&c_date=&proc=sin&sub=tso&zkr=&nyo=on&tso=on&ksno=&kgrn=&list_cnt=20&mad_list_cnt=&hit_cnt=&idx=1&page_idx=&sort=&dtsl=&sndc='. $list_item . '&session=&sfname=&trkn=AL&mode=S';
my $uri = URI->new($url);
my $result = $scraper->scrape($uri);
my @contents;
push(@contents, $url);
foreach my $item (@{ $result->{list} }) {
push(@contents, '>>'. $item->{title});
push(@contents, $item->{author});
push(@contents, $item->{publish});
}
my $contents = join("\n", @contents);
&sendmail($config,$contents);
}
sub sendmail {
my ($config, $contents) = @_;
my $email = Email::MIME->create(
header => [
From => $config->{username},
To => $config->{mobile_mail},
Subject => encode('MIME-Header-ISO_2022_JP', 'HimejiLibraryNew'),
],
attributes => {
content_type => 'text/plain',
charset => 'utf-8',
encoding => 'base64',
},
body_str => $contents,
);
my $sender = Email::Send->new({
mailer => 'Gmail',
mailer_args => [
username => $config->{username},
password => $config->{password},
]
}
);
$sender->send($email);
}
Email::Sen::Gmailを使ってGmail経由でメール送信
Email::Send, Email::Send::Gmail. Email::MIMEを使ってGmail経由でメールを送るコード保存用に
主にiPhoneへのメール送信につかっていると。定期的に図書館新着メール、検索サーチ、
まとまった内容をスクラッピングしてまとめて連続でメールする感じでつかっていると。
#!/usr/bin/perl
use strict;
use warnings;
use Email::Send;
use Email::Send::Gmail;
use Email::MIME;
use Email::MIME::Creator;
use Config::Pit;
use Encode;
my $config = pit_get("gmail.com");
my $email = Email::MIME->create(
header => [
From => $config->{username},
To => 'iPhone_address@i.softbank.jp',
Subject => encode('MIME-Header-ISO_2022_JP', "テスト送信"),
],
attributes => {
content_type => 'text/plain',
charset => 'utf-8',
encoding => 'base64',
},
body => "メールのテスト送信です。",
);
my $sender = Email::Send->new({
mailer => 'Gmail',
mailer_args => [
username => $config->{username},
password => $config->{password},
]
}
);
$sender->send($email);Email::MIMEのattribute設定があるおかげでhtml形式のメールなども送れる。
本文もオブジェクトのままで値を渡せるのでgood!
参照先は以下から
モダンにGmailからメール送信 - hnwの日記
libxml-atom-perl
新しくPerl開発環境を構築中。
はてなダイアリーへコマンドラインからポストするためにXML::Atom::Entry、XML::Atom::Clientを使うわけなんだが、
Ubuntu server 10.04にてCPANモジュールXML::Atomインストールが何度もこけてしまうので悩んでいたんだわけだが（XML::Parser,XML::LibXMLで躓くみたいな）
libxml-atom-perlのパッケージを入れることで、すんなりとCPANからインストールすることができたｗ。
ちなみに
sudo apt-cache search keyword
で、パッケージ検索する技を覚えました。とりあえず、XML::Atomがインストールできたのでコマンドラインからはてなダイアリーにポストしていますと。
MacBook Air手に入れたら・・・
MacBook Airが当たるキャンペーンに乗っかって、
MacBook Air 11インチ欲しい！（まっくぶっくえあーじゅういちいんちほしい）
MacBook Air 11インチ欲しい！とは - はてなキーワード
はてなダイアリーで、ブログを書くだけで話題のMacBook Airが当たるキャンペーンを実施中です。はてなブックマークで同時応募すると、当選確率が2倍にUP！
MacBook Air手に入れたら・・・
とりあえず、以下の記事を参考にして開発環境を整えるつもり。
本来の目的は、iPhoneアプリを作るために欲しいんだ。
Titanium mobileでiPhoneアプリを作ると。
TitaniumでAndroid/iPhoneアプリをリリースしました！はてなブックマークリーダー！ - Money does not hurt your heart
gistp 修正
Cwd モジュールを使って、アップしたディレクトリにgit cloneできるようにした。
今までは、gistに投げた後は、HOMEディレクトリにgit cloneされていたんだけど、すぐにgistにアップしたものを修正したい時に同じディレクトリにあればと思って修正を加えた。
gistp使ってgistにアップした後、git cloneされるようになっているので、アップした時点でファイルが要らなくなることを知った。
#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
use strict;
use warnings;
use 5.008001;
use WWW::Mechanize;
use Getopt::Long;
use File::Slurp qw(slurp);
use Pod::Usage;
use Cwd;
my %options;
GetOptions(\%options, "--name=s", "--private", "--help");
run(\%options, @ARGV);
sub run {
my($opts, @args) = @_;
if ($opts->{help}) {
pod2usage(0);
}
my @files = setup_files($opts, @args);
my %fields;
my $i = 1;
for my $file (@files) {
$fields{"file_name[gistfile$i]"} = $file->{name};
$fields{"file_contents[gistfile$i]"} = $file->{content};
$i++;
}
$fields{private} = 'on' if $opts->{private};
my %auth = get_auth() or die "No github.user and github.token found. See http://github.com/account\n";
my($id, $uri) = post_gist({ %fields, %auth });
git_clone($id, $uri);
}
sub setup_files {
my($opts, @args) = @_;
my @files;
if (@args == 0 or $args[0] eq '-') {
my $content = join '', <STDIN>;
@files = ({ name => $opts->{name} || '', content => $content });
} else {
for my $arg (@args) {
push @files, {
name => $arg,
content => scalar slurp($arg),
};
}
}
return @files;
}
sub post_gist {
my $fields = shift;
my $mech = WWW::Mechanize->new;
$mech->get('http://gist.github.com');
$mech->submit_form(
form_number => 2,
fields => $fields,
);
my $id = ($mech->uri->path =~ m!^/([0-9a-f]+)$!)[0]
or die "Creating a gist failed: " . $mech->uri;
return ($id, $mech->uri);
}
sub git_clone {
my($id, $uri) = @_;
#my $dir = $ENV{GIST_DIR} || $ENV{GISTY_DIR} || "$ENV{HOME}/gists";
my $dir = Cwd::getcwd();
unless (-e $dir) {
mkdir $dir, 0777 or die "$dir: $!";
}
chdir $dir;
warn "Created a new gist at $uri\nNow cloning to $dir/$id\n";
system "git clone git\@gist.github.com:$id.git";
}
sub get_auth {
my ($self) = @_;
my($login, $token);
if (eval "require Git; 1") {
$login = Git::config('github.user');
$token = Git::config('github.token');
} else {
chomp($login = `git config --global github.user`);
chomp($token = `git config --global github.token`);
}
return unless $login and $token;
return (
login => $login,
token => $token,
);
}
__END__
HTML::ExtractContent&Lingua::JA::Summarize::Extract #2
記事最初の2行を別で抜き出し、サマリー生成後、追加表示する
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use URI;
use HTML::ExtractContent;
use Encode;
use Lingua::JA::Summarize::Extract;
use Data::Dumper;
my $url = shift;
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
if ($res->is_success) {
my $ext = HTML::ExtractContent->new;
$ext->extract($res->decoded_content);
my $cont = $ext->as_text;
my @text = split"\n", $cont;
my @sentence = splice(@text, 0,2);
my $summarize = Lingua::JA::Summarize::Extract->new({ rate => 5, 'length' => 300 });
my $res_summari = $summarize->extract($cont)->as_string;
print "first-sentence\n";
print map { encode('utf-8', $_) } @sentence;
print "summarize\n";
print encode('utf-8', $res_summari);
} else {
die $res->status_line;
}
任意の記事のサマリーを生成する HTML::ExtractContent&Lingua::JA::Summarize::Extract
HTML::ExtractContent - search.cpan.org
Lingua::JA::Summarize::Extract - search.cpan.orgを使って生成。
記事最初の1,2行は、表示されるようにしたほうがいいかな。
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use URI;
use HTML::ExtractContent;
use Encode;
use Lingua::JA::Summarize::Extract;
my $url = shift;
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
if ($res->is_success) {
my $ext = HTML::ExtractContent->new;
my $summarize = Lingua::JA::Summarize::Extract->new;
my $res_summari = $summarize->extract($ext->extract($res->decoded_content)->as_text);
print "summarize\n";
print $res_summari = encode('utf-8', $res_summari);
} else {
die $res->status_line;
}
