Hatena::ブログ(Diary)

cool2ikou このページをアンテナに追加 RSSフィード

2011-05-17

姫路図書館カテゴリ別新着書籍情報を取得し、Gmail送信するPerlスクリプト

@list 部分の数字がカテゴリを指す。

情報が欲しいカテゴリの数値を@listの配列に指定する。

カテゴリ毎の新着書籍情報がメールで送信される。

0. 日本の文学

  1. その他の日本文学
  2. 外国の文学
  3. 歴史・伝統・地理
  4. 政治・法律軍事
  5. 経済統計
  6. 社会・教育・民族
  7. 自然科学医学
  8. 技術・工学・工業
  9. 家庭・家事・育児
  10. 芸術・スポーツ
  11. その他の一般書

#!/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);	
}

2011-02-13

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からインストールすることができたw。

ちなみに

sudo apt-cache search keyword

で、パッケージ検索する技を覚えました。とりあえず、XML::Atomインストールできたのでコマンドラインからはてなダイアリーにポストしていますと。

2011-01-21

2010-11-26

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__

2010-11-03

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;
}